From 3405f9e4efae7129d68e5652291916e97b216a8f Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 20 Feb 2026 11:04:09 +0100 Subject: [PATCH] + wip copypasta secmod_rsa --- src/crypto.ml | 6 ++ src/secmod_eddsa.ml | 16 ++-- src/secmod_rsa.ml | 199 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 211 insertions(+), 10 deletions(-) create mode 100644 src/secmod_rsa.ml diff --git a/src/crypto.ml b/src/crypto.ml index 99cabfea..dce8e925 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -119,6 +119,7 @@ module EddsaPrivateKey = struct type t = priv + let generate = generate let pub_of_priv = pub_of_priv let to_octets t = priv_to_octets t @@ -251,9 +252,14 @@ module RsaSignature : sig type t val jsont : t Jsont.t + val sign : key:RsaPrivateKey.t -> string -> string end = struct type t = string + (* TODO crypto + this is a placeholder signature algorithm *) + let sign ~key s = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key s + let jsont = let of_b32 s = B32.decode s in let to_b32 t = B32.encode t in diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index e995a054..2aabf687 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -1,22 +1,18 @@ open Syntax open Crypto open Time -open Mirage_crypto_ec module Cfg = Config.Exchange_secmod_eddsa -type priv = Ed25519.priv -type pub = Ed25519.pub - type key = { - priv: priv; - pub: pub; + priv: EddsaPrivateKey.t; + pub: EddsaPublicKey.t; t1: Absolute.t; t2: Absolute.t; } type t = { - sm_key_priv: priv; - sm_key_pub: pub; + sm_key_priv: EddsaPrivateKey.t; + sm_key_pub: EddsaPublicKey.t; mutable keys: key list; } @@ -108,7 +104,7 @@ let gen_additional_keys_until_lookahead ~now l = let new_keys = List.map (fun (t1, t2) -> - let priv, pub = Mirage_crypto_ec.Ed25519.generate () in + let priv, pub = EddsaPrivateKey.generate () in { priv; pub; t1; t2 }) periodes in @@ -150,7 +146,7 @@ let init () = match opt with | Some t -> Ok t | None -> - let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in + let sm_key_priv, sm_key_pub = EddsaPrivateKey.generate () in let* () = write_eddsa sm_key_fpath sm_key_priv in Ok { sm_key_priv; sm_key_pub; keys= [] } in diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml new file mode 100644 index 00000000..41fb3cad --- /dev/null +++ b/src/secmod_rsa.ml @@ -0,0 +1,199 @@ +(* TODO refacto common parts with secmod_eddsa *) +open Syntax +open Crypto +open Time +module Cfg = Config.Exchange_secmod_rsa + +type key = { + priv: RsaPrivateKey.t; + pub: RsaPublicKey.t; + t1: Absolute.t; + t2: Absolute.t; +} + +type t = { + sm_key_priv: EddsaPrivateKey.t; + sm_key_pub: EddsaPublicKey.t; + mutable keys: key list; +} + +(* -- util -- *) + +let time_abs_of_string s = + int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) + +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_eddsa fpath = + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + EddsaPrivateKey.of_octets data + +let read_rsa fpath = + let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + RsaPrivateKey.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_rsa fpath priv = + let data = RsaPrivateKey.to_octets priv in + Bos.OS.File.write fpath data |> unwrap_err_msg + +let write_key k = write_rsa (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_rsa: 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_ = + assert (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) -> + (* TODO ~bits is in coin's config *) + let priv, pub = RsaPrivateKey.generate ~bits:2048 () in + { priv; pub; t1; t2 }) + periodes + in + new_keys + +let sm_key_fpath = + Result.get_ok + @@ + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + Fpath.normalize fpath + +(* we load sm_key separately + we don't accept non-key files in key_dir *) +let load_key fpath = + match Fpath.equal (Fpath.normalize fpath) sm_key_fpath 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_rsa fpath in + let pub = RsaPrivateKey.pub_of_priv priv in + Ok (Some { priv; pub; t1; t2 })) + +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_eddsa 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 = EddsaPrivateKey.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 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 + { t with keys } + +(* --- *) + +let t = + match init () with + | Error e -> Fmt.failwith "secmod_rsa 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 = RsaSignature.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; + delete_key_file k + +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