Commit de9beb6b authored by Stephane Glondu's avatar Stephane Glondu

Fix conversions of uuids

There was a confusion between atdgen-generated conversion functions
and our own. To avoid the confusion, call our own functions
raw_string_of_uuid and uuid_of_raw_string.
parent 2e840e79
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Platform
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
......@@ -355,7 +356,7 @@ let loadElection () =
let params = P.election.e_params in
setNodeById "election_name" params.e_name;
setNodeById "election_description" params.e_description;
setNodeById "election_uuid" (string_of_uuid params.e_uuid);
setNodeById "election_uuid" (raw_string_of_uuid params.e_uuid);
setNodeById "election_fingerprint" P.election.e_fingerprint;
withElementById "intro" (fun e ->
let b = createStartButton election_params e params.e_questions in
......
......@@ -79,7 +79,7 @@ let remove_dashes x =
module MakeDerive (G : GROUP) = struct
let derive uuid x =
let salt = remove_dashes (string_of_uuid uuid) in
let salt = remove_dashes (raw_string_of_uuid uuid) in
let derived = pbkdf2_hex ~iterations:1000 ~salt x in
Z.(of_string_base 16 derived mod G.q)
......
......@@ -42,9 +42,9 @@ let read_number = make_read "read_number" Z.of_string
(** {1 Serializers for type uuid} *)
let write_uuid = make_write string_of_uuid
let write_uuid = make_write raw_string_of_uuid
let read_uuid = make_read "read_uuid" uuid_of_string
let read_uuid = make_read "read_uuid" uuid_of_raw_string
(** {1 Serializers for type int_or_null} *)
......
......@@ -25,12 +25,12 @@ type number = Z.t
type uuid = string
type int_or_null = int option
let uuid_of_string x =
let uuid_of_raw_string x =
match Uuidm.of_string x with
| Some s -> Uuidm.to_string s
| None -> Printf.ksprintf invalid_arg "%S is not a valid UUID" x
let string_of_uuid x = x
let raw_string_of_uuid x = x
module SSet = Set.Make(String)
......
......@@ -25,8 +25,8 @@ type number = Z.t
type uuid
type int_or_null = int option
val uuid_of_string : string -> uuid
val string_of_uuid : uuid -> string
val uuid_of_raw_string : string -> uuid
val raw_string_of_uuid : uuid -> string
module SSet : Set.S with type elt = string
......
......@@ -42,7 +42,7 @@ end
let parse_params p =
let module P = (val p : PARAMS) in
let module R = struct
let uuid = uuid_of_string P.uuid
let uuid = uuid_of_raw_string P.uuid
module G = (val Group.of_string P.group : GROUP)
end
in (module R : PARSED_PARAMS)
......
......@@ -19,6 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
......@@ -46,7 +47,7 @@ end
let parse_params p =
let module P = (val p : PARAMS) in
let module R = struct
let uuid = uuid_of_string P.uuid
let uuid = uuid_of_raw_string P.uuid
let template = template_of_string P.template
module G = (val Group.of_string P.group : GROUP)
let get_public_keys () =
......
......@@ -22,6 +22,7 @@
open Lwt
open Platform
open Common
open Serializable_builtin_t
open Web_serializable_builtin_t
open Web_serializable_j
......@@ -163,7 +164,7 @@ let election_file = Eliom_parameter.user_type
~to_string:string_of_election_file
let uuid =
Eliom_parameter.user_type ~of_string:uuid_of_string ~to_string:string_of_uuid
Eliom_parameter.user_type ~of_string:uuid_of_raw_string ~to_string:raw_string_of_uuid
let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
......@@ -191,7 +192,7 @@ let string_of_user {user_domain; user_name} =
user_domain ^ ":" ^ user_name
let underscorize x =
String.map (function '-' -> '_' | c -> c) (string_of_uuid x)
String.map (function '-' -> '_' | c -> c) (raw_string_of_uuid x)
let send_email recipient subject body =
let contents =
......
......@@ -21,6 +21,7 @@
open Lwt
open Platform
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
......@@ -67,7 +68,7 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE
send_email email subject body
let do_cast rawballot (user, date) =
let voters = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "voters.txt") in
let voters = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "voters.txt") in
let%lwt voters = Lwt_stream.to_list voters in
let%lwt email, login =
let rec loop = function
......@@ -157,7 +158,7 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE
Ocsipersist.add cred_table new_ None
let do_write f =
Lwt_io.(with_file ~mode:Output (!spool_dir / string_of_uuid uuid / string_of_election_file f))
Lwt_io.(with_file ~mode:Output (!spool_dir / raw_string_of_uuid uuid / string_of_election_file f))
let do_write_ballots () =
do_write ESBallots (fun oc ->
......
......@@ -21,6 +21,7 @@
open Lwt
open Platform
open Serializable_builtin_t
open Serializable_j
open Common
open Web_serializable_j
......@@ -30,7 +31,7 @@ let ( / ) = Filename.concat
let get_election_result uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / string_of_uuid uuid / "result.json") |>
Lwt_io.chars_of_file (!spool_dir / raw_string_of_uuid uuid / "result.json") |>
Lwt_stream.to_string >>= fun x ->
return @@ Some (result_of_string (Yojson.Safe.from_lexbuf ~stream:true) x)
with _ -> return_none
......@@ -46,23 +47,23 @@ type election_state =
let election_states = Ocsipersist.open_table "election_states"
let get_election_state x =
try%lwt Ocsipersist.find election_states (string_of_uuid x)
try%lwt Ocsipersist.find election_states (raw_string_of_uuid x)
with Not_found -> return `Archived
let set_election_state x s =
Ocsipersist.add election_states (string_of_uuid x) s
Ocsipersist.add election_states (raw_string_of_uuid x) s
let past = datetime_of_string "\"2015-10-01 00:00:00.000000\""
let set_election_date uuid d =
let dates = { e_finalization = d } in
Lwt_io.(with_file Output (!spool_dir / string_of_uuid uuid / "dates.json") (fun oc ->
Lwt_io.(with_file Output (!spool_dir / raw_string_of_uuid uuid / "dates.json") (fun oc ->
write_line oc (string_of_election_dates dates)
))
let get_election_date uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / string_of_uuid uuid / "dates.json") |>
Lwt_io.chars_of_file (!spool_dir / raw_string_of_uuid uuid / "dates.json") |>
Lwt_stream.to_string >>= fun x ->
let dates = election_dates_of_string x in
return dates.e_finalization
......@@ -72,17 +73,17 @@ let get_election_date uuid =
let election_pds = Ocsipersist.open_table "election_pds"
let get_partial_decryptions x =
try%lwt Ocsipersist.find election_pds (string_of_uuid x)
try%lwt Ocsipersist.find election_pds (raw_string_of_uuid x)
with Not_found -> return []
let set_partial_decryptions x pds =
Ocsipersist.add election_pds (string_of_uuid x) pds
Ocsipersist.add election_pds (raw_string_of_uuid x) pds
let auth_configs = Ocsipersist.open_table "auth_configs"
let key_of_uuid_option = function
| None -> ""
| Some x -> string_of_uuid x
| Some x -> raw_string_of_uuid x
let get_auth_config x =
try%lwt Ocsipersist.find auth_configs (key_of_uuid_option x)
......@@ -93,7 +94,7 @@ let set_auth_config x c =
let get_raw_election uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "election.json") in
let lines = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "election.json") in
begin match%lwt Lwt_stream.to_list lines with
| x :: _ -> return @@ Some x
| [] -> return_none
......@@ -112,7 +113,7 @@ let return_empty_metadata = return empty_metadata
let get_election_metadata uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / string_of_uuid uuid / "metadata.json") |>
Lwt_io.chars_of_file (!spool_dir / raw_string_of_uuid uuid / "metadata.json") |>
Lwt_stream.to_string >>= fun x ->
return @@ metadata_of_string x
with _ -> return_empty_metadata
......@@ -125,7 +126,7 @@ let get_elections_by_owner user =
return None
else (
try
let uuid = uuid_of_string x in
let uuid = uuid_of_raw_string x in
let%lwt metadata = get_election_metadata uuid in
match metadata.e_owner with
| Some o when o = user -> return (Some uuid)
......@@ -137,14 +138,14 @@ let get_elections_by_owner user =
let get_voters uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "voters.txt") in
let lines = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "voters.txt") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
let get_passwords uuid =
let csv =
try Some (Csv.load (!spool_dir / string_of_uuid uuid / "passwords.csv"))
try Some (Csv.load (!spool_dir / raw_string_of_uuid uuid / "passwords.csv"))
with _ -> None
in
match csv with
......@@ -160,21 +161,21 @@ let get_passwords uuid =
let get_public_keys uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "public_keys.jsons") in
let lines = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "public_keys.jsons") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
let get_private_keys uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "private_keys.jsons") in
let lines = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "private_keys.jsons") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
let get_threshold uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / string_of_uuid uuid / "threshold.json") |>
Lwt_io.chars_of_file (!spool_dir / raw_string_of_uuid uuid / "threshold.json") |>
Lwt_stream.to_string >>= fun x ->
return (Some x)
with _ -> return_none
......@@ -190,7 +191,7 @@ module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes)
let raw_get_ballots_archived uuid =
try%lwt
let ballots = Lwt_io.lines_of_file (!spool_dir / string_of_uuid uuid / "ballots.jsons") in
let ballots = Lwt_io.lines_of_file (!spool_dir / raw_string_of_uuid uuid / "ballots.jsons") in
Lwt_stream.fold (fun b accu ->
let hash = sha256_b64 b in
Ballots.add hash b accu
......
......@@ -21,6 +21,7 @@
open Lwt
open Platform
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
......@@ -75,11 +76,11 @@ let find_election =
fun x -> cache#find x
let get_setup_election uuid =
let%lwt se = Ocsipersist.find election_stable (string_of_uuid uuid) in
let%lwt se = Ocsipersist.find election_stable (raw_string_of_uuid uuid) in
return (setup_election_of_string se)
let set_setup_election uuid se =
Ocsipersist.add election_stable (string_of_uuid uuid) (string_of_setup_election se)
Ocsipersist.add election_stable (raw_string_of_uuid uuid) (string_of_setup_election se)
let dump_passwords dir table =
Lwt_io.(with_file Output (dir / "passwords.csv") (fun oc ->
......@@ -89,7 +90,7 @@ let dump_passwords dir table =
))
let finalize_election uuid se =
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
(* voters *)
let () =
if se.se_voters = [] then failwith "no voters"
......@@ -261,7 +262,7 @@ let cleanup_file f =
with _ -> return_unit
let archive_election uuid =
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let uuid_u = underscorize uuid in
let%lwt () = cleanup_table ~uuid_s "election_states" in
let%lwt () = cleanup_table ~uuid_s "site_tokens_decrypt" in
......@@ -319,7 +320,7 @@ let () = Html5.register ~service:admin
Ocsipersist.fold_step (fun k v accu ->
let v = setup_election_of_string v in
if v.se_owner = u then
return ((uuid_of_string k, v.se_questions.t_name) :: accu)
return ((uuid_of_raw_string k, v.se_questions.t_name) :: accu)
else return accu
) election_stable []
in
......@@ -334,7 +335,7 @@ let () = File.register ~service:source_code
let generate_uuid =
let gen = Uuidm.v4_gen (Random.State.make_self_init ()) in
fun () -> uuid_of_string (Uuidm.to_string (gen ()))
fun () -> uuid_of_raw_string (Uuidm.to_string (gen ()))
let redir_preapply s u () = Redirection.send (preapply s u)
......@@ -349,7 +350,7 @@ let create_new_election owner cred auth =
| `CAS server -> Some [{auth_system = "cas"; auth_instance = "cas"; auth_config = ["server", server]}]
in
let uuid = generate_uuid () in
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let%lwt token = generate_token () in
let se_metadata = {
e_owner = Some owner;
......@@ -586,7 +587,7 @@ let () =
let langs = get_languages metadata.e_languages in
let%lwt x = generate_password langs title url user in
Ocsipersist.add table user x >>
dump_passwords (!spool_dir / string_of_uuid uuid) table >>
dump_passwords (!spool_dir / raw_string_of_uuid uuid) table >>
T.generic_page ~title:"Success" ~service
("A new password has been mailed to " ^ user ^ ".") ()
>>= Html5.send
......@@ -705,7 +706,7 @@ let () =
let%lwt st_token = generate_token () in
let trustee = {st_id; st_token; st_public_key = ""} in
se.se_public_keys <- se.se_public_keys @ [trustee];
let%lwt () = Ocsipersist.add election_pktokens st_token (string_of_uuid uuid) in
let%lwt () = Ocsipersist.add election_pktokens st_token (raw_string_of_uuid uuid) in
redir_preapply election_setup_trustees uuid ()
) else (
let msg = st_id ^ " is not a valid e-mail address!" in
......@@ -739,7 +740,7 @@ let () =
Html5.register ~service:election_setup_credentials
(fun token () ->
let%lwt uuid = Ocsipersist.find election_credtokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
let%lwt se = get_setup_election uuid in
T.election_setup_credentials token uuid se ()
)
......@@ -759,11 +760,11 @@ let wrap_handler f =
let handle_credentials_post token creds =
let%lwt uuid = Ocsipersist.find election_credtokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
let%lwt se = get_setup_election uuid in
if se.se_public_creds_received then forbidden () else
let module G = (val Group.of_string se.se_group : GROUP) in
let fname = !spool_dir / string_of_uuid uuid ^ ".public_creds.txt" in
let fname = !spool_dir / raw_string_of_uuid uuid ^ ".public_creds.txt" in
Lwt_mutex.with_lock
election_setup_mutex
(fun () ->
......@@ -853,7 +854,7 @@ let () =
) S.empty se.se_voters
in
let creds = S.elements creds in
let fname = !spool_dir / string_of_uuid uuid ^ ".public_creds.txt" in
let fname = !spool_dir / raw_string_of_uuid uuid ^ ".public_creds.txt" in
let%lwt () =
Lwt_io.with_file
~flags:(Unix.([O_WRONLY; O_NONBLOCK; O_CREAT; O_TRUNC]))
......@@ -873,7 +874,7 @@ let () =
Html5.register ~service:election_setup_trustee
(fun token () ->
let%lwt uuid = Ocsipersist.find election_pktokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
let%lwt se = get_setup_election uuid in
T.election_setup_trustee token uuid se ()
)
......@@ -884,7 +885,7 @@ let () =
wrap_handler
(fun () ->
let%lwt uuid = Ocsipersist.find election_pktokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
Lwt_mutex.with_lock
election_setup_mutex
(fun () ->
......@@ -936,7 +937,7 @@ let () =
Any.register ~service:election_setup_import_post
(fun uuid from ->
with_setup_election uuid (fun se ->
let from_s = string_of_uuid from in
let from_s = raw_string_of_uuid from in
let%lwt voters = Web_persist.get_voters from in
let%lwt passwords = Web_persist.get_passwords from in
let get_password =
......@@ -980,7 +981,7 @@ let () =
Any.register ~service:election_setup_import_trustees_post
(fun uuid from ->
with_setup_election uuid (fun se ->
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let%lwt metadata = Web_persist.get_election_metadata from in
let%lwt threshold = Web_persist.get_threshold from in
let%lwt public_keys = Web_persist.get_public_keys from in
......@@ -1099,7 +1100,7 @@ let () =
let () =
Any.register ~service:election_admin
(fun (uuid, ()) () ->
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let%lwt w = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in
let%lwt site_user = Web_state.get_site_user () in
......@@ -1274,7 +1275,7 @@ let () =
Any.register ~service:election_missing_voters
(fun (uuid, ()) () ->
with_site_user (fun u ->
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let%lwt w = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
......@@ -1314,7 +1315,7 @@ let () =
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
let records = Lwt_io.lines_of_file
(!spool_dir / string_of_uuid uuid / string_of_election_file ESRecords)
(!spool_dir / raw_string_of_uuid uuid / string_of_election_file ESRecords)
in
let%lwt records = Lwt_stream.fold (fun r accu ->
let s = Pcre.exec ~rex r in
......@@ -1329,7 +1330,7 @@ let () =
let find_trustee_id uuid token =
try%lwt
let%lwt tokens = Ocsipersist.find election_tokens_decrypt (string_of_uuid uuid) in
let%lwt tokens = Ocsipersist.find election_tokens_decrypt (raw_string_of_uuid uuid) in
let rec find i = function
| [] -> raise Not_found
| t :: ts -> if t = token then i else find (i+1) ts
......@@ -1391,7 +1392,7 @@ let () =
in
let pk = pks.(trustee_id-1).trustee_public_key in
let pd = partial_decryption_of_string W.G.read partial_decryption in
let et = !spool_dir / string_of_uuid uuid / string_of_election_file ESETally in
let et = !spool_dir / raw_string_of_uuid uuid / string_of_election_file ESETally in
let%lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in
let et = encrypted_tally_of_string W.G.read et in
if E.check_factor et pk pd then (
......@@ -1409,7 +1410,7 @@ let () =
let handle_election_tally_release (uuid, ()) () =
with_site_user (fun u ->
let uuid_s = string_of_uuid uuid in
let uuid_s = raw_string_of_uuid uuid in
let%lwt w = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val w) in
......@@ -1502,7 +1503,7 @@ let handle_pseudo_file uuid w f site_user =
) else return ()
in
let content_type = content_type_of_file f in
File.send ~content_type (!spool_dir / string_of_uuid uuid / string_of_election_file f)
File.send ~content_type (!spool_dir / raw_string_of_uuid uuid / string_of_election_file f)
let () =
Any.register ~service:election_dir
......@@ -1540,7 +1541,7 @@ let () =
Web_persist.set_election_state uuid (`EncryptedTally (npks, nb, hash)) >>
(* compute partial decryption and release tally
if the (single) key is known *)
let skfile = !spool_dir / string_of_uuid uuid / "private_key.json" in
let skfile = !spool_dir / raw_string_of_uuid uuid / "private_key.json" in
if npks = 1 && Sys.file_exists skfile then (
let%lwt sk = Lwt_io.lines_of_file skfile |> Lwt_stream.to_list in
let sk = match sk with
......@@ -1609,7 +1610,7 @@ let () =
| Some t -> Some (t @ [trustee])
in
se.se_threshold_trustees <- trustees;
let%lwt () = Ocsipersist.add election_tpktokens stt_token (string_of_uuid uuid) in
let%lwt () = Ocsipersist.add election_tpktokens stt_token (raw_string_of_uuid uuid) in
redir_preapply election_setup_threshold_trustees uuid ()
) else (
let msg = stt_id ^ " is not a valid e-mail address!" in
......@@ -1649,7 +1650,7 @@ let () =
Html5.register ~service:election_setup_threshold_trustee
(fun token () ->
let%lwt uuid = Ocsipersist.find election_tpktokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
let%lwt se = get_setup_election uuid in
T.election_setup_threshold_trustee token uuid se ()
)
......@@ -1660,7 +1661,7 @@ let () =
wrap_handler
(fun () ->
let%lwt uuid = Ocsipersist.find election_tpktokens token in
let uuid = uuid_of_string uuid in
let uuid = uuid_of_raw_string uuid in
Lwt_mutex.with_lock election_setup_mutex
(fun () ->
let%lwt se = get_setup_election uuid in
......
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Lwt
open Serializable_builtin_t
open Serializable_j
open Signatures
open Common
......@@ -992,7 +993,7 @@ let election_setup_credentials token uuid se () =
~a:[a_style "display:none;"]
[
div [pcdata "UUID:"];
div [unsafe_textarea "uuid" (string_of_uuid uuid)];
div [unsafe_textarea "uuid" (raw_string_of_uuid uuid)];
div [pcdata "Group parameters:"];
div [unsafe_textarea "group" se.se_group];
]
......@@ -1184,13 +1185,13 @@ let election_setup_importer ~service ~title uuid (elections, tallied, archived)
let format_election election =
let module W = (val election : ELECTION_DATA) in
let name = W.election.e_params.e_name in
let uuid_s = string_of_uuid W.election.e_params.e_uuid in
let uuid_s = raw_string_of_uuid W.election.e_params.e_uuid in
let form = post_form ~service
(fun from ->
[
div [pcdata name; pcdata " ("; pcdata uuid_s; pcdata ")"];
div [
user_type_input string_of_uuid
user_type_input raw_string_of_uuid
~input_type:`Hidden
~name:from
~value:W.election.e_params.e_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