diff --git a/data/secmod/.gitkeep b/data/secmod/.gitkeep new file mode 100644 index 00000000..e69de29b diff --git a/src/data_file.ml b/src/data_file.ml index 44b98908..9fa34674 100644 --- a/src/data_file.ml +++ b/src/data_file.ml @@ -3,15 +3,18 @@ open Syntax open Crypto let read fname = - let* b = File.exists fname in + let* b = File.exists fname |> Syntax.unwrap_err_msg in match b with | false -> Ok None | true -> - let+ content = File.read fname in + let+ content = File.read fname |> Syntax.unwrap_err_msg in Some content -let write_eddsa fname priv = EddsaPrivateKey.to_octets priv |> File.write fname -let write_rsa fname priv = RsaPrivateKey.to_octets priv |> File.write fname +let write_eddsa fname priv = + EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg + +let write_rsa fname priv = + RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg let read_eddsa fname = let* opt = read fname in @@ -19,7 +22,7 @@ let read_eddsa fname = | None -> Ok None | Some data -> ( EddsaPrivateKey.of_octets data |> function - | Error err -> Error (`Msg err) + | Error e -> Error e | Ok v -> Ok (Some v)) let read_rsa fname = @@ -28,5 +31,5 @@ let read_rsa fname = | None -> Ok None | Some data -> ( RsaPrivateKey.of_octets data |> function - | Error e -> Error (`Msg e) + | Error e -> Error e | Ok v -> Ok (Some v)) diff --git a/src/secmod.ml b/src/secmod.ml index d56a1c98..8ee41fdc 100644 --- a/src/secmod.ml +++ b/src/secmod.ml @@ -70,14 +70,14 @@ module Make (Conn : Pg.CONN) = struct dn_section_name_ht: (denomination_hash, string) Hashtbl.t; } - let dir = Fpath.(v "data" / "secmod ") + let dir = Fpath.(v "data" / "secmod") let db_lookup_signkey_data conn fname priv = let pub = EddsaPrivateKey.pub_of_priv priv in - let* opt = Pg.find_signkey conn pub in + let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in match opt with | None -> - Fmt.error_msg + Fmt.error "load_signkey error: no associated data found in database for \ signkey `%s`." (Fpath.to_string fname) @@ -86,10 +86,10 @@ module Make (Conn : Pg.CONN) = struct let db_lookup_denom_data conn ~section_name priv = let pub = RsaPrivateKey.pub_of_priv priv in let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in - let* opt = Pg.find_denom conn h_pub in + let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in match opt with | None -> - Fmt.error_msg + Fmt.error "load_denom error no associated metadata found in database for \ denomination `%s`." section_name @@ -106,11 +106,11 @@ module Make (Conn : Pg.CONN) = struct let load conn = let error_invalid_state = - Fmt.error_msg "secmod load error: invalid store state." + Fmt.error "secmod load error: invalid store state." in let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sm_key") in let* signkeys = - let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in + let l = List.init 1 (fun i -> Fpath.(dir / Fmt.str "sk_%d" i)) in let* l = list_map (fun fname -> load_signkey conn fname) l in match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt in @@ -249,18 +249,49 @@ module Make (Conn : Pg.CONN) = struct in { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht } + let store t = + Miou.Mutex.protect t.lock @@ fun () -> + let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in + let* () = + Hashtbl.to_seq_values t.sk_ht + |> List.of_seq + |> List.mapi (fun i (key : signkey) -> + let fname = Fpath.(dir / Fmt.str "sk_%d" i) in + (fname, key.priv)) + |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) + in + let* () = + let* l = + Hashtbl.to_seq_values t.dn_ht + |> List.of_seq + |> Syntax.list_map (fun (key : denom) -> + let+ section_name = + match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with + | None -> Error "invalid state, section_name not found" + | Some s -> Ok s + in + let fname = Fpath.(dir / section_name) in + (fname, key.priv)) + in + list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l + in + Ok () + let t = match load (module Conn) with | Ok None -> let t = make_new () in + let () = + match store t with + | Error e -> Fmt.failwith "secmod storage failure: %s." e + | Ok () -> () + in Logs.info (fun m -> m "secmod initialized with fresh keys"); t - | Ok (Some v) -> + | Ok (Some t) -> Logs.info (fun m -> m "secmod initialized from storage"); - v - | Error _ -> - (* TODO error: pretty print *) - Fmt.failwith "secmod init failure." + t + | Error e -> Fmt.failwith "secmod init failure: %s." e (* note: don't expose a signing function if we want a real "security module" one day *) let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s @@ -369,23 +400,4 @@ module Make (Conn : Pg.CONN) = struct let denom = { denom with dn_data } in Hashtbl.replace t.dn_ht h_denom_pub denom; Ok () - - (* TODO *) - let _store t = - let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in - let* () = - get_signkeys () - |> List.mapi (fun i (key : signkey) -> - let fname = Fpath.(dir / string_of_int i) in - (fname, key.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key) - in - let* () = - get_denoms () - |> List.mapi (fun i (key : denom) -> - let fname = Fpath.(dir / string_of_int i) in - (fname, key.priv)) - |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key) - in - Ok () end