Commit ca7b9b18 authored by Stephane Glondu's avatar Stephane Glondu

Switch to exception-less style when Not_found is involved

parent 14d08b4c
...@@ -64,9 +64,7 @@ let getTextarea id = ...@@ -64,9 +64,7 @@ let getTextarea id =
(Dom_html.CoerceTo.textarea e) (Dom_html.CoerceTo.textarea e)
(fun x -> res := Some (Js.to_string (x##.value))) (fun x -> res := Some (Js.to_string (x##.value)))
); );
match !res with !res
| None -> raise Not_found
| Some x -> x
let setTextarea id z = let setTextarea id z =
withElementById id (fun e -> withElementById id (fun e ->
...@@ -351,7 +349,11 @@ let loadElection () = ...@@ -351,7 +349,11 @@ let loadElection () =
setDisplayById "election_loader" "none"; setDisplayById "election_loader" "none";
setDisplayById "wait_div" "none"; setDisplayById "wait_div" "none";
setDisplayById "booth_div" "block"; setDisplayById "booth_div" "block";
let election_raw = getTextarea "election_params" |> drop_trailing_newline in let election_raw =
match getTextarea "election_params" with
| Some x -> drop_trailing_newline x
| None -> failwith "election_params is missing"
in
let election_params = Election.(get_group (of_string election_raw)) in let election_params = Election.(get_group (of_string election_raw)) in
let module P = (val election_params : ELECTION_DATA) in let module P = (val election_params : ELECTION_DATA) in
let params = P.election.e_params in let params = P.election.e_params in
...@@ -374,8 +376,7 @@ let get_url x = ...@@ -374,8 +376,7 @@ let get_url x =
None None
else else
let args = Url.decode_arguments (String.sub x 1 (n-1)) in let args = Url.decode_arguments (String.sub x 1 (n-1)) in
try Some (List.assoc "url" args) List.assoc_opt "url" args
with Not_found -> None
let load_url url = let load_url url =
let open Lwt_xmlHttpRequest in let open Lwt_xmlHttpRequest in
...@@ -386,11 +387,13 @@ let load_url url = ...@@ -386,11 +387,13 @@ let load_url url =
) )
let load_url_handler _ = let load_url_handler _ =
let url = getTextarea "url" in (match getTextarea "url" with
let encoded = Url.encode_arguments ["url", url] in | Some url ->
Dom_html.window##.location##.hash := Js.string encoded; let encoded = Url.encode_arguments ["url", url] in
load_url url; Dom_html.window##.location##.hash := Js.string encoded;
Js._false load_url url
| None -> ()
); Js._false
let load_params_handler _ = let load_params_handler _ =
setDisplayById "div_ballot" "block"; setDisplayById "div_ballot" "block";
......
...@@ -183,7 +183,11 @@ let b64_order = "+/0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYz ...@@ -183,7 +183,11 @@ let b64_order = "+/0123456789aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYz
let compare_b64 a b = let compare_b64 a b =
let na = String.length a and nb = String.length b in let na = String.length a and nb = String.length b in
let value_of c = try String.index b64_order c with Not_found -> -1 in let value_of c =
match String.index_opt b64_order c with
| Some i -> i
| None -> -1
in
let rec loop i = let rec loop i =
match (i < na), (i < nb) with match (i < na), (i < nb) with
| true, true -> | true, true ->
......
...@@ -56,16 +56,15 @@ end ...@@ -56,16 +56,15 @@ end
let check x = let check x =
String.length x = token_length + 1 && String.length x = token_length + 1 &&
let rec loop i accu = let rec loop i accu =
if i < token_length then ( if i < token_length then
let digit = String.index digits x.[i] in match String.index_opt digits x.[i] with
loop (i+1) Z.(n58 * accu + of_int digit) | Some digit -> loop (i+1) Z.(n58 * accu + of_int digit)
) else accu | None -> None
else Some accu
in in
try match loop 0 Z.zero, String.index_opt digits x.[token_length] with
let n = loop 0 Z.zero in | Some n, Some checksum -> Z.((n + of_int checksum) mod n53 =% zero)
let checksum = String.index digits x.[token_length] in | _, _ -> false
Z.((n + of_int checksum) mod n53 =% zero)
with Not_found -> false
let remove_dashes x = let remove_dashes x =
let n = String.length x in let n = String.length x in
......
...@@ -582,10 +582,9 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct ...@@ -582,10 +582,9 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
in in
let map = loop 0 G.one GMap.empty in let map = loop 0 G.one GMap.empty in
fun x -> fun x ->
try match GMap.find_opt x map with
GMap.find x map | Some x -> x
with Not_found -> | None -> invalid_arg "Cannot compute result"
invalid_arg "Cannot compute result"
in in
let result = Array.mmap log results in let result = Array.mmap log results in
{num_tallied; encrypted_tally; partial_decryptions; result} {num_tallied; encrypted_tally; partial_decryptions; result}
......
...@@ -33,8 +33,9 @@ let check token = ...@@ -33,8 +33,9 @@ let check token =
n >= min_uuid_length && n >= min_uuid_length &&
let rec loop i = let rec loop i =
if i >= 0 then if i >= 0 then
let digit = try String.index digits token.[i] with Not_found -> -1 in match String.index_opt digits token.[i] with
if digit >= 0 then loop (i-1) else false | Some _ -> loop (i-1)
| None -> false
else true else true
in loop (n-1) in loop (n-1)
......
...@@ -49,7 +49,7 @@ let sha256_b64 x = ...@@ -49,7 +49,7 @@ let sha256_b64 x =
Js.Unsafe.meth_call sjcl "codec.base64.fromBits" Js.Unsafe.meth_call sjcl "codec.base64.fromBits"
[| sha256 x |] |> Js.to_string [| sha256 x |] |> Js.to_string
in in
match (try Some (String.index raw '=') with Not_found -> None) with match String.index_opt raw '=' with
| Some i -> String.sub raw 0 i | Some i -> String.sub raw 0 i
| None -> raw | None -> raw
......
...@@ -194,8 +194,7 @@ let decrypt ~key ~iv ~ciphertext = ...@@ -194,8 +194,7 @@ let decrypt ~key ~iv ~ciphertext =
type rng = Cryptokit.Random.rng type rng = Cryptokit.Random.rng
let secure_rng = let secure_rng =
if Belenios_version.debug && if Belenios_version.debug && Sys.getenv_opt "BELENIOS_USE_URANDOM" <> None
(try Sys.getenv "BELENIOS_USE_URANDOM" with Not_found -> "") <> ""
then Cryptokit.Random.device_rng "/dev/urandom" then Cryptokit.Random.device_rng "/dev/urandom"
else Cryptokit.Random.secure_rng else Cryptokit.Random.secure_rng
......
...@@ -125,10 +125,9 @@ module Make (P : PARSED_PARAMS) : S = struct ...@@ -125,10 +125,9 @@ module Make (P : PARSED_PARAMS) : S = struct
| Some creds -> (fun b -> | Some creds -> (fun b ->
match b.signature with match b.signature with
| Some s -> | Some s ->
(try (match GSet.find_opt s.s_public_key !creds with
if GSet.find s.s_public_key !creds then false | Some false -> creds := GSet.add s.s_public_key true !creds; true
else (creds := GSet.add s.s_public_key true !creds; true) | _ -> false)
with Not_found -> false)
| None -> false | None -> false
) )
| None -> (fun _ -> true) | None -> (fun _ -> true)
......
...@@ -25,7 +25,7 @@ let alert s : unit = ...@@ -25,7 +25,7 @@ let alert s : unit =
let open Js.Unsafe in let open Js.Unsafe in
fun_call (variable "alert") [| s |> Js.string |> inject |] fun_call (variable "alert") [| s |> Js.string |> inject |]
let get_textarea id = let get_textarea_opt id =
let res = ref None in let res = ref None in
Js.Opt.iter Js.Opt.iter
(document##getElementById (Js.string id)) (document##getElementById (Js.string id))
...@@ -34,9 +34,12 @@ let get_textarea id = ...@@ -34,9 +34,12 @@ let get_textarea id =
(Dom_html.CoerceTo.textarea e) (Dom_html.CoerceTo.textarea e)
(fun x -> res := Some (Js.to_string (x##.value))) (fun x -> res := Some (Js.to_string (x##.value)))
); );
match !res with !res
| None -> raise Not_found
let get_textarea id =
match get_textarea_opt id with
| Some x -> x | Some x -> x
| None -> Printf.ksprintf failwith "<textarea> %s is missing" id
let set_textarea id z = let set_textarea id z =
Js.Opt.iter Js.Opt.iter
...@@ -47,7 +50,7 @@ let set_textarea id z = ...@@ -47,7 +50,7 @@ let set_textarea id z =
(fun x -> x##.value := Js.string z) (fun x -> x##.value := Js.string z)
) )
let get_input id = let get_input_opt id =
let res = ref None in let res = ref None in
Js.Opt.iter Js.Opt.iter
(document##getElementById (Js.string id)) (document##getElementById (Js.string id))
...@@ -56,9 +59,12 @@ let get_input id = ...@@ -56,9 +59,12 @@ let get_input id =
(Dom_html.CoerceTo.input e) (Dom_html.CoerceTo.input e)
(fun x -> res := Some (Js.to_string (x##.value))) (fun x -> res := Some (Js.to_string (x##.value)))
); );
match !res with !res
| None -> raise Not_found
let get_input id =
match get_input_opt id with
| Some x -> x | Some x -> x
| None -> Printf.ksprintf failwith "<input> %s is missing" id
let set_element_display id x = let set_element_display id x =
Js.Opt.iter Js.Opt.iter
......
...@@ -27,7 +27,11 @@ let generate _ = ...@@ -27,7 +27,11 @@ let generate _ =
let raw = get_textarea "voters" in let raw = get_textarea "voters" in
let rec loop i accu = let rec loop i accu =
if i >= 0 then if i >= 0 then
let j = try String.rindex_from raw i '\n' with Not_found -> -1 in let j =
match String.rindex_from_opt raw i '\n' with
| Some x -> x
| None -> -1
in
loop (j-1) (String.sub raw (j+1) (i-j) :: accu) loop (j-1) (String.sub raw (j+1) (i-j) :: accu)
else else
accu accu
......
...@@ -75,20 +75,20 @@ let compute_partial_decryption _ = ...@@ -75,20 +75,20 @@ let compute_partial_decryption _ =
Dom_html.CoerceTo.input e >>= fun e -> Dom_html.CoerceTo.input e >>= fun e ->
let pk_str = Js.to_string e##.value in let pk_str = Js.to_string e##.value in
let private_key = let private_key =
try match get_textarea_opt "encrypted_private_key" with
let epk = get_textarea "encrypted_private_key" in | Some epk ->
let module PKI = Trustees.MakePKI (P.G) (DirectRandom) in let module PKI = Trustees.MakePKI (P.G) (DirectRandom) in
let module C = Trustees.MakeChannels (P.G) (DirectRandom) (PKI) in let module C = Trustees.MakeChannels (P.G) (DirectRandom) (PKI) in
let sk = PKI.derive_sk pk_str and dk = PKI.derive_dk pk_str in let sk = PKI.derive_sk pk_str and dk = PKI.derive_dk pk_str in
let vk = P.G.(g **~ sk) in let vk = P.G.(g **~ sk) in
let epk = C.recv dk vk epk in let epk = C.recv dk vk epk in
(partial_decryption_key_of_string epk).pdk_decryption_key (partial_decryption_key_of_string epk).pdk_decryption_key
with Not_found -> | None ->
basic_check_private_key pk_str; basic_check_private_key pk_str;
try number_of_string pk_str try number_of_string pk_str
with e -> with e ->
Printf.ksprintf Printf.ksprintf
failwith "Error in format of private key: %s" (Printexc.to_string e) failwith "Error in format of private key: %s" (Printexc.to_string e)
in in
let factor = E.compute_factor encrypted_tally private_key in let factor = E.compute_factor encrypted_tally private_key in
set_textarea "pd" (string_of_partial_decryption P.G.write factor); set_textarea "pd" (string_of_partial_decryption P.G.write factor);
...@@ -129,8 +129,7 @@ let get_uuid x = ...@@ -129,8 +129,7 @@ let get_uuid x =
None None
else else
let args = Url.decode_arguments (String.sub x 1 (n-1)) in let args = Url.decode_arguments (String.sub x 1 (n-1)) in
try Some (List.assoc "uuid" args) List.assoc_opt "uuid" args
with Not_found -> None
let main _ = let main _ =
let _ = let _ =
......
...@@ -31,8 +31,7 @@ open Web_services ...@@ -31,8 +31,7 @@ open Web_services
let ( / ) = Filename.concat let ( / ) = Filename.concat
let next_lf str i = let next_lf str i =
try Some (String.index_from str i '\n') String.index_from_opt str i '\n'
with Not_found -> None
let scope = Eliom_common.default_session_scope let scope = Eliom_common.default_session_scope
...@@ -64,19 +63,15 @@ let () = Eliom_registration.Any.register ~service:dummy_post dummy_handler ...@@ -64,19 +63,15 @@ let () = Eliom_registration.Any.register ~service:dummy_post dummy_handler
let check_password_with_file db name password = let check_password_with_file db name password =
let%lwt db = Lwt_preemptive.detach Csv.load db in let%lwt db = Lwt_preemptive.detach Csv.load db in
try match
begin List.find_opt (function
match | username :: _ :: _ :: _ -> username = name
List.find (function | _ -> false
| username :: _ :: _ :: _ -> username = name ) db
| _ -> false with
) db | Some (_ :: salt :: hashed :: _) ->
with return (sha256_hex (salt ^ password) = hashed)
| _ :: salt :: hashed :: _ -> | _ -> return false
return (sha256_hex (salt ^ password) = hashed)
| _ -> return false
end
with Not_found -> return false
let password_handler () (name, password) = let password_handler () (name, password) =
let%lwt uuid, service, config = let%lwt uuid, service, config =
...@@ -145,8 +140,9 @@ let username_rex = "^[A-Z0-9._%+-]+$" ...@@ -145,8 +140,9 @@ let username_rex = "^[A-Z0-9._%+-]+$"
let is_username = let is_username =
let rex = Pcre.regexp ~flags:[`CASELESS] username_rex in let rex = Pcre.regexp ~flags:[`CASELESS] username_rex in
fun x -> fun x ->
try ignore (Pcre.pcre_exec ~rex x); true match pcre_exec_opt ~rex x with
with Not_found -> false | Some _ -> true
| None -> false
let add_account ~username ~password ~email = let add_account ~username ~password ~email =
if is_username username then if is_username username then
...@@ -302,8 +298,8 @@ let oidc_handler params () = ...@@ -302,8 +298,8 @@ let oidc_handler params () =
| None -> failwith "oidc handler was invoked without environment" | None -> failwith "oidc handler was invoked without environment"
| Some x -> return x | Some x -> return x
in in
let code = try Some (List.assoc "code" params) with Not_found -> None in let code = List.assoc_opt "code" params in
let state = try Some (List.assoc "state" params) with Not_found -> None in let state = List.assoc_opt "state" params in
match code, state with match code, state with
| Some code, Some state -> | Some code, Some state ->
let%lwt ocfg, client_id, client_secret, st = let%lwt ocfg, client_id, client_secret, st =
...@@ -370,8 +366,8 @@ let get_login_handler service uuid auth_system config = ...@@ -370,8 +366,8 @@ let get_login_handler service uuid auth_system config =
| _ -> fail_http 404 | _ -> fail_http 404
let rec find_auth_instance x = function let rec find_auth_instance x = function
| [] -> raise Not_found | [] -> None
| { auth_instance = i; auth_system = s; auth_config = c } :: _ when i = x -> s, c | { auth_instance = i; auth_system = s; auth_config = c } :: _ when i = x -> Some (s, c)
| _ :: xs -> find_auth_instance x xs | _ :: xs -> find_auth_instance x xs
let login_handler service uuid = let login_handler service uuid =
...@@ -392,8 +388,9 @@ let login_handler service uuid = ...@@ -392,8 +388,9 @@ let login_handler service uuid =
match service with match service with
| Some s -> | Some s ->
let%lwt auth_system, config = let%lwt auth_system, config =
try return @@ find_auth_instance s c match find_auth_instance s c with
with Not_found -> fail_http 404 | Some x -> return x
| None -> fail_http 404
in in
get_login_handler s uuid auth_system config get_login_handler s uuid auth_system config
| None -> | None ->
......
...@@ -268,11 +268,9 @@ let send_email recipient subject body = ...@@ -268,11 +268,9 @@ let send_email recipient subject body =
let split_identity x = let split_identity x =
let n = String.length x in let n = String.length x in
try match String.index_opt x ',' with
let i = String.index x ',' in | Some i -> String.sub x 0 i, String.sub x (i+1) (n-i-1)
String.sub x 0 i, String.sub x (i+1) (n-i-1) | None -> x, x
with Not_found ->
x, x
let available_languages = ["en"; "fr"; "de"; "ro"; "it"] let available_languages = ["en"; "fr"; "de"; "ro"; "it"]
...@@ -287,13 +285,18 @@ let string_of_languages xs = ...@@ -287,13 +285,18 @@ let string_of_languages xs =
let languages_of_string x = let languages_of_string x =
Pcre.split x Pcre.split x
let pcre_exec_opt ~rex x =
try Some (Pcre.exec ~rex x)
with Not_found -> None
let email_rex = "[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}" let email_rex = "[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}"
let is_email = let is_email =
let rex = Pcre.regexp ~flags:[`CASELESS] ("^" ^ email_rex ^ "$") in let rex = Pcre.regexp ~flags:[`CASELESS] ("^" ^ email_rex ^ "$") in
fun x -> fun x ->
try ignore (Pcre.pcre_exec ~rex x); true match pcre_exec_opt ~rex x with
with Not_found -> false | Some _ -> true
| None -> false
let extract_email = let extract_email =
let rex = Pcre.regexp ~flags:[`CASELESS] ("<(" ^ email_rex ^ ")>") in let rex = Pcre.regexp ~flags:[`CASELESS] ("<(" ^ email_rex ^ ")>") in
...@@ -301,10 +304,9 @@ let extract_email = ...@@ -301,10 +304,9 @@ let extract_email =
if is_email x then if is_email x then
Some x Some x
else ( else (
try match pcre_exec_opt ~rex x with
let s = Pcre.exec ~rex x in | Some s -> Some (Pcre.get_substring s 1)
Some (Pcre.get_substring s 1) | None -> None
with Not_found -> None
) )
let file_exists x = let file_exists x =
......
...@@ -119,6 +119,8 @@ val get_languages : string list option -> string list ...@@ -119,6 +119,8 @@ val get_languages : string list option -> string list
val string_of_languages : string list option -> string val string_of_languages : string list option -> string
val languages_of_string : string -> string list val languages_of_string : string -> string list
val pcre_exec_opt : rex:Pcre.regexp -> string -> Pcre.substrings option
val is_email : string -> bool val is_email : string -> bool
val extract_email : string -> string option val extract_email : string -> string option
......
...@@ -66,13 +66,11 @@ let () = ...@@ -66,13 +66,11 @@ let () =
gdpr_uri := Some uri gdpr_uri := Some uri
| Element ("server", attrs, []) -> | Element ("server", attrs, []) ->
let set attr setter = let set attr setter =
try match List.assoc_opt attr attrs with
let mail = List.assoc attr attrs in | Some mail ->
if is_email mail then if is_email mail then setter mail
setter mail else Printf.ksprintf failwith "%s is not a valid e-mail address" mail
else | None -> ()
Printf.ksprintf failwith "%s is not a valid e-mail address" mail
with Not_found -> ()
in in
set "mail" (fun x -> server_mail := x); set "mail" (fun x -> server_mail := x);
set "return-path" (fun x -> return_path := Some x); set "return-path" (fun x -> return_path := Some x);
......
...@@ -273,7 +273,7 @@ let get_ballot_by_hash uuid hash = ...@@ -273,7 +273,7 @@ let get_ballot_by_hash uuid hash =
match%lwt get_election_state uuid with match%lwt get_election_state uuid with
| `Archived -> | `Archived ->
let%lwt ballots = archived_ballots_cache#find uuid in let%lwt ballots = archived_ballots_cache#find uuid in
(try Some (StringMap.find hash ballots) with Not_found -> None) |> return return (StringMap.find_opt hash ballots)
| _ -> | _ ->
let%lwt ballot = read_file ~uuid ("ballots" / urlize hash) in let%lwt ballot = read_file ~uuid ("ballots" / urlize hash) in
match ballot with match ballot with
...@@ -313,7 +313,7 @@ let replace_ballot uuid hash ballot = ...@@ -313,7 +313,7 @@ let replace_ballot uuid hash ballot =
let compute_encrypted_tally uuid = let compute_encrypted_tally uuid =
let%lwt election = get_raw_election uuid in let%lwt election = get_raw_election uuid in
match election with match election with
| None -> Lwt.fail Not_found | None -> return None
| Some election -> | Some election ->
let election = Election.of_string election in let election = Election.of_string election in
let module W = (val Election.get_group election) in let module W = (val Election.get_group election) in
...@@ -328,7 +328,7 @@ let compute_encrypted_tally uuid = ...@@ -328,7 +328,7 @@ let compute_encrypted_tally uuid =
in in
let tally = string_of_encrypted_tally E.G.write tally in let tally = string_of_encrypted_tally E.G.write tally in
let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in
return (num_tallied, sha256_b64 tally, tally) return (Some (num_tallied, sha256_b64 tally, tally))
module ExtendedRecordsCacheTypes = struct module ExtendedRecordsCacheTypes = struct
type key = uuid type key = uuid
...@@ -368,7 +368,7 @@ let extended_records_cache = ...@@ -368,7 +368,7 @@ let extended_records_cache =
let find_extended_record uuid username = let find_extended_record uuid username =
let%lwt rs = extended_records_cache#find uuid in let%lwt rs = extended_records_cache#find uuid in
return (try Some (StringMap.find username rs) with Not_found -> None) return (StringMap.find_opt username rs)
let add_extended_record uuid username r = let add_extended_record uuid username r =
let%lwt rs = extended_records_cache#find uuid in let%lwt rs = extended_records_cache#find uuid in
......
...@@ -71,7 +71,7 @@ val get_ballot_by_hash : uuid -> string -> string option Lwt.t ...@@ -71,7 +71,7 @@ val get_ballot_by_hash : uuid -> string -> string option Lwt.t
val add_ballot : uuid -> string -> string Lwt.t val add_ballot : uuid -> string -> string Lwt.t
val replace_ballot : uuid -> string -> string -> string Lwt.t val replace_ballot : uuid -> string -> string -> string Lwt.t
val compute_encrypted_tally : uuid -> (int * string * string) Lwt.t val compute_encrypted_tally : uuid -> (int * string * string) option Lwt.t
val find_extended_record : uuid -> string -> (datetime * string) option Lwt.t val find_extended_record : uuid -> string -> (datetime * string) option Lwt.t
val add_extended_record : uuid -> string -> datetime * string -> unit Lwt.t val add_extended_record : uuid -> string -> datetime * string -> unit Lwt.t
......
...@@ -655,11 +655,11 @@ let find_user_id uuid user = ...@@ -655,11 +655,11 @@ let find_user_id uuid user =
let db = Lwt_io.lines_of_file (!spool_dir / uuid_s / "voters.txt") in let db = Lwt_io.lines_of_file (!spool_dir / uuid_s / "voters.txt") in
let%lwt db = Lwt_stream.to_list db in let%lwt db = Lwt_stream.to_list db in
let rec loop = function let rec loop = function
| [] -> Lwt.fail Not_found | [] -> None
| id :: xs -> | id :: xs ->
let _, login = split_identity id in let _, login = split_identity id in
if login = user then return id else loop xs if login = user then Some id else loop xs
in loop db in return (loop db)
let load_password_db uuid = let load_password_db uuid =
let uuid_s = raw_string_of_uuid uuid in let uuid_s = raw_string_of_uuid uuid in
...@@ -686,8 +686,8 @@ let () = ...@@ -686,8 +686,8 @@ let () =
(uuid, ()) |> rewrite_prefix (uuid, ()) |> rewrite_prefix
in in
let service = preapply election_admin uuid in let service = preapply election_admin uuid in
(try%lwt match%lwt find_user_id uuid user with
let%lwt id = find_user_id uuid user in | Some id ->
let langs = get_languages metadata.e_languages in let langs = get_languages metadata.e_languages in
let%lwt db = load_password_db uuid in let%lwt db = load_password_db uuid in
let%lwt x = generate_password metadata langs title url id in let%lwt x = generate_password metadata langs title url id in
...@@ -696,11 +696,10 @@ let () = ...@@ -696,11 +696,10 @@ let () =
T.generic_page ~title:"Success" ~service T.generic_page ~title:"Success" ~service
("A new password has been mailed to " ^ id ^ ".") () ("A new password has been mailed to " ^ id ^ ".") ()
>>= Html.send >>= Html.send
with Not_found -> | None ->
T.generic_page ~title:"Error" ~service T.generic_page ~title:"Error" ~service
(user ^ " is not a registered user for this election.") () (user ^ " is not a registered user for this election.") ()
>>= Html.send >>= Html.send
)
) else forbidden () ) else forbidden ()
) )
) )
...@@ -736,8 +735,9 @@ let identity_rex = Pcre.regexp ...@@ -736,8 +735,9 @@ let identity_rex = Pcre.regexp
"^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}(,[A-Z0-9._%+-]+)?$" "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}(,[A-Z0-9._%+-]+)?$"
let is_identity x = let is_identity x =
try ignore (Pcre.pcre_exec ~rex:identity_rex x); true match pcre_exec_opt ~rex:identity_rex x with
with Not_found -> false | Some _ -> true
| None -> false
let merge_voters a b f = let merge_voters a b f =
let existing = List.fold_left (fun accu sv -> let existing = List.fold_left (fun accu sv ->
...@@ -760,10 +760,10 @@ let () = ...@@ -760,10 +760,10 @@ let () =
else ( else (
let voters = Pcre.split voters in let voters = Pcre.split voters in
let () = let () =
try match List.find_opt (fun x -> not (is_identity x)) voters with
let bad = List.find (fun x -> not (is_identity x)) voters in | Some bad ->
Printf.ksprintf failwith "%S is not a valid identity" bad Printf.ksprintf failwith "%S is not a valid identity" bad
with Not_found -> () | None -> ()
in