Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit dbfd371f authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Rename Web_common.Error into BeleniosWebError

The name was conflicting with Pervasives.Error.
parent 0dfe307a
......@@ -82,12 +82,12 @@ let do_add_account ~db_fname ~username ~password ~email () =
let hashed = sha256_hex (salt ^ password) in
let rec append accu = function
| [] -> Ok (List.rev ([username; salt; hashed; email] :: accu))
| (u :: _ :: _ :: _) :: _ when u = username -> Pervasives.Error UsernameTaken
| (_ :: _ :: _ :: e :: _) :: _ when e = email -> Pervasives.Error AddressTaken
| (u :: _ :: _ :: _) :: _ when u = username -> Error UsernameTaken
| (_ :: _ :: _ :: e :: _) :: _ when e = email -> Error AddressTaken
| x :: xs -> append (x :: accu) xs
in
match append [] db with
| Pervasives.Error _ as x -> Lwt.return x
| Error _ as x -> Lwt.return x
| Ok db ->
let db = List.map (String.concat ",") db in
let%lwt () = write_file db_fname db in
......@@ -119,18 +119,18 @@ let is_username =
let add_account ~username ~password ~email =
if is_username username then
match%lwt Web_signup.cracklib_check password with
| Some e -> return (Pervasives.Error (BadPassword e))
| Some e -> return (Error (BadPassword e))
| None ->
match get_password_db_fname () with
| None -> forbidden ()
| Some db_fname ->
Lwt_mutex.with_lock password_db_mutex
(do_add_account ~db_fname ~username ~password ~email)
else return (Pervasives.Error BadUsername)
else return (Error BadUsername)
let change_password ~username ~password =
match%lwt Web_signup.cracklib_check password with
| Some e -> return (Pervasives.Error e)
| Some e -> return (Error e)
| None ->
match get_password_db_fname () with
| None -> forbidden ()
......
......@@ -70,9 +70,9 @@ type error =
| UnauthorizedVoter
| CastError of cast_error
exception Error of error
exception BeleniosWebError of error
let fail e = Lwt.fail (Error e)
let fail e = Lwt.fail (BeleniosWebError e)
let explain_error l e =
let module L = (val l : Web_i18n_sig.LocalizedStrings) in
......
......@@ -42,7 +42,7 @@ type error =
| UnauthorizedVoter
| CastError of cast_error
exception Error of error
exception BeleniosWebError of error
val fail : error -> 'a Lwt.t
......
......@@ -482,7 +482,7 @@ let replace_credential uuid old_ new_ =
StringMap.fold (fun k v accu ->
if sha256_hex k = old_ then (
match v with
| Some _ -> raise (Error UsedCredential)
| Some _ -> raise (BeleniosWebError UsedCredential)
| None -> Some k
) else accu
) xs None
......@@ -502,16 +502,16 @@ let do_cast_ballot election ~rawballot ~user date =
try
if String.contains rawballot '\n' then invalid_arg "multiline ballot";
Ok (ballot_of_string E.G.read rawballot)
with e -> Pervasives.Error (ECastSerialization e)
with e -> Error (ECastSerialization e)
with
| Pervasives.Error _ as x -> return x
| Error _ as x -> return x
| Ok ballot ->
match ballot.signature with
| None -> return (Pervasives.Error ECastMissingCredential)
| None -> return (Error ECastMissingCredential)
| Some s ->
let credential = E.G.to_string s.s_public_key in
match%lwt find_credential_mapping uuid credential with
| None -> return (Pervasives.Error ECastInvalidCredential)
| None -> return (Error ECastInvalidCredential)
| Some old_cred ->
let%lwt old_record = find_extended_record uuid user in
match old_cred, old_record with
......@@ -522,7 +522,7 @@ let do_cast_ballot election ~rawballot ~user date =
let%lwt () = add_credential_mapping uuid credential (Some hash) in
let%lwt () = add_extended_record uuid user (date, credential) in
return (Ok (hash, false))
) else return (Pervasives.Error ECastProofCheck)
) else return (Error ECastProofCheck)
| Some hash, Some (_, old_credential) ->
(* revote *)
if credential = old_credential then (
......@@ -531,10 +531,10 @@ let do_cast_ballot election ~rawballot ~user date =
let%lwt () = add_credential_mapping uuid credential (Some hash) in
let%lwt () = add_extended_record uuid user (date, credential) in
return (Ok (hash, true))
) else return (Pervasives.Error ECastProofCheck)
) else return (Pervasives.Error ECastWrongCredential)
| None, Some _ -> return (Pervasives.Error ECastRevoteNotAllowed)
| Some _, None -> return (Pervasives.Error ECastReusedCredential)
) else return (Error ECastProofCheck)
) else return (Error ECastWrongCredential)
| None, Some _ -> return (Error ECastRevoteNotAllowed)
| Some _, None -> return (Error ECastReusedCredential)
let cast_mutex = Lwt_mutex.create ()
......
......@@ -1292,13 +1292,13 @@ let () =
let auto_close = format auto_close in
let open Web_persist in
Ok { auto_open; auto_close }
with Failure e -> Pervasives.Error e
with Failure e -> Error e
in
match auto_dates with
| Ok x ->
let%lwt () = Web_persist.set_election_auto_dates uuid x in
redir_preapply election_admin uuid ()
| Pervasives.Error msg ->
| Error msg ->
let service = preapply election_admin uuid in
T.generic_page ~title:"Error" ~service msg () >>= Html.send
) else forbidden ()
......@@ -1350,7 +1350,7 @@ let () =
try%lwt
let%lwt () = Web_persist.replace_credential uuid old new_ in
String.send ("OK", "text/plain")
with Error e ->
with 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")
......@@ -1440,7 +1440,7 @@ let cast_ballot uuid ~rawballot ~user =
| Ok (hash, revote) ->
let%lwt () = send_confirmation_email uuid revote login email hash in
return hash
| Pervasives.Error e ->
| Error e ->
let msg = match e with
| ECastWrongCredential -> Some "attempted to revote with already used credential"
| ECastRevoteNotAllowed -> Some "attempted to revote using a new credential"
......@@ -1467,7 +1467,7 @@ let () =
try%lwt
let%lwt hash = cast_ballot uuid ~rawballot ~user in
return (`Valid hash)
with Error e -> return (`Error e)
with BeleniosWebError e -> return (`Error e)
in
let%lwt () = Eliom_reference.set Web_state.cast_confirmed (Some result) in
redir_preapply election_home (uuid, ()) ()
......@@ -2218,16 +2218,16 @@ let () =
let%lwt () = Eliom_reference.unset Web_state.signup_address in
T.generic_page ~title:"Account creation" ~service:admin
"The account has been created." () >>= Html.send
| Pervasives.Error UsernameTaken ->
| Error UsernameTaken ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because the username is already taken. Please try again with a different one." () >>= Html.send
| Pervasives.Error AddressTaken ->
| Error AddressTaken ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because there is already an account with this address. Please try again with a different one." () >>= Html.send
| Pervasives.Error BadUsername ->
| Error BadUsername ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because the username is invalid. Please try again with a different one." () >>= Html.send
| Pervasives.Error (BadPassword e) ->
| Error (BadPassword e) ->
Printf.ksprintf
(fun x -> T.generic_page ~title:"Account creation" ~service:signup x () >>= Html.send)
"The account creation failed because the password is too weak (%s). Please try again with a different one"
......@@ -2246,7 +2246,7 @@ let () =
let%lwt () = Eliom_reference.unset Web_state.signup_address in
T.generic_page ~title:"Change password" ~service:admin
"The password has been changed." () >>= Html.send
| Pervasives.Error e ->
| Error e ->
Printf.ksprintf
(fun x -> T.generic_page ~title:"Change password" ~service:signup x () >>= Html.send)
"The password is too weak (%s). Please try again with a different one"
......
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