JJ: Description from the destination commit:
+ secmod load and init JJ: Description from source commit: ++
This commit is contained in:
parent
355efa8b0f
commit
92e6103737
3 changed files with 185 additions and 62 deletions
|
|
@ -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
|
||||||
|
|
||||||
(* -- *)
|
(* -- *)
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
*)
|
*)
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue