Commit 8f6d3db2 authored by Stephane Glondu's avatar Stephane Glondu Committed by Stéphane Glondu

Merge branch 'master' into explicit-homomorphism

parents bb068944 12dffa36
Pipeline #103629 passed with stages
in 26 minutes and 26 seconds
......@@ -41,6 +41,7 @@
<eliom findlib-package="eliom.server.monitor.start"/>
</site>
<eliom module="_build/src/web/server.cma">
<maxrequestbodysizeinmemory value="1048576"/>
<maxmailsatonce value="1000"/>
<uuid length="14"/>
<gdpr uri="http://www.example.org/privacy_policy.html"/>
......
......@@ -351,7 +351,10 @@ $\textsf{field}(o)$ to access the field \textsf{field} of $o$.
\right\}
\end{gather*}
A private key is a random number $x$ modulo $q$. The corresponding
A private key is a number $x$ modulo $q$, chosen at random in the
basic decryption mode, and computed after several interactions in the
threshold mode.
The corresponding
$\pklabel$ is $X=g^x$. A $\tpk$ is a bundle of this public key with a
\hyperref[common]{$\proof$} of knowledge computed as follows:
\begin{enumerate}
......@@ -628,7 +631,8 @@ Trustee $\mathcal{T}_j$ fills $\textsf{vo}_j$ as follows:
\]
\item \textsf{public\_key} is set to a
\hyperref[trustee-keys]{\texttt{trustee\_public\_key}} structure
built using $S_j$ as private key.
built using $S_j$ as private key, which computes the corresponding
public key and a proof of knowledge of $S_j$.
\end{itemize}
The administrator checks $\textsf{vo}_j$ as follows:
\begin{itemize}
......
......@@ -33,14 +33,16 @@ let stream_to_list s =
let lines_of_file fname =
let ic = open_in fname in
Stream.from (fun _ ->
try Some (input_line ic)
with End_of_file -> close_in ic; None
)
match input_line ic with
| line -> Some line
| exception End_of_file -> close_in ic; None
)
let lines_of_stdin () =
Stream.from (fun _ ->
try Some (input_line stdin)
with End_of_file -> None
match input_line stdin with
| line -> Some line
| exception End_of_file -> None
)
let string_of_file f =
......@@ -86,12 +88,11 @@ let get_mandatory_opt name = function
| None -> failcmd "%s is mandatory" name
let wrap_main f =
try
let () = f () in `Ok ()
with
| Cmdline_error e -> `Error (true, e)
| Failure e -> `Error (false, e)
| e -> `Error (false, Printexc.to_string e)
match f () with
| () -> `Ok ()
| exception Cmdline_error e -> `Error (true, e)
| exception Failure e -> `Error (false, e)
| exception e -> `Error (false, Printexc.to_string e)
module type CMDLINER_MODULE = sig
val cmds : (unit Cmdliner.Term.t * Cmdliner.Term.info) list
......@@ -297,8 +298,7 @@ module Election : CMDLINER_MODULE = struct
let get_threshold () =
let file = "threshold.json" in
Printf.eprintf "I: loading %s...\n%!" file;
try Some (string_of_file (X.dir / file))
with _ -> None
try Some (string_of_file (X.dir / file)) with _ -> None
let get_public_keys () =
load_from_file (fun x -> x) (X.dir/"public_keys.jsons") |>
......@@ -307,14 +307,12 @@ module Election : CMDLINER_MODULE = struct
let get_public_creds () =
let file = "public_creds.txt" in
Printf.eprintf "I: loading %s...\n%!" file;
try Some (lines_of_file (X.dir / file))
with _ -> None
try Some (lines_of_file (X.dir / file)) with _ -> None
let get_ballots () =
let file = "ballots.jsons" in
Printf.eprintf "I: loading %s...\n%!" file;
try Some (lines_of_file (X.dir / file))
with _ -> None
try Some (lines_of_file (X.dir / file)) with _ -> None
let get_shuffles () =
let file = "shuffles.jsons" in
......
......@@ -84,8 +84,8 @@ let compute_partial_decryption _ =
(partial_decryption_key_of_string epk).pdk_decryption_key
| None ->
basic_check_private_key pk_str;
try number_of_string pk_str
with e ->
try number_of_string pk_str with
| e ->
Printf.ksprintf
failwith "Error in format of private key: %s" (Printexc.to_string e)
in
......
......@@ -67,8 +67,8 @@ let extractQuestion q =
p2##querySelector (Js.string selector) >>= fun x ->
Dom_html.CoerceTo.input x >>= fun x ->
let x = Js.to_string x##.value in
try return (int_of_string x)
with _ -> failwith (error_msg ^ ": " ^ x ^ ".")
try return (int_of_string x) with
| _ -> failwith (error_msg ^ ": " ^ x ^ ".")
in
let answers = p2##querySelectorAll (Js.string ".question_answer") in
let q_answers =
......
......@@ -31,9 +31,10 @@ let stream_to_list s =
let lines_of_file fname =
let ic = open_in fname in
Stream.from (fun _ ->
try Some (input_line ic)
with End_of_file -> close_in ic; None
)
match input_line ic with
| line -> Some line
| exception End_of_file -> close_in ic; None
)
let string_of_file f =
lines_of_file f |> stream_to_list |> String.concat "\n"
......
......@@ -52,8 +52,8 @@ let oidc_get_userinfo ocfg info =
let%lwt info = Ocsigen_stream.(string_of_stream 10000 (get stream)) in
let%lwt () = Ocsigen_stream.finalize stream `Success in
let x = oidc_userinfo_of_string info in
return (Some (match x.oidc_email with Some x -> x | None -> x.oidc_sub))
| None -> return None
return_some (match x.oidc_email with Some x -> x | None -> x.oidc_sub)
| None -> return_none
let oidc_get_name ocfg client_id client_secret code =
let content = [
......@@ -69,7 +69,7 @@ let oidc_get_name ocfg client_id client_secret code =
let%lwt info = Ocsigen_stream.(string_of_stream 10000 (get stream)) in
let%lwt () = Ocsigen_stream.finalize stream `Success in
oidc_get_userinfo ocfg info
| None -> return None
| None -> return_none
let oidc_handler params () =
Web_auth.run_post_login_handler "oidc" (fun _ _ authenticate ->
......
......@@ -162,7 +162,7 @@ let lookup_account ~service ~username ~email =
let username = String.trim username |> String.lowercase_ascii in
let email = email |> String.lowercase_ascii in
match get_password_db_fname service with
| None -> return None
| None -> return_none
| Some db ->
let%lwt db = Lwt_preemptive.detach Csv.load db in
match
......@@ -172,5 +172,5 @@ let lookup_account ~service ~username ~email =
| _ -> false
) db
with
| Some (u :: _ :: _ :: e :: _) when is_email e -> return (Some (u, e))
| _ -> return None
| Some (u :: _ :: _ :: e :: _) when is_email e -> return_some (u, e)
| _ -> return_none
......@@ -303,11 +303,10 @@ let send_email recipient subject body =
let return_path = !Web_config.return_path in
let sendmail = sendmail ?return_path in
let rec loop () =
try%lwt
Lwt_preemptive.detach sendmail contents
with Unix.Unix_error (Unix.EAGAIN, _, _) ->
let%lwt () = Lwt_unix.sleep 1. in
loop ()
try%lwt Lwt_preemptive.detach sendmail contents with
| Unix.Unix_error (Unix.EAGAIN, _, _) ->
let%lwt () = Lwt_unix.sleep 1. in
loop ()
in loop ()
let split_identity x =
......@@ -330,8 +329,7 @@ let languages_of_string x =
Pcre.split x
let pcre_exec_opt ~rex x =
try Some (Pcre.exec ~rex x)
with Not_found -> None
try Some (Pcre.exec ~rex x) with Not_found -> None
let email_rex = "[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}"
......@@ -354,11 +352,9 @@ let extract_email =
)
let file_exists x =
try%lwt
let%lwt () = Lwt_unix.(access x [R_OK]) in
return true
with _ ->
return false
match%lwt Lwt_unix.(access x [R_OK]) with
| () -> return true
| exception _ -> return false
let get_fname uuid x =
match uuid with
......@@ -368,10 +364,9 @@ let get_fname uuid x =
!Web_config.spool_dir / raw_string_of_uuid uuid / x
let read_file ?uuid x =
try%lwt
let%lwt lines = Lwt_io.lines_of_file (get_fname uuid x) |> Lwt_stream.to_list in
return (Some lines)
with _ -> return_none
match%lwt Lwt_io.lines_of_file (get_fname uuid x) |> Lwt_stream.to_list with
| lines -> return_some lines
| exception _ -> return_none
let write_file ?uuid x lines =
let fname = get_fname uuid x in
......@@ -386,8 +381,8 @@ let write_file ?uuid x lines =
Lwt_unix.rename fname_new fname
let cleanup_file f =
try%lwt Lwt_unix.unlink f
with _ -> return_unit
try%lwt Lwt_unix.unlink f with
| _ -> return_unit
let rmdir dir =
let command = "rm", [| "rm"; "-rf"; dir |] in
......
......@@ -26,10 +26,6 @@ open Web_common
(** Global initialization *)
(* FIXME: the following should be in configuration file... but
<maxrequestbodysize> doesn't work *)
let () = Ocsigen_config.set_maxrequestbodysizeinmemory 1048576 (* 1 MB *)
let () = CalendarLib.Time_Zone.(change Local)
(** Parse configuration from <eliom> *)
......@@ -47,6 +43,8 @@ let () =
List.iter @@ function
| PCData x ->
Ocsigen_extensions.Configuration.ignore_blank_pcdata ~in_tag:"belenios" x
| Element ("maxrequestbodysizeinmemory", ["value", m], []) ->
Ocsigen_config.set_maxrequestbodysizeinmemory (int_of_string m)
| Element ("log", ["file", file], []) ->
Lwt_main.run (open_security_log file)
| Element ("source", ["file", file], []) ->
......
......@@ -33,7 +33,7 @@ let ( / ) = Filename.concat
let get_draft_election uuid =
match%lwt read_file ~uuid "draft.json" with
| Some [x] -> return @@ Some (draft_election_of_string x)
| Some [x] -> return_some (draft_election_of_string x)
| _ -> return_none
let set_draft_election uuid se =
......@@ -41,16 +41,15 @@ let set_draft_election uuid se =
let get_election_result uuid =
match%lwt read_file ~uuid "result.json" with
| Some [x] -> return (Some (election_result_of_string Yojson.Safe.read_json x))
| Some [x] -> return_some (election_result_of_string Yojson.Safe.read_json x)
| _ -> return_none
let set_election_result_hidden uuid hidden =
match hidden with
| None ->
(
try%lwt Lwt_unix.unlink (!Web_config.spool_dir / raw_string_of_uuid uuid / "hide_result")
with _ -> return_unit
)
(try%lwt Lwt_unix.unlink (!Web_config.spool_dir / raw_string_of_uuid uuid / "hide_result") with
| _ -> return_unit
)
| Some d -> write_file ~uuid "hide_result" [string_of_datetime d]
let get_election_result_hidden uuid =
......@@ -58,7 +57,7 @@ let get_election_result_hidden uuid =
| Some [x] ->
let t = datetime_of_string x in
if datetime_compare (now ()) t < 0 then
return (Some t)
return_some t
else
let%lwt () = set_election_result_hidden uuid None in
return_none
......@@ -129,9 +128,8 @@ let set_election_auto_dates uuid x =
let set_election_state uuid s =
match s with
| `Archived ->
(
try%lwt Lwt_unix.unlink (!Web_config.spool_dir / raw_string_of_uuid uuid / "state.json")
with _ -> return_unit
(try%lwt Lwt_unix.unlink (!Web_config.spool_dir / raw_string_of_uuid uuid / "state.json") with
| _ -> return_unit
)
| _ -> write_file ~uuid "state.json" [string_of_election_state s]
......@@ -170,7 +168,7 @@ let set_partial_decryptions uuid pds =
let get_decryption_tokens uuid =
match%lwt read_file ~uuid "decryption_tokens.json" with
| Some [x] -> return @@ Some (decryption_tokens_of_string x)
| Some [x] -> return_some (decryption_tokens_of_string x)
| _ -> return_none
let set_decryption_tokens uuid pds =
......@@ -179,7 +177,7 @@ let set_decryption_tokens uuid pds =
let get_raw_election uuid =
match%lwt read_file ~uuid "election.json" with
| Some [x] -> return (Some x)
| Some [x] -> return_some x
| _ -> return_none
let empty_metadata = {
......@@ -218,7 +216,7 @@ let get_elections_by_owner user =
Lwt_list.filter_map_s
(fun x ->
if x = "." || x = ".." then
return None
return_none
else (
try
let uuid = uuid_of_raw_string x in
......@@ -248,16 +246,16 @@ let get_elections_by_owner user =
let date = Option.get date default_archive_date in
return (`Archived, date)
in
return @@ Some (kind, uuid, date, election.e_params.e_name)
return_some (kind, uuid, date, election.e_params.e_name)
)
| _ -> return_none
)
| Some se ->
if se.se_owner = user then
let date = Option.get se.se_creation_date default_creation_date in
return @@ Some (`Draft, uuid, date, se.se_questions.t_name)
return_some (`Draft, uuid, date, se.se_questions.t_name)
else return_none
with _ -> return None
with _ -> return_none
)
)
......@@ -278,14 +276,14 @@ let get_passwords uuid =
SMap.add login (salt, hash) accu
| _ -> accu
) SMap.empty csv in
return @@ Some res
return_some res
let get_public_keys uuid =
read_file ~uuid "public_keys.jsons"
let get_private_key uuid =
match%lwt read_file ~uuid "private_key.json" with
| Some [x] -> return (Some (number_of_string x))
| Some [x] -> return_some (number_of_string x)
| _ -> return_none
let get_private_keys uuid =
......@@ -293,7 +291,7 @@ let get_private_keys uuid =
let get_threshold uuid =
match%lwt read_file ~uuid "threshold.json" with
| Some [x] -> return (Some x)
| Some [x] -> return_some x
| _ -> return_none
module StringMap = Map.Make (String)
......@@ -326,13 +324,12 @@ let get_ballot_hashes uuid =
StringMap.bindings ballots |> List.map fst |> return
| _ ->
let uuid_s = raw_string_of_uuid uuid in
try%lwt
let ballots = Lwt_unix.files_of_directory (!Web_config.spool_dir / uuid_s / "ballots") in
let%lwt ballots = Lwt_stream.to_list ballots in
let ballots = List.filter (fun x -> x <> "." && x <> "..") ballots in
return (List.rev_map unurlize ballots)
with Unix.Unix_error(Unix.ENOENT, "opendir", _) ->
return []
match%lwt Lwt_unix.files_of_directory (!Web_config.spool_dir / uuid_s / "ballots") |> Lwt_stream.to_list with
| ballots ->
let ballots = List.filter (fun x -> x <> "." && x <> "..") ballots in
return (List.rev_map unurlize ballots)
| exception Unix.Unix_error(Unix.ENOENT, "opendir", _) ->
return []
let get_ballot_by_hash uuid hash =
match%lwt get_election_state uuid with
......@@ -342,7 +339,7 @@ let get_ballot_by_hash uuid hash =
| _ ->
let%lwt ballot = read_file ~uuid ("ballots" / urlize hash) in
match ballot with
| Some [x] -> return (Some x)
| Some [x] -> return_some x
| _ -> return_none
let load_ballots uuid =
......@@ -352,7 +349,7 @@ let load_ballots uuid =
let%lwt ballots = Lwt_stream.to_list ballots in
Lwt_list.filter_map_s (fun x ->
match%lwt read_file (ballots_dir / x) with
| Some [x] -> return (Some x)
| Some [x] -> return_some x
| _ -> return_none
) ballots
) else return []
......@@ -380,7 +377,7 @@ let replace_ballot uuid ~hash ~rawballot =
let compute_encrypted_tally uuid =
let%lwt election = get_raw_election uuid in
match election with
| None -> return None
| None -> return_none
| Some election ->
let election = Election.of_string election in
let module W = (val Election.get_group election) in
......@@ -391,7 +388,7 @@ let compute_encrypted_tally uuid =
let num_tallied = Array.length ballots in
let tally = string_of_encrypted_tally E.G.write tally in
let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in
return (Some (num_tallied, sha256_b64 tally, tally))
return_some (num_tallied, sha256_b64 tally, tally)
let get_shuffle_token uuid =
match%lwt read_file ~uuid "shuffle_token.json" with
......
......@@ -170,10 +170,10 @@ Belenios Server" username uri
let confirm_link token =
links := filter_links_by_time !links;
match SMap.find_opt token !links with
| None -> Lwt.return None
| None -> Lwt.return_none
| Some x ->
links := SMap.remove token !links;
Lwt.return (Some (x.service, x.address, x.kind))
Lwt.return_some (x.service, x.address, x.kind)
let cracklib =
let x = "cracklib-check" in (x, [| x |])
......@@ -191,4 +191,4 @@ let cracklib_check password =
| None ->
let%lwt x = Lwt_process.pmap ~env:[| "LANG=C" |] cracklib password in
Lwt.return (extract_comment x)
| Some _ -> Lwt.return (Some "newline in password")
| Some _ -> Lwt.return_some "newline in password"
This diff is collapsed.
......@@ -30,8 +30,8 @@ let election_user = Eliom_reference.eref ~scope None
let get_election_user uuid =
match%lwt Eliom_reference.get election_user with
| Some (u, x) when u = uuid -> return (Some x)
| _ -> return None
| Some (u, x) when u = uuid -> return_some x
| _ -> return_none
let ballot = Eliom_reference.eref ~scope None
let cast_confirmed = Eliom_reference.eref ~scope None
......
......@@ -2825,7 +2825,7 @@ let tally_trustees election trustee_id token () =
let%lwt encrypted_private_key =
match%lwt Web_persist.get_private_keys uuid with
| None -> return_none
| Some keys -> return (Some (List.nth keys (trustee_id-1)))
| Some keys -> return_some (List.nth keys (trustee_id-1))
in
let content = [
p [pcdata "It is now time to compute your partial decryption factors."];
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment