diff --git a/src/config.ml b/src/config.ml index e7066f5c..eb7973b5 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,10 +1,10 @@ open Parse_config let config_filename = "mte.conf" + +(* TODO config : rm *) let secrets_dir = Fpath.v "secrets" let secmod_dir = Fpath.(secrets_dir / "secmod") - -(* TODO config *) let secmod_eddsa_dir = Fpath.(secrets_dir / "secmod_eddsa") let config_data = @@ -190,7 +190,9 @@ module Exchange_secmod_rsa = struct let lookahead_sign = get "lookahead_sign" |> 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 module Exchange_secmod_eddsa = struct @@ -201,27 +203,8 @@ module Exchange_secmod_eddsa = struct let lookahead_sign = get "lookahead_sign" |> duration let overlap_duration = get "overlap_duration" |> duration let duration = get "duration" |> duration - - (* TODO config -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? - *) + let sm_priv_key = get "sm_priv_key" + let key_dir = get "key_dir" end (* -- *) diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index e8f71342..bd46794a 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -1,60 +1,213 @@ open Syntax open Crypto - -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 Time open Mirage_crypto_ec +module Cfg = Config.Exchange_secmod_eddsa type priv = Ed25519.priv type pub = Ed25519.pub -type t = { +type key = { priv: priv; pub: pub; - start: Timestamp.t; - end_: Timestamp.t; + t1: Absolute.t; + t2: Absolute.t; } -(* - create dir if not exists - read dir contents - init sm_key - check filename - build sorted list - check overlaps - just fail if not good - add keys until lookahead +type t = { + sm_key_priv: priv; + sm_key_pub: pub; + mutable keys: key list; +} +(* -- util -- *) +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 - - sign - - verify - - expose future_sk list - - purge +let t1_t2_of_fpath fpath = + let fname = Fpath.filename fpath in + 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 + +let time_abs_to_string abs = + abs + |> Timestamp.of_absolute + |> Timestamp.to_s + |> Option.get + |> Int64.to_int + |> string_of_int + +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) + +(* -- IO -- *) + +let read_key fpath = + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let write_eddsa fpath priv = + let data = EddsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_eddsa (key_fpath k) k.priv + +let delete_key_file k = + let+ () = + Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg + 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 + 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 + l + +(* -- *) + +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 = + match Fpath.filename fpath = Cfg.sm_priv_key with + | true -> Ok None + | false -> ( + match t1_t2_of_fpath fpath with + | None -> Fmt.error "invalid file `%a`" Fpath.pp fpath + | Some (t1, t2) -> + let* priv = read_key fpath in + let pub = EddsaPrivateKey.pub_of_priv priv in + Ok (Some { priv; pub; t1; t2 })) + +let sm_key_fpath = Fpath.(v Cfg.key_dir / Cfg.sm_priv_key) + +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 + | [] -> Ok None + | _l -> + let* sm_key_priv = read_key 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 }) + +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 sm_key_fpath 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; + let+ () = delete_key_file k in + () + +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 - !lock - todo taler doc/config is confusing + taler doc/config is confusing how is computed stamp_expire stamp_end what to do of 'Exchange.signkey_legal_duration' - => (??) + => stamp_expire = stamp_start + duration stamp_end = stamp_start + signkey_legal_duration + (not sure about it) *) diff --git a/src/syntax.ml b/src/syntax.ml index c61aba15..426d9ac0 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -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 = 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 err = ref None in try