From ebafa8b1eac9bff70fd4902d1f13e5b438677280 Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 20 Feb 2026 12:04:36 +0100 Subject: [PATCH] ++ --- src/secmod_rsa.ml | 104 +++++++++++++++++++++++++++++++--------------- 1 file changed, 70 insertions(+), 34 deletions(-) diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 41fb3cad..e7318553 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -5,6 +5,7 @@ open Time module Cfg = Config.Exchange_secmod_rsa type key = { + section_name: string; priv: RsaPrivateKey.t; pub: RsaPublicKey.t; t1: Absolute.t; @@ -14,7 +15,7 @@ type key = { type t = { sm_key_priv: EddsaPrivateKey.t; sm_key_pub: EddsaPublicKey.t; - mutable keys: key list; + mutable denoms: (string * key list) list; } (* -- util -- *) @@ -44,7 +45,7 @@ let key_fpath k = let t1 = time_abs_to_string k.t1 in let t2 = time_abs_to_string k.t2 in let fname = Fmt.str "%s-%s" t1 t2 in - Fpath.(v Cfg.key_dir / fname) + Fpath.(v Cfg.key_dir / k.section_name / fname) (* -- IO -- *) @@ -72,13 +73,13 @@ let delete_key_file k = in () -let get_key_dir_contents dir = - let* dir = Fpath.of_string dir |> unwrap_err_msg in - let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in +let get_key_dir_contents dir_fpath = + let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in if b then - Logs.info (fun m -> m "secmod_rsa: created directory `%a`" Fpath.pp dir); + Logs.info (fun m -> + m "secmod_rsa: created directory `%a`" Fpath.pp dir_fpath); let+ l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg + Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir_fpath |> unwrap_err_msg in l @@ -100,7 +101,7 @@ let split_in_periodes ~start ~end_ = in go acc start end_ -let gen_additional_keys_until_lookahead ~now l = +let gen_additional_keys_until_lookahead ~now (section_name, l) = (* try to _not_ generate keys with validity start in the past (probably not important) *) let start = @@ -115,7 +116,7 @@ let gen_additional_keys_until_lookahead ~now l = (fun (t1, t2) -> (* TODO ~bits is in coin's config *) let priv, pub = RsaPrivateKey.generate ~bits:2048 () in - { priv; pub; t1; t2 }) + { section_name; priv; pub; t1; t2 }) periodes in new_keys @@ -128,7 +129,7 @@ let sm_key_fpath = (* we load sm_key separately we don't accept non-key files in key_dir *) -let load_key fpath = +let load_key ~section_name fpath = match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with | true -> Ok None | false -> ( @@ -137,18 +138,25 @@ let load_key fpath = | Some (t1, t2) -> let* priv = read_rsa fpath in let pub = RsaPrivateKey.pub_of_priv priv in - Ok (Some { priv; pub; t1; t2 })) + Ok (Some { section_name; priv; pub; t1; t2 })) + +let load_section section_fpath = + let section_name = Fpath.filename section_fpath in + let* l = get_key_dir_contents section_fpath in + let* l = list_map (load_key ~section_name) l in + let keys = List.filter_map Fun.id l in + Ok (section_name, keys) let load () = - let* l = get_key_dir_contents Cfg.key_dir in - let* l = list_map load_key l in - let keys = List.filter_map Fun.id l in - match keys with + let* l = get_key_dir_contents (Fpath.v Cfg.key_dir) in + (* TODO check/filter on section_name directories *) + let* denoms = list_map load_section l in + match denoms with | [] -> Ok None | _l -> let* sm_key_priv = read_eddsa sm_key_fpath in let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in - Ok (Some { sm_key_priv; sm_key_pub; keys }) + Ok (Some { sm_key_priv; sm_key_pub; denoms }) let init () = let* opt = load () in @@ -158,13 +166,44 @@ let init () = | None -> let sm_key_priv, sm_key_pub = EddsaPrivateKey.generate () in let* () = write_eddsa sm_key_fpath sm_key_priv in - Ok { sm_key_priv; sm_key_pub; keys= [] } + Ok { sm_key_priv; sm_key_pub; denoms= [] } in + (* TODO read from config *) + let sections = [] in let now = Absolute.of_ptime (Ptime_clock.now ()) in - let new_keys = gen_additional_keys_until_lookahead ~now t.keys in - let+ () = list_iter write_key new_keys in - let keys = sort_keys (t.keys @ new_keys) in - { t with keys } + let news = + List.map + (fun section_name -> + let v = + match List.find_opt (fun (s, _keys) -> s = section_name) t.denoms with + | None -> (section_name, []) + | Some v -> v + in + gen_additional_keys_until_lookahead ~now v) + sections + in + let+ () = list_iter (list_iter write_key) news in + + (* TODO better data structure *) + (* merge new and old *) + let ht = Hashtbl.create 0xff in + let () = + List.iter + (fun (_section_name, keys) -> + List.iter (fun k -> Hashtbl.replace ht k ()) keys) + t.denoms + in + let () = List.iter (List.iter (fun k -> Hashtbl.replace ht k ())) news in + let all = List.of_seq @@ Hashtbl.to_seq_keys ht in + let denoms = + List.map + (fun section_name -> + let keys = List.filter (fun k -> k.section_name = section_name) all in + (section_name, keys)) + sections + in + + { t with denoms } (* --- *) @@ -174,11 +213,18 @@ let t = | Ok t -> t let sm_key_pub = t.sm_key_pub -let keys () = List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) t.keys +let all_keys () = List.map snd t.denoms |> List.concat + +let keys () = + all_keys () + |> List.map (fun { section_name; priv= _; pub; t1; t2 } -> + (section_name, pub, t1, t2)) + let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s let find_key pub = - List.find_opt (fun k -> k.pub = pub) t.keys + all_keys () + |> List.find_opt (fun k -> k.pub = pub) |> Option.to_result ~none:"key not found" let sign ~pub s = @@ -186,14 +232,4 @@ let sign ~pub s = let data = RsaSignature.sign ~key:k.priv s in data -let delete_key pub = - let* k = find_key pub in - let l = List.filter (fun k -> k.pub <> pub) t.keys in - t.keys <- l; - delete_key_file k - -let delete_outdated ~now = - t.keys - |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) - |> List.map (fun k -> k.pub) - |> list_iter delete_key +(* TODO add delete functions *)