Commit 6c62906c authored by Stephane Glondu's avatar Stephane Glondu Committed by Stéphane Glondu

Change (mostly) style of exception catching

parent 58a4ded7
......@@ -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_result () =
load_from_file (fun x -> x) (X.dir/"result.json") |> function
......
......@@ -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
......
......@@ -43,8 +43,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
p2##querySelector (Js.string ".question_blank") >>= fun q_blank ->
Dom_html.CoerceTo.input q_blank >>= fun q_blank ->
......
......@@ -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"
......
......@@ -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
......
......@@ -47,10 +47,9 @@ let get_election_result uuid =
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 =
......@@ -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]
......@@ -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
......
......@@ -530,16 +530,16 @@ let with_draft_election ?(save = true) uuid f =
match%lwt Web_persist.get_draft_election uuid with
| None -> fail_http 404
| Some se ->
if se.se_owner = u then (
try%lwt
let%lwt r = f se in
let%lwt () = if save then Web_persist.set_draft_election uuid se else return_unit in
return r
with e ->
let msg = match e with Failure s -> s | _ -> Printexc.to_string e in
let service = preapply election_draft uuid in
T.generic_page ~title:"Error" ~service msg () >>= Html.send
) else forbidden ()
if se.se_owner = u then (
match%lwt f se with
| r ->
let%lwt () = if save then Web_persist.set_draft_election uuid se else return_unit in
return r
| exception e ->
let msg = match e with Failure s -> s | _ -> Printexc.to_string e in
let service = preapply election_draft uuid in
T.generic_page ~title:"Error" ~service msg () >>= Html.send
) else forbidden ()
)
)
......@@ -887,8 +887,7 @@ let () =
)
let wrap_handler f =
try%lwt f ()
with
try%lwt f () with
| e -> T.generic_page ~title:"Error" (Printexc.to_string e) () >>= Html.send
let handle_credentials_post uuid token creds =
......@@ -1077,11 +1076,10 @@ let () =
Any.register ~service:election_draft_create
(fun uuid () ->
with_draft_election ~save:false uuid (fun se ->
try%lwt
let%lwt () = validate_election uuid se in
redir_preapply election_admin uuid ()
with e ->
T.new_election_failure (`Exception e) () >>= Html.send
match%lwt validate_election uuid se with
| () -> redir_preapply election_admin uuid ()
| exception e ->
T.new_election_failure (`Exception e) () >>= Html.send
)
)
......@@ -1238,24 +1236,26 @@ let () =
let () =
Any.register ~service:election_home
(fun (uuid, ()) () ->
try%lwt
let%lwt w = find_election uuid in
let%lwt () = Eliom_reference.unset Web_state.ballot in
match%lwt Eliom_reference.get Web_state.cast_confirmed with
| Some result ->
let%lwt () = Eliom_reference.unset Web_state.cast_confirmed in
let%lwt () = Eliom_reference.unset Web_state.election_user in
T.cast_confirmed w ~result () >>= Html.send
| None ->
let%lwt state = Web_persist.get_election_state uuid in
T.election_home w state () >>= Html.send
with Not_found ->
let%lwt lang = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang lang) in
T.generic_page ~title:L.not_yet_open
~service:(preapply election_home (uuid, ()))
L.come_back_later ()
>>= Html.send)
match%lwt find_election uuid with
| w ->
let%lwt () = Eliom_reference.unset Web_state.ballot in
(match%lwt Eliom_reference.get Web_state.cast_confirmed with
| Some result ->
let%lwt () = Eliom_reference.unset Web_state.cast_confirmed in
let%lwt () = Eliom_reference.unset Web_state.election_user in
T.cast_confirmed w ~result () >>= Html.send
| None ->
let%lwt state = Web_persist.get_election_state uuid in
T.election_home w state () >>= Html.send
)
| exception Not_found ->
let%lwt lang = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang lang) in
T.generic_page ~title:L.not_yet_open
~service:(preapply election_home (uuid, ()))
L.come_back_later ()
>>= Html.send
)
let get_cont_state cont =
let redir = match cont with
......@@ -1321,19 +1321,17 @@ let election_set_result_hidden f uuid x =
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
try%lwt
let%lwt () = Web_persist.set_election_result_hidden uuid (f x) in
redir_preapply election_admin uuid ()
with
| Failure msg ->
match%lwt Web_persist.set_election_result_hidden uuid (f x) with
| () -> redir_preapply election_admin uuid ()
| exception Failure msg ->
let service = preapply election_admin uuid in
T.generic_page ~title:"Error" ~service msg () >>= Html.send
) else forbidden ()
)
let parse_datetime_from_post x =
try datetime_of_string ("\"" ^ x ^ ".000000\"")
with _ -> Printf.ksprintf failwith "%s is not a valid date!" x
try datetime_of_string ("\"" ^ x ^ ".000000\"") with
| _ -> Printf.ksprintf failwith "%s is not a valid date!" x
let () =
Any.register ~service:election_hide_result
......@@ -1425,10 +1423,9 @@ let () =
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
try%lwt
let%lwt () = Web_persist.replace_credential uuid old new_ in
String.send ("OK", "text/plain")
with BeleniosWebError e ->
match%lwt Web_persist.replace_credential uuid old new_ with
| () -> String.send ("OK", "text/plain")
| exception BeleniosWebError e ->
let%lwt lang = Eliom_reference.get Web_state.language in
let l = Web_i18n.get_lang lang in
String.send ("Error: " ^ explain_error l e, "text/plain")
......@@ -1479,15 +1476,11 @@ let () =
T.generic_page ~title:L.cookies_are_blocked L.please_enable_them ()
>>= Html.send
| Some ballot ->
match
try
let ballot = ballot_of_string Yojson.Safe.read_json ballot in
Some ballot.election_uuid
with _ -> None
with
| None ->
match ballot_of_string Yojson.Safe.read_json ballot with
| exception _ ->
T.generic_page ~title:"Error" "Ill-formed ballot" () >>= Html.send
| Some uuid ->
| ballot ->
let uuid = ballot.election_uuid in
match%lwt Web_persist.get_draft_election uuid with
| Some _ -> redir_preapply election_draft uuid ()
| None -> redir_preapply election_login ((uuid, ()), None) ()
......@@ -1554,10 +1547,9 @@ let () =
| None -> forbidden ()
| Some user ->
let%lwt result =
try%lwt
let%lwt hash = cast_ballot uuid ~rawballot ~user in
return (Ok hash)
with BeleniosWebError e -> return (Error e)
match%lwt cast_ballot uuid ~rawballot ~user with
| hash -> return (Ok hash)
| exception BeleniosWebError e -> return (Error e)
in
let%lwt () = Eliom_reference.set Web_state.cast_confirmed (Some result) in
redir_preapply election_home (uuid, ()) ()
......
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