JJ: Description from the destination commit:

+ secmod load and init

JJ: Description from source commit:
++
This commit is contained in:
swrup 2026-02-20 08:24:22 +01:00
parent 355efa8b0f
commit 92e6103737
3 changed files with 185 additions and 62 deletions

View file

@ -1,10 +1,10 @@
open Parse_config open Parse_config
let config_filename = "mte.conf" let config_filename = "mte.conf"
(* TODO config : rm *)
let secrets_dir = Fpath.v "secrets" let secrets_dir = Fpath.v "secrets"
let secmod_dir = Fpath.(secrets_dir / "secmod") let secmod_dir = Fpath.(secrets_dir / "secmod")
(* TODO config *)
let secmod_eddsa_dir = Fpath.(secrets_dir / "secmod_eddsa") let secmod_eddsa_dir = Fpath.(secrets_dir / "secmod_eddsa")
let config_data = let config_data =
@ -190,7 +190,9 @@ module Exchange_secmod_rsa = struct
let lookahead_sign = get "lookahead_sign" |> duration let lookahead_sign = get "lookahead_sign" |> duration
let overlap_duration = get "overlap_duration" |> duration let overlap_duration = get "overlap_duration" |> duration
(* not relevant: sm_priv_key key_dir unixpath *) let duration = get "duration" |> duration
let sm_priv_key = get "sm_priv_key"
let key_dir = get "key_dir"
end end
module Exchange_secmod_eddsa = struct module Exchange_secmod_eddsa = struct
@ -201,27 +203,8 @@ module Exchange_secmod_eddsa = struct
let lookahead_sign = get "lookahead_sign" |> duration let lookahead_sign = get "lookahead_sign" |> duration
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 sm_priv_key = get "sm_priv_key"
(* TODO config let key_dir = get "key_dir"
LOOKAHEAD_SIGN
How long do we generate denomination and signing keys ahead of time?
OVERLAP_DURATION
How much should validity periods for coins overlap? Should be long enough to avoid problems with wallets picking one key and then due to network latency another key being valid. The DURATION_WITHDRAW period must be longer than this value.
DURATION
For how long should EdDSA keys be valid for signing?
SM_PRIV_KEY
Where should the security module store its long-term private key?
KEY_DIR
Where should the security module store the private keys it manages?
UNIXPATH
On which path should the security module listen for signing requests?
*)
end end
(* -- *) (* -- *)

View file

