JJ: Description from the destination commit:

+

JJ: Description from source commit:
.
This commit is contained in:
swrup 2026-02-20 08:52:17 +01:00
parent 38b42406e4
commit f9cc34c956

View file

@ -1,8 +1,8 @@
open Syntax open Syntax
open Crypto open Crypto
open Mirage_crypto_ec
open Config.Exchange_secmod_eddsa
open Time open Time
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
@ -17,7 +17,7 @@ type key = {
type t = { type t = {
sm_key_priv: priv; sm_key_priv: priv;
sm_key_pub: pub; sm_key_pub: pub;
keys: key list; mutable keys: key list;
} }
let time_abs_of_string s = let time_abs_of_string s =
@ -35,32 +35,33 @@ let time_abs_to_string abs =
|> Int64.to_int |> Int64.to_int
|> string_of_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 read_key fname =
let fpath = Fpath.(v key_dir / fname) in let fpath = Fpath.(v Cfg.key_dir / fname) in
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
EddsaPrivateKey.of_octets data EddsaPrivateKey.of_octets data
let write_eddsa fname priv = let write_eddsa fname priv =
let fpath = Fpath.(v key_dir / fname) in let fpath = Fpath.(v Cfg.key_dir / fname) in
let data = EddsaPrivateKey.to_octets priv in let data = EddsaPrivateKey.to_octets priv in
Bos.OS.File.write fpath data |> unwrap_err_msg Bos.OS.File.write fpath data |> unwrap_err_msg
let write_key t = let write_key k = write_eddsa (key_filename k) k.priv
let t1 = time_abs_to_string t.t1 in
let t2 = time_abs_to_string t.t2 in
let fname = Fmt.str "%s-%s" t1 t2 in
write_eddsa fname t.priv
let split_in_periodes ~start ~end_ = let split_in_periodes ~start ~end_ =
(* no overlap on first periode (* no overlap on first periode
this is to not generate a key valid in the past *) this is to not generate a key valid in the past *)
let t1 = start in let t1 = start in
let t2 = Absolute.add start duration in let t2 = Absolute.add start Cfg.duration in
let acc = [ (t1, t2) ] in let acc = [ (t1, t2) ] in
let start = t2 in let start = t2 in
let rec go acc start end_ = let rec go acc start end_ =
let t1 = Absolute.sub start overlap_duration in let t1 = Absolute.sub start Cfg.overlap_duration in
let t2 = Absolute.add start duration in let t2 = Absolute.add start Cfg.duration in
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_ if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
in in
go acc start end_ go acc start end_
@ -73,9 +74,9 @@ let gen_additional_keys_until_lookahead ~now l =
let l_rev = List.rev l in let l_rev = List.rev l in
match l_rev with match l_rev with
| [] -> now | [] -> now
| hd :: _ -> Absolute.sub hd.t2 overlap_duration | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
in in
let end_ = Absolute.add now lookahead_sign in let end_ = Absolute.add now Cfg.lookahead_sign in
let periodes = split_in_periodes ~start ~end_ in let periodes = split_in_periodes ~start ~end_ in
let new_keys = let new_keys =
List.map List.map
@ -108,7 +109,7 @@ let purge_outdated ~now l =
let load_key fpath = let load_key fpath =
let fname = Fpath.filename fpath in let fname = Fpath.filename fpath in
if fname = sm_priv_key then Ok None if fname = Cfg.sm_priv_key then Ok None
else else
match String.split_on_char '-' fname with match String.split_on_char '-' fname with
| [] -> Fmt.failwith "not possible" | [] -> Fmt.failwith "not possible"
@ -122,7 +123,7 @@ let load_key fpath =
| _ -> Ok None | _ -> Ok None
let load () = let load () =
let dir = Fpath.v key_dir in let dir = Fpath.v Cfg.key_dir in
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
if b then if b then
Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir); Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
@ -134,7 +135,7 @@ let load () =
match keys with match keys with
| [] -> Ok None | [] -> Ok None
| _l -> | _l ->
let* sm_key_priv = read_key sm_priv_key in let* sm_key_priv = read_key Cfg.sm_priv_key in
let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv 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; keys })
@ -145,7 +146,7 @@ let init () =
| Some t -> Ok t | Some t -> Ok t
| None -> | None ->
let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
let* () = write_eddsa sm_priv_key sm_key_priv in let* () = write_eddsa Cfg.sm_priv_key sm_key_priv in
Ok { sm_key_priv; sm_key_pub; keys= [] } Ok { sm_key_priv; sm_key_pub; keys= [] }
in in
let now = Absolute.of_ptime (Ptime_clock.now ()) in let now = Absolute.of_ptime (Ptime_clock.now ()) in
@ -163,15 +164,36 @@ let t =
| Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
| Ok t -> t | Ok t -> t
(* let sm_key_pub = t.sm_key_pub
- sign let keys () = List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) t.keys
- expose future_sk list let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
- purge
- revoke let sign ~pub s =
match List.find_opt (fun k -> k.pub = pub) t.keys with
| None -> Error "key not found"
| Some k ->
let data = EddsaSignature.sign ~key:k.priv s in
Ok data
let delete_key ~pub =
let k = List.find_opt (fun k -> k.pub = pub) t.keys in
match k with
| None -> Error "key not found"
| Some k ->
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
()
(* 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'
=> (??) => (??)