secmod ok

This commit is contained in:
swrup 2026-03-19 07:30:01 +01:00
parent c30fc5c059
commit c3e947213b
4 changed files with 42 additions and 57 deletions

View file

@ -225,7 +225,7 @@ module Exchange_secmod_rsa = struct
(* 8.3 filenames for FAT *) (* 8.3 filenames for FAT *)
let key_dir = "rsa" |> spath let key_dir = "rsa" |> spath
let sm_priv_key = "rsa/sm_key" |> spath let sm_priv_key = "sm_rsa" |> spath
end end
module Exchange_secmod_eddsa = struct module Exchange_secmod_eddsa = struct
@ -237,7 +237,7 @@ module Exchange_secmod_eddsa = struct
let overlap_duration = get "overlap_duration" |> duration let overlap_duration = get "overlap_duration" |> duration
let duration = get "duration" |> duration let duration = get "duration" |> duration
let key_dir = "eddsa" |> spath let key_dir = "eddsa" |> spath
let sm_priv_key = "eddsa/sm_key" |> spath let sm_priv_key = "sm_eddsa" |> spath
end end
(* -- *) (* -- *)

View file

@ -238,8 +238,21 @@ module RsaPrivateKey = struct
let of_octets = Binary_format_rsa.priv_of_octets let of_octets = Binary_format_rsa.priv_of_octets
let to_octets = Binary_format_rsa.priv_to_octets let to_octets = Binary_format_rsa.priv_to_octets
(* we use Bin.cstring because size of key (~bits) can change depending on section_name
we also have to b32 encode/decode our octets because of null-char
enforce all to be of the same size instead? *)
let bin = let bin =
let of_octets_exn t = of_octets t |> Result.get_ok in let of_octets_exn s =
let res =
let* s = B32.decode s in
of_octets s
in
match res with
| Error e -> Fmt.failwith "RsaPrivateKey.bin decoding failure: %s." e
| Ok t -> t
in
let to_octets t = to_octets t |> B32.encode in
Bin.map Bin.cstring of_octets_exn to_octets Bin.map Bin.cstring of_octets_exn to_octets
let jsont = let jsont =

View file

@ -4,6 +4,9 @@
schedule tasks schedule tasks
sign: check timestamps before signing *) sign: check timestamps before signing *)
(* IMPROVE (* IMPROVE
Bin encode/decode
- catch failure
- should use little-endian
list_issue_date: save timestamp of key generation list_issue_date: save timestamp of key generation
key validity period: key validity period:
more checks + do not exceed lookahead more checks + do not exceed lookahead
@ -71,26 +74,17 @@ let read_key fs spath =
let k = Bin.decode key_bin data (ref 0) in let k = Bin.decode key_bin data (ref 0) in
Ok k Ok k
let write_key fs spath k = let write_key fs k =
let spath = key_spath k in
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath); Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
let data = Bin.to_string key_bin k in let data = Bin.to_string key_bin k in
Fat.write fs spath data |> unwrap_msg Fat.write fs spath data |> unwrap_msg
let write_key fs k = write_key fs (key_spath k) k
let delete_file fs spath = let delete_file fs spath =
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath); Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
let+ () = Fat.remove fs spath |> unwrap_msg in let+ () = Fat.remove fs spath |> unwrap_msg in
() ()
let get_key_dir_contents fs dir =
Log.debug (fun m -> m "get_key_dir_contents `%a`" Spath.pp dir);
let* () = Fat.mkdir fs dir |> unwrap_msg in
let+ l = Fat.ls fs dir |> unwrap_msg in
let l = List.map (fun entry -> entry.Fat.name) l in
let l = List.map (Spath.add dir) l in
l
let gen_key t1 t2 = let gen_key t1 t2 =
let priv, pub = EddsaPrivateKey.generate () in let priv, pub = EddsaPrivateKey.generate () in
let k = { priv; pub; t1; t2 } in let k = { priv; pub; t1; t2 } in
@ -128,7 +122,13 @@ let gen_additional_keys_until_lookahead ~now l =
new_keys new_keys
let load fs = let load fs =
let* l = get_key_dir_contents fs Cfg.key_dir in let* () =
if Fat.exists fs Cfg.key_dir then Ok ()
else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
in
let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
let l = List.map (fun entry -> entry.Fat.name) l in
let l = List.map (Spath.add Cfg.key_dir) l in
let l = let l =
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
in in