@ -1,60 +1,198 @@
open Syntax open Syntax
open Crypto open Crypto
open Time
let read fname = Bos.OS.File.read fname |> unwrap_err_msg
let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
let read_eddsa fname =
let* data = read fname in
EddsaPrivateKey.of_octets data
let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
module Config = struct
(* TODO config *)
open Config.Exchange_secmod_eddsa
let dir = Config.secmod_eddsa_dir
let lookahead_sign = lookahead_sign
let overlap_duration = overlap_duration
let duration = duration
end
open Mirage_crypto_ec open Mirage_crypto_ec
module Cfg = Config.Exchange_secmod_eddsa
type priv = Ed25519.priv type priv = Ed25519.priv
type pub = Ed25519.pub type pub = Ed25519.pub
type t = { type key = {
priv: priv; priv: priv;
pub: pub; pub: pub;
start: Timestamp.t; t1: Absolute.t;
end_: Timestamp.t; t2: Absolute.t;
} }
(* type t = {
create dir if not exists sm_key_priv: priv;
read dir contents sm_key_pub: pub;
init sm_key mutable keys: key list;
check filename }
build sorted list
check overlaps
just fail if not good
add keys until lookahead
let time_abs_of_string s =
match int_of_string_opt s with
| None -> None
| Some n ->
let ts = Absolute.of_s (Int64.of_int n) in
Some ts
let t1_t2_of_filename fname =
match String.split_on_char '-' fname with
| [] -> Fmt.failwith "not possible"
| [ t1; t2 ] -> (
match (time_abs_of_string t1, time_abs_of_string t2) with
| None, _ | _, None -> None
| Some t1, Some t2 -> Some (t1, t2))
| _ -> None
- sign let time_abs_to_string abs =
- verify abs
- expose future_sk list |> Timestamp.of_absolute
- purge |> Timestamp.to_s
|> Option.get
|> Int64.to_int
|> string_of_int
let key_filename k =
let t1 = time_abs_to_string k.t1 in
let t2 = time_abs_to_string k.t2 in
Fmt.str "%s-%s" t1 t2
let read_key fname =
let fpath = Fpath.(v Cfg.key_dir / fname) in
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
EddsaPrivateKey.of_octets data
let write_eddsa fname priv =
let fpath = Fpath.(v Cfg.key_dir / fname) in
let data = EddsaPrivateKey.to_octets priv in
Bos.OS.File.write fpath data |> unwrap_err_msg
let write_key k = write_eddsa (key_filename k) k.priv
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
let split_in_periodes ~start ~end_ =
(* no overlap on first periode *)
let t1 = start in
let t2 = Absolute.add start Cfg.duration in
let acc = [ (t1, t2) ] in
let start = t2 in
let rec go acc start end_ =
let t1 = Absolute.sub start Cfg.overlap_duration in
let t2 = Absolute.add start Cfg.duration in
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
in
go acc start end_
let gen_additional_keys_until_lookahead ~now l =
(* try to _not_ generate keys with validity start in the past
(probably not important) *)
let start =
match List.rev (sort_keys l) with
| [] -> now
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
in
let end_ = Absolute.add now Cfg.lookahead_sign in
let periodes = split_in_periodes ~start ~end_ in
let new_keys =
List.map
(fun (t1, t2) ->
let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
{ priv; pub; t1; t2 })
periodes
in
new_keys
let check_periodes _l =
(* TODO *)
Ok ()
(* we load sm_key separately
we don't accept non-key files in key_dir *)
let load_key fpath =
let fname = Fpath.filename fpath in
match fname = Cfg.sm_priv_key with
| true -> Ok None
| false -> (
match t1_t2_of_filename fname with
| None -> Fmt.error "invalid filename `%s`" fname
| Some (t1, t2) ->
let* priv = read_key fname in
let pub = EddsaPrivateKey.pub_of_priv priv in
Ok (Some { priv; pub; t1; t2 }))
let load () =
let dir = Fpath.v Cfg.key_dir in
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
if b then
Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
let* l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
in
let* l = list_map load_key l in
let keys = List.filter_map Fun.id l in
match keys with
| [] -> Ok None
| _l ->
let* sm_key_priv = read_key Cfg.sm_priv_key in
let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
Ok (Some { sm_key_priv; sm_key_pub; keys })
let init () =
let* opt = load () in
let* t =
match opt with
| Some t -> Ok t
| None ->
let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
let* () = write_eddsa Cfg.sm_priv_key sm_key_priv in
Ok { sm_key_priv; sm_key_pub; keys= [] }
in
let now = Absolute.of_ptime (Ptime_clock.now ()) in
let* () = check_periodes t.keys 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
let t = { t with keys } in
Ok t
(* --- *)
let t =
match init () with
| Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
| 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 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
|> Option.to_result ~none:"key not found"
let sign ~pub s =
let+ k = find_key pub in
let data = EddsaSignature.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;
(* rm file *)
let fname = key_filename k in
let fpath = Fpath.(v Cfg.key_dir / fname) in
let* () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
Ok ()
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
- sign: check time
- schedule tasks - schedule tasks
- !lock - !lock
todo taler doc/config is confusing taler doc/config is confusing
how is computed stamp_expire stamp_end how is computed stamp_expire stamp_end
what to do of 'Exchange.signkey_legal_duration' what to do of 'Exchange.signkey_legal_duration'
=> (??) =>
stamp_expire = stamp_start + duration stamp_expire = stamp_start + duration
stamp_end = stamp_start + signkey_legal_duration stamp_end = stamp_start + signkey_legal_duration
(not sure about it)
*) *)

View file

@ -7,6 +7,8 @@ let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
let unwrap_err_caqti o = let unwrap_err_caqti o =
match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
(* TODO list_filter_map *)
let list_iter f l = let list_iter f l =
let err = ref None in let err = ref None in
try try