Skip to content

GitLab

Commit 494a4d54 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Add Web_common.{read,write}_file and use them

parent b785f4aa
Hide whitespace changes
Inline Side-by-side
Showing with 116 additions and 107 deletions
src/web/web_common.ml
View file @ 494a4d54
......@@ -238,3 +238,23 @@ let email_rex = Pcre.regexp
let is_email x =
try ignore (Pcre.pcre_exec ~rex:email_rex x); true
with Not_found -> false
let get_fname uuid x =
match uuid with
| None -> x
| Some uuid ->
let ( / ) = Filename.concat in
!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
let write_file ?uuid x lines =
Lwt_io.(
with_file Output (get_fname uuid x) (fun oc ->
Lwt_list.iter_s (write_line oc) lines
)
)
src/web/web_common.mli
View file @ 494a4d54
......@@ -101,3 +101,6 @@ val string_of_languages : string list option -> string
val languages_of_string : string -> string list
val is_email : string -> bool
val read_file : ?uuid:uuid -> string -> string list option Lwt.t
val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t
src/web/web_election.ml
View file @ 494a4d54
......@@ -65,15 +65,14 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
send_email email subject body
let do_cast rawballot (user, date) =
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 voters = read_file ~uuid "voters.txt" in
let%lwt email, login =
let rec loop = function
| x :: xs ->
let email, login = split_identity x in
if login = user.user_name then return (email, login) else loop xs
| [] -> fail UnauthorizedVoter
in loop voters
in loop (match voters with Some xs -> xs | None -> [])
in
let user = string_of_user user in
let%lwt state = Web_persist.get_election_state uuid in
......
src/web/web_persist.ml
View file @ 494a4d54
......@@ -30,11 +30,9 @@ open Web_common
let ( / ) = Filename.concat
let get_election_result uuid =
try%lwt
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
match%lwt read_file ~uuid "result.json" with
| Some [x] -> return (Some (result_of_string Yojson.Safe.read_json x))
| _ -> return_none
type election_state =
[ `Open
......@@ -56,19 +54,15 @@ let set_election_state 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 / raw_string_of_uuid uuid / "dates.json") (fun oc ->
write_line oc (string_of_election_dates dates)
))
let dates = string_of_election_dates { e_finalization = d } in
write_file ~uuid "dates.json" [dates]
let get_election_date uuid =
try%lwt
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
with _ ->
return past
match%lwt read_file ~uuid "dates.json" with
| Some [x] ->
let dates = election_dates_of_string x in
return dates.e_finalization
| _ -> return past
let election_pds = Ocsipersist.open_table "election_pds"
......@@ -93,13 +87,9 @@ let set_auth_config x c =
Ocsipersist.add auth_configs (key_of_uuid_option x) c
let get_raw_election uuid =
try%lwt
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
end
with _ -> return_none
match%lwt read_file ~uuid "election.json" with
| Some [x] -> return (Some x)
| _ -> return_none
let empty_metadata = {
e_owner = None;
......@@ -112,11 +102,9 @@ let empty_metadata = {
let return_empty_metadata = return empty_metadata
let get_election_metadata uuid =
try%lwt
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
match%lwt read_file ~uuid "metadata.json" with
| Some [x] -> return (metadata_of_string x)
| _ -> return_empty_metadata
let get_elections_by_owner user =
Lwt_unix.files_of_directory !spool_dir |>
......@@ -137,11 +125,7 @@ let get_elections_by_owner user =
Lwt_stream.to_list
let get_voters uuid =
try%lwt
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
read_file ~uuid "voters.txt"
let get_passwords uuid =
let csv =
......@@ -160,25 +144,15 @@ let get_passwords uuid =
return @@ Some res
let get_public_keys uuid =
try%lwt
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
read_file ~uuid "public_keys.jsons"
let get_private_keys uuid =
try%lwt
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
read_file ~uuid "private_keys.jsons"
let get_threshold uuid =
try%lwt
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
match%lwt read_file ~uuid "threshold.json" with
| Some [x] -> return (Some x)
| _ -> return_none
module Ballots = Map.Make (String)
......@@ -190,13 +164,15 @@ end
module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes)
let raw_get_ballots_archived uuid =
try%lwt
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
) ballots Ballots.empty
with _ -> return Ballots.empty
match%lwt read_file ~uuid "ballots.jsons" with
| Some bs ->
return (
List.fold_left (fun accu b ->
let hash = sha256_b64 b in
Ballots.add hash b accu
) Ballots.empty bs
)
| None -> return Ballots.empty
let archived_ballots_cache =
new BallotsCache.cache raw_get_ballots_archived 10
......
src/web/web_site.ml
View file @ 494a4d54
......@@ -205,10 +205,12 @@ let finalize_election uuid se =
(* inject credentials *)
let%lwt () =
let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in
Lwt_io.lines_of_file fname |>
Lwt_stream.iter_s B.inject_cred >>
B.update_files () >>
Lwt_unix.unlink fname
match%lwt read_file fname with
| Some xs ->
Lwt_list.iter_s B.inject_cred xs
>> B.update_files ()
>> Lwt_unix.unlink fname
| None -> return_unit
in
(* create file with private keys, if any *)
let%lwt () =
......@@ -635,8 +637,6 @@ let is_identity x =
try ignore (Pcre.pcre_exec ~rex:identity_rex x); true
with Not_found -> false
module SSet = Set.Make (PString)
let merge_voters a b f =
let existing = List.fold_left (fun accu sv ->
SSet.add sv.sv_id accu
......@@ -768,15 +768,19 @@ let handle_credentials_post token creds =
) >>
let%lwt () =
let i = ref 1 in
Lwt_stream.iter
(fun x ->
try
let x = G.of_string x in
if not (G.check x) then raise Exit;
incr i
with _ ->
Printf.ksprintf failwith "invalid credential at line %d" !i)
(Lwt_io.lines_of_file fname)
match%lwt read_file fname with
| Some xs ->
return (
List.iter (fun x ->
try
let x = G.of_string x in
if not (G.check x) then raise Exit;
incr i
with _ ->
Printf.ksprintf failwith "invalid credential at line %d" !i
) xs
)
| None -> return_unit
in
let () = se.se_metadata <- {se.se_metadata with e_cred_authority = None} in
let () = se.se_public_creds_received <- true in
......@@ -818,7 +822,6 @@ let () =
~absolute:true ~service:election_home
(uuid, ()) |> rewrite_prefix
in
let module S = Set.Make (PString) in
let module G = (val Group.of_string se.se_group : GROUP) in
let module CD = Credential.MakeDerive (G) in
let%lwt creds =
......@@ -843,10 +846,10 @@ let () =
Printf.sprintf L.mail_credential_subject title
in
let%lwt () = send_email email subject body in
return @@ S.add pub_cred accu
) S.empty se.se_voters
return @@ SSet.add pub_cred accu
) SSet.empty se.se_voters
in
let creds = S.elements creds in
let creds = SSet.elements creds in
let fname = !spool_dir / raw_string_of_uuid uuid ^ ".public_creds.txt" in
let%lwt () =
Lwt_io.with_file
......@@ -1262,27 +1265,33 @@ let () =
Any.register ~service:election_missing_voters
(fun (uuid, ()) () ->
with_site_user (fun u ->
let uuid_s = raw_string_of_uuid uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
let voters = Lwt_io.lines_of_file
(!spool_dir / uuid_s / string_of_election_file ESVoters)
let%lwt voters =
match%lwt read_file ~uuid (string_of_election_file ESVoters) with
| Some vs ->
return (
List.fold_left (fun accu v ->
let _, login = split_identity v in
SSet.add login accu
) SSet.empty vs
)
| None -> return SSet.empty
in
let module S = Set.Make (PString) in
let%lwt voters = Lwt_stream.fold (fun v accu ->
let _, login = split_identity v in
S.add login accu
) voters S.empty in
let records = Lwt_io.lines_of_file
(!spool_dir / uuid_s / string_of_election_file ESRecords)
let%lwt voters =
match%lwt read_file ~uuid (string_of_election_file ESRecords) with
| Some rs ->
return (
List.fold_left (fun accu r ->
let s = Pcre.exec ~rex r in
let v = Pcre.get_substring s 1 in
SSet.remove v accu
) voters rs
)
| None -> return voters
in
let%lwt voters = Lwt_stream.fold (fun r accu ->
let s = Pcre.exec ~rex r in
let v = Pcre.get_substring s 1 in
S.remove v accu
) records voters in
let buf = Buffer.create 128 in
S.iter (fun v ->
SSet.iter (fun v ->
Buffer.add_string buf v;
Buffer.add_char buf '\n'
) voters;
......@@ -1299,15 +1308,19 @@ let () =
let%lwt w = find_election uuid in
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 / raw_string_of_uuid uuid / string_of_election_file ESRecords)
let%lwt records =
match%lwt read_file ~uuid (string_of_election_file ESRecords) with
| Some rs ->
return (
List.rev_map (fun r ->
let s = Pcre.exec ~rex r in
let date = Pcre.get_substring s 1 in
let voter = Pcre.get_substring s 2 in
(date, voter)
) rs
)
| None -> return []
in
let%lwt records = Lwt_stream.fold (fun r accu ->
let s = Pcre.exec ~rex r in
let date = Pcre.get_substring s 1 in
let voter = Pcre.get_substring s 2 in
(date, voter) :: accu
) records [] in
T.pretty_records w (List.rev records) () >>= Html5.send
) else forbidden ()
)
......@@ -1451,10 +1464,8 @@ let handle_election_tally_release (uuid, ()) () =
in
let result = E.compute_result ntallied et pds combinator in
let%lwt () =
let open Lwt_io in
with_file
~mode:Output (!spool_dir / uuid_s / string_of_election_file ESResult)
(fun oc -> Lwt_io.write_line oc (string_of_result W.G.write result))
let result = string_of_result W.G.write result in
write_file ~uuid (string_of_election_file ESResult) [result]
in
let%lwt () = Web_persist.set_election_state uuid (`Tallied result.result) in
let%lwt () = Ocsipersist.remove election_tokens_decrypt uuid_s in
......@@ -1525,9 +1536,9 @@ let () =
if the (single) key is known *)
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%lwt sk = read_file skfile in
let sk = match sk with
| [sk] -> number_of_string sk
| Some [sk] -> number_of_string sk
| _ -> failwith "several private keys are available"
in
let tally = encrypted_tally_of_string W.G.read tally in
......
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