web_persist.ml 6.46 KB
Newer Older
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2018 Inria                                           *)
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

22
open Lwt
23
open Platform
24
open Serializable_builtin_t
25
open Serializable_j
26
open Common
27
open Web_serializable_j
28
open Web_common
29

30 31 32
let ( / ) = Filename.concat

let get_election_result uuid =
33 34 35
  match%lwt read_file ~uuid "result.json" with
  | Some [x] -> return (Some (result_of_string Yojson.Safe.read_json x))
  | _ -> return_none
36

37 38 39
type election_state =
  [ `Open
  | `Closed
40
  | `EncryptedTally of int * int * string
41
  | `Tallied of plaintext
42
  | `Archived
43 44
  ]

45 46 47
let election_states = Ocsipersist.open_table "election_states"

let get_election_state x =
48
  try%lwt Ocsipersist.find election_states (raw_string_of_uuid x)
49
  with Not_found -> return `Archived
50 51

let set_election_state x s =
52
  Ocsipersist.add election_states (raw_string_of_uuid x) s
53

54 55
let past = datetime_of_string "\"2015-10-01 00:00:00.000000\""

56
let set_election_date uuid d =
57 58
  let dates = string_of_election_dates { e_finalization = d } in
  write_file ~uuid "dates.json" [dates]
59

60
let get_election_date uuid =
61 62 63 64 65
  match%lwt read_file ~uuid "dates.json" with
  | Some [x] ->
     let dates = election_dates_of_string x in
     return dates.e_finalization
  | _ -> return past
66

67 68 69
let election_pds = Ocsipersist.open_table "election_pds"

let get_partial_decryptions x =
70
  try%lwt Ocsipersist.find election_pds (raw_string_of_uuid x)
71 72 73
  with Not_found -> return []

let set_partial_decryptions x pds =
74
  Ocsipersist.add election_pds (raw_string_of_uuid x) pds
75 76 77

let auth_configs = Ocsipersist.open_table "auth_configs"

78 79
let key_of_uuid_option = function
  | None -> ""
80
  | Some x -> raw_string_of_uuid x
81

82
let get_auth_config x =
83
  try%lwt Ocsipersist.find auth_configs (key_of_uuid_option x)
84 85 86
  with Not_found -> return []

let set_auth_config x c =
87
  Ocsipersist.add auth_configs (key_of_uuid_option x) c
88

89
let get_raw_election uuid =
90 91 92
  match%lwt read_file ~uuid "election.json" with
  | Some [x] -> return (Some x)
  | _ -> return_none
93

94 95 96 97 98
let empty_metadata = {
  e_owner = None;
  e_auth_config = None;
  e_cred_authority = None;
  e_trustees = None;
99
  e_languages = None;
100
  e_contact = None;
101 102 103 104
}

let return_empty_metadata = return empty_metadata

105
let get_election_metadata uuid =
106 107 108
  match%lwt read_file ~uuid "metadata.json" with
  | Some [x] -> return (metadata_of_string x)
  | _ -> return_empty_metadata
109

110 111
let get_elections_by_owner user =
  Lwt_unix.files_of_directory !spool_dir |>
112 113 114 115 116 117
    Lwt_stream.filter_map_s
      (fun x ->
        if x = "." || x = ".." then
          return None
        else (
          try
118
            let uuid = uuid_of_raw_string x in
119 120 121 122 123 124 125 126
            let%lwt metadata = get_election_metadata uuid in
            match metadata.e_owner with
            | Some o when o = user -> return (Some uuid)
            | _ -> return None
          with _ -> return None
        )
      ) |>
    Lwt_stream.to_list
127 128

let get_voters uuid =
129
  read_file ~uuid "voters.txt"
130 131 132

let get_passwords uuid =
  let csv =
133
    try Some (Csv.load (!spool_dir / raw_string_of_uuid uuid / "passwords.csv"))
134 135 136 137 138 139 140 141 142 143 144 145
    with _ -> None
  in
  match csv with
  | None -> return_none
  | Some csv ->
     let res = List.fold_left (fun accu line ->
       match line with
       | [login; salt; hash] ->
          SMap.add login (salt, hash) accu
       | _ -> accu
     ) SMap.empty csv in
     return @@ Some res
146

147
let get_public_keys uuid =
148
  read_file ~uuid "public_keys.jsons"
149

150 151 152 153 154
let get_private_key uuid =
  match%lwt read_file ~uuid "private_key.json" with
  | Some [x] -> return (Some (number_of_string x))
  | _ -> return_none

155
let get_private_keys uuid =
156
  read_file ~uuid "private_keys.jsons"
157

158
let get_threshold uuid =
159 160 161
  match%lwt read_file ~uuid "threshold.json" with
  | Some [x] -> return (Some x)
  | _ -> return_none
162

163 164 165
module Ballots = Map.Make (String)

module BallotsCacheTypes = struct
166
  type key = uuid
167 168 169 170 171 172
  type value = string Ballots.t
end

module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes)

let raw_get_ballots_archived uuid =
173 174 175 176 177 178 179 180 181
  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
182 183 184 185

let archived_ballots_cache =
  new BallotsCache.cache raw_get_ballots_archived 10

186
let get_ballot_hashes uuid =
187
  match%lwt get_election_state uuid with
188
  | `Archived ->
189
     let%lwt ballots = archived_ballots_cache#find uuid in
190 191 192 193 194 195 196
     Ballots.bindings ballots |> List.map fst |> return
  | _ ->
     let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
     Ocsipersist.fold_step (fun hash _ accu ->
       return (hash :: accu)
     ) table [] >>= (fun x -> return @@ List.rev x)

197
let get_ballot_by_hash uuid hash =
198
  match%lwt get_election_state uuid with
199
  | `Archived ->
200
     let%lwt ballots = archived_ballots_cache#find uuid in
201 202 203
     (try Some (Ballots.find hash ballots) with Not_found -> None) |> return
  | _ ->
     let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
204
     try%lwt Ocsipersist.find table hash >>= (fun x -> return @@ Some x)
205
     with Not_found -> return_none