From c287da9bc3507cded275c5c0358464e476d274d8 Mon Sep 17 00:00:00 2001 From: swrup Date: Tue, 17 Feb 2026 16:01:40 +0100 Subject: [PATCH] --- secrets/.keep | 0 src/config.ml | 1 + src/data_file.ml | 32 ++----- src/http_management.ml | 21 ++--- src/secmod.ml | 188 ++++++++++++++++++++--------------------- src/secmod.mli | 2 + 6 files changed, 113 insertions(+), 131 deletions(-) delete mode 100644 secrets/.keep diff --git a/secrets/.keep b/secrets/.keep deleted file mode 100644 index e69de29b..00000000 diff --git a/src/config.ml b/src/config.ml index 3ccc104b..21666cf7 100644 --- a/src/config.ml +++ b/src/config.ml @@ -2,6 +2,7 @@ open Parse_config let config_filename = "mte.conf" let secrets_dir = Fpath.v "secrets" +let secmod_dir = Fpath.(secrets_dir / "secmod") let config_data = match Assets_crunch.read config_filename with diff --git a/src/data_file.ml b/src/data_file.ml index 9fa34674..27526ace 100644 --- a/src/data_file.ml +++ b/src/data_file.ml @@ -2,34 +2,20 @@ open Bos.OS open Syntax open Crypto -let read fname = - let* b = File.exists fname |> Syntax.unwrap_err_msg in - match b with - | false -> Ok None - | true -> - let+ content = File.read fname |> Syntax.unwrap_err_msg in - Some content +let read fname = File.read fname |> unwrap_err_msg let write_eddsa fname priv = - EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg + EddsaPrivateKey.to_octets priv |> File.write fname |> unwrap_err_msg let write_rsa fname priv = - RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg + RsaPrivateKey.to_octets priv |> File.write fname |> unwrap_err_msg let read_eddsa fname = - let* opt = read fname in - match opt with - | None -> Ok None - | Some data -> ( - EddsaPrivateKey.of_octets data |> function - | Error e -> Error e - | Ok v -> Ok (Some v)) + let* data = read fname in + let+ v = EddsaPrivateKey.of_octets data in + v let read_rsa fname = - let* opt = read fname in - match opt with - | None -> Ok None - | Some data -> ( - RsaPrivateKey.of_octets data |> function - | Error e -> Error e - | Ok v -> Ok (Some v)) + let* data = read fname in + let+ v = RsaPrivateKey.of_octets data in + v diff --git a/src/http_management.ml b/src/http_management.ml index 72abe7e1..06e9450b 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -32,15 +32,15 @@ module Keys_get = struct end module Keys_post = struct + let error_key_unknown = + "404 not found, One of the keys for which a signature was provided is \ + unknown to the exchange." + let verify_denom_signature (module Sm : Secmod.S) DenomSignature.{ h_denom_pub; master_sig } = let* denom = - match Sm.find_denomination h_denom_pub with - | None -> - Fmt.error - "404 not found, One of the keys for which a signature was provided \ - is unknown to the exchange." - | Some denom -> Ok denom + Sm.find_future_denomination h_denom_pub + |> Option.to_result ~none:error_key_unknown in let open Signatures.DenominationKeyValidity in let r : r = @@ -63,12 +63,7 @@ module Keys_post = struct let verify_signkey_signature (module Sm : Secmod.S) SignKeySignature.{ key; master_sig } = let* signkey = - match Sm.find_signkey key with - | None -> - Fmt.error - "404 not found, One of the keys for which a signature was provided \ - is unknown to the exchange." - | Some signkey -> Ok signkey + Sm.find_future_signkey key |> Option.to_result ~none:error_key_unknown in let open Signatures.ExchangeSigningKeyValidity in let r : r = @@ -76,7 +71,7 @@ module Keys_post = struct start= signkey.stamp_start; expire= signkey.stamp_expire; end_= signkey.stamp_end; - signkey_pub= signkey.pub; + signkey_pub= signkey.key; } in verify_f ~f:Sm.verify_with_master_key master_sig r diff --git a/src/secmod.ml b/src/secmod.ml index 39c4374b..0a9535c9 100644 --- a/src/secmod.ml +++ b/src/secmod.ml @@ -16,6 +16,8 @@ module type S = sig val get_future_denominations : unit -> Api.FutureDenom.t list val find_signkey : eddsa_pub -> Signkey.t option val find_denomination : denom_hash -> Denomination.t option + val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option + val find_future_denomination : denom_hash -> Api.FutureDenom.t option val certify_future_signkey : eddsa_pub -> @@ -64,11 +66,12 @@ module Make (Conn : Pg.CONN) = struct dn_section_name_ht: (denom_hash, string) Hashtbl.t; } - let sm_key_fname = Fpath.(Config.secrets_dir / "sm_key") - let sk_key_fname i = Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i) + let conn = (module Conn : Pg.CONN) + let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key") + let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i) - let dn_key_fname section_name = - Fpath.(Config.secrets_dir / Fmt.str "dn_%s" section_name) + let dn_fname section_name = + Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name) let database_find_sk conn pub = let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in @@ -85,90 +88,70 @@ module Make (Conn : Pg.CONN) = struct "secmod failure: a denomination could not be found in database" | Some dn_data -> Ok dn_data - (* TODO clean up *) - let load conn = - let error_invalid_state = - Fmt.error "secmod load error: invalid store state." - in + let list_to_ht l = Hashtbl.of_seq (List.to_seq l) + + let load () = let* sm_key = Data_file.read_eddsa sm_key_fname in - let* sk_keys = - let l = List.init 1 sk_key_fname in - let* l = list_map (fun fname -> Data_file.read_eddsa fname) l in - match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt + let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in + + let* sk_keys = list_map Data_file.read_eddsa (List.init 1 sk_fname) in + let* sk_l = + list_map + (fun priv -> + let pub = EddsaPrivateKey.pub_of_priv priv in + let+ sk = database_find_sk conn pub in + ((pub, sk), (pub, priv))) + sk_keys in + let sk_ht, sk_key_ht = + match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2) + in + + let dn_section_name_ht = Hashtbl.create 0xff in let* dn_keys = - let* l = - let open Config.Coin in - list_map - (fun coin -> - let section_name = coin.section_name in - let+ opt = Data_file.read_rsa (dn_key_fname section_name) in - Option.map (fun priv -> (section_name, priv)) opt) - all_coins - in - match Syntax.opt_list l with - | Error () -> error_invalid_state - | Ok opt -> Ok opt + list_map + (fun coin -> + let section_name = coin.Config.Coin.section_name in + let+ priv = Data_file.read_rsa (dn_fname section_name) in + (section_name, priv)) + Config.Coin.all_coins in - match (sm_key, sk_keys, dn_keys) with - | None, None, None -> Ok None - | Some sm_key, Some sk_keys, Some dn_keys -> - let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in - let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in - (* sk *) - let* l = - list_map - (fun priv -> - let pub = EddsaPrivateKey.pub_of_priv priv in - let+ sk = database_find_sk conn pub in - ((pub, sk), (pub, priv))) - sk_keys - in - let sk_ht, sk_key_ht = - let sk_l, priv_l = List.split l in - (list_to_ht sk_l, list_to_ht priv_l) - in - (* dn *) - let dn_section_name_ht = Hashtbl.create 0xff in - let* l = - list_map - (fun (section_name, priv) -> - let h_pub = - priv - |> RsaPrivateKey.pub_of_priv - |> RsaPublicKey.to_octets - |> DenominationHash.hash - in - - (* fill dn_section_name_ht *) - Hashtbl.replace dn_section_name_ht h_pub section_name; - - let+ dn = database_find_dn conn h_pub in - ((h_pub, dn), (h_pub, priv))) - dn_keys - in - let dn_ht, dn_key_ht = - match List.split l with l1, l2 -> (list_to_ht l1, list_to_ht l2) - in - (* future keys are not stored anywhere until they are certified with a master_sig - so we don't have any future key to load *) - let t = - { - sm_key; - sm_pubkey; - sk_ht; - dn_ht; - sk_key_ht; - dn_key_ht; - future_sk_ht= Hashtbl.create 0xff; - future_dn_ht= Hashtbl.create 0xff; - future_sk_key_ht= Hashtbl.create 0xff; - future_dn_key_ht= Hashtbl.create 0xff; - dn_section_name_ht; - } - in - Ok (Some t) - | _, _, _ -> error_invalid_state + let* dn_l = + list_map + (fun (section_name, priv) -> + let h_pub = + priv + |> RsaPrivateKey.pub_of_priv + |> RsaPublicKey.to_octets + |> DenominationHash.hash + in + (* fill dn_section_name_ht *) + Hashtbl.replace dn_section_name_ht h_pub section_name; + let+ dn = database_find_dn conn h_pub in + ((h_pub, dn), (h_pub, priv))) + dn_keys + in + let dn_ht, dn_key_ht = + match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2) + in + (* future keys are not stored anywhere until they are certified with a master_sig + so we don't have any future key to load *) + let t = + { + sm_key; + sm_pubkey; + sk_ht; + dn_ht; + sk_key_ht; + dn_key_ht; + future_sk_ht= Hashtbl.create 0xff; + future_dn_ht= Hashtbl.create 0xff; + future_sk_key_ht= Hashtbl.create 0xff; + future_dn_key_ht= Hashtbl.create 0xff; + dn_section_name_ht; + } + in + Ok t let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s @@ -284,16 +267,29 @@ module Make (Conn : Pg.CONN) = struct List.iter (make_future_dn t) Config.Coin.all_coins; t - let t = - match load (module Conn) with - | Ok None -> + let init () = + let dir = Config.secmod_dir in + let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in + if b then + Logs.info (fun m -> m "secmod: created directory `%a`" Fpath.pp dir); + let* l = + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg + in + match List.is_empty l with + | true -> + Logs.info (fun m -> m "secmod: empty storage, generating fresh keys"); let t = make_new () in - Logs.info (fun m -> m "secmod initialized with fresh keys"); + Ok t + | false -> + Logs.info (fun m -> m "secmod: loading keys from storage"); + load () + + let t = + match init () with + | Error e -> Fmt.failwith "secmod initialization failure: `%s`." e + | Ok t -> + Logs.info (fun m -> m "secmod initialized"); t - | Ok (Some t) -> - Logs.info (fun m -> m "secmod initialized from storage"); - t - | Error e -> Fmt.failwith "secmod init failure: %s." e let sm_pubkey = t.sm_pubkey let sign_with_sm_key s = sign_with_sm_key t s @@ -324,7 +320,9 @@ module Make (Conn : Pg.CONN) = struct t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq let find_signkey pub = Hashtbl.find_opt t.sk_ht pub - let find_denomination pub = Hashtbl.find_opt t.dn_ht pub + let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub + let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub + let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub let certify_future_signkey pub master_sig = match @@ -453,7 +451,7 @@ module Make (Conn : Pg.CONN) = struct let* () = Hashtbl.to_seq_values t.sk_key_ht |> List.of_seq - |> List.mapi (fun i priv -> Data_file.write_eddsa (sk_key_fname i) priv) + |> List.mapi (fun i priv -> Data_file.write_eddsa (sk_fname i) priv) |> list_iter Fun.id in let* () = @@ -465,7 +463,7 @@ module Make (Conn : Pg.CONN) = struct | None -> Error "invalid state, section_name not found" | Some s -> Ok s in - Data_file.write_rsa (dn_key_fname section_name) priv) + Data_file.write_rsa (dn_fname section_name) priv) in Logs.info (fun m -> m "saved secmod private keys data"); Ok () diff --git a/src/secmod.mli b/src/secmod.mli index 9c266a2b..9b3f2b57 100644 --- a/src/secmod.mli +++ b/src/secmod.mli @@ -16,6 +16,8 @@ module type S = sig val get_future_denominations : unit -> Api.FutureDenom.t list val find_signkey : eddsa_pub -> Signkey.t option val find_denomination : denom_hash -> Denomination.t option + val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option + val find_future_denomination : denom_hash -> Api.FutureDenom.t option val certify_future_signkey : eddsa_pub ->