View file

@ -13,15 +13,7 @@ module Cfg = struct
open Config open Config
include Exchange_secmod_rsa include Exchange_secmod_rsa
(* TODO section_name *)
let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name) let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
(*
|> list_map Sfn.of_string
|> unwrap_msg
|> function
| Error e -> Fmt.failwith "invalid section_name %s" e
| Ok l -> l
*)
(* helper functions to get config value from section_name: *) (* helper functions to get config value from section_name: *)
@ -77,7 +69,9 @@ let key_bin =
|> sealr |> sealr
let key_spath k = let key_spath k =
let sfn_res = String.sub (RsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in let sfn_res =
String.sub (DenominationHash.to_b32 k.h_pub) 0 8 |> Sfn.of_string
in
match sfn_res with match sfn_res with
| Error _ -> failwith "not possible" | Error _ -> failwith "not possible"
| Ok sfn -> Spath.(Cfg.key_dir / sfn) | Ok sfn -> Spath.(Cfg.key_dir / sfn)
@ -97,34 +91,20 @@ let write_eddsa fs spath priv =
let read_key fs spath = let read_key fs spath =
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
let* data = Fat.read fs spath |> unwrap_msg in let* data = Fat.read fs spath |> unwrap_msg in
(* todo: catch failure *)
let k = Bin.decode key_bin data (ref 0) in let k = Bin.decode key_bin data (ref 0) in
Ok k Ok k
let read_rsa fs spath = let write_key fs k =
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath); let spath = key_spath k in
let* data = Fat.read fs spath |> unwrap_msg in Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
RsaPrivateKey.of_octets data let data = Bin.to_string key_bin k in
let write_rsa fs spath priv =
let data = RsaPrivateKey.to_octets priv in
Fat.write fs spath data |> unwrap_msg Fat.write fs spath data |> unwrap_msg
let write_key fs k = write_rsa fs (key_spath k) k.priv
let delete_file fs spath = let delete_file fs spath =
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath); Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
let+ () = Fat.remove fs spath |> unwrap_msg in let+ () = Fat.remove fs spath |> unwrap_msg in
() ()
let get_key_dir_contents fs dir =
Log.debug (fun m -> m "get_key_dir_contents `%a`" Spath.pp dir);
let* () = Fat.mkdir fs dir |> unwrap_msg in
let+ l = Fat.ls fs dir |> unwrap_msg in
let l = List.map (fun entry -> entry.Fat.name) l in
let l = List.map (Spath.add dir) l in
l
(* -- *) (* -- *)
let gen_key ~section_name t1 t2 = let gen_key ~section_name t1 t2 =
@ -153,8 +133,6 @@ let split_in_periodes ~start ~end_ ~duration_withdraw =
go acc start end_ go acc start end_
let gen_additional_keys_until_lookahead ~now ~section_name 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 = let start =
match List.rev (sort_keys l) with match List.rev (sort_keys l) with
| [] -> now | [] -> now
@ -170,24 +148,18 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
in in
new_keys new_keys
let load_section fs section_name = let load fs =
(* TODO section_name *) let* () =
let section_name = if Fat.exists fs Cfg.key_dir then Ok ()
match Sfn.of_string section_name with else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
| Error (`Msg e) -> Fmt.failwith "invalid section_name %s" e
| Ok sfn -> sfn
in in
let section_spath = Spath.(Cfg.key_dir / section_name) in let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
let* l = get_key_dir_contents fs section_spath in let l = List.map (fun entry -> entry.Fat.name) l in
let l = List.map (Spath.add Cfg.key_dir) l in
let l = let l =
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
in in
let* keys = list_map (read_key fs) l in let* keys = list_map (read_key fs) l in
Ok keys
let load fs =
let* keys_l = list_map (load_section fs) Cfg.sections in
let keys = List.concat keys_l in
match keys with match keys with
| [] -> Ok None | [] -> Ok None
| _l -> | _l ->