From c570d6933816aab4831d5d92e1670ca6b3ddeb43 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 21 Feb 2026 18:43:47 +0100 Subject: [PATCH] functorize secmod --- src/crypto.ml | 2 +- src/devices.ml | 4 +-- src/keys.ml | 39 ++++++++++++-------- src/keys.mli | 5 +++ src/mod_intf.mli | 33 +++++++++++++++-- src/secmod_eddsa.ml | 84 ++++++++++++++++++++++++------------------- src/secmod_rsa.ml | 86 +++++++++++++++++++++++++-------------------- 7 files changed, 157 insertions(+), 96 deletions(-) diff --git a/src/crypto.ml b/src/crypto.ml index dce8e925..383d86f9 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -252,7 +252,7 @@ module RsaSignature : sig type t val jsont : t Jsont.t - val sign : key:RsaPrivateKey.t -> string -> string + val sign : key:RsaPrivateKey.t -> string -> t end = struct type t = string diff --git a/src/devices.ml b/src/devices.ml index 1d3c702b..15c6d389 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -22,5 +22,5 @@ let keys = let finally _key = () in Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] @@ fun (module Conn : Pg.CONN) (_env : env) -> - let sm : (module Keys.S) = (module Keys.Make (Conn)) in - sm + let keys : (module Keys.S) = (module Keys.Make (Conn)) in + keys diff --git a/src/keys.ml b/src/keys.ml index be6b003e..b3b85902 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -1,17 +1,27 @@ +open Syntax +open Crypto + (* TODO better error type *) type 'a result = ('a, string) Result.t module type S = Mod_intf.KEYS +(* + (Sm_eddsa : Mod_intf.SECMOD_EDDSA) + (Sm_rsa : Mod_intf.SECMOD_RSA) + *) + module Make (Conn : Pg.CONN) = struct let conn = (module Conn : Pg.CONN) - open Syntax - open Crypto + module Sm_eddsa = Secmod_eddsa.Make () + module Sm_rsa = Secmod_rsa.Make () + let secmod_eddsa_pub = Sm_eddsa.sm_pub + let secmod_rsa_pub = Sm_rsa.sm_pub + + (* - *) let master_pub = Config.Exchange.master_public_key - let secmod_rsa_pub = Secmod_rsa.sm_pub - let secmod_eddsa_pub = Secmod_eddsa.sm_pub (* TODO error should be a "key not found", either: @@ -20,12 +30,12 @@ module Make (Conn : Pg.CONN) = struct - bad keyring state *) let sign pub s = - match Secmod_eddsa.sign ~pub s with + match Sm_eddsa.sign pub s with | Error e -> Fmt.failwith "sign failure: %s." e | Ok v -> v let sign_denom pub s = - match Secmod_rsa.sign ~pub s with + match Sm_rsa.sign pub s with | Error e -> Fmt.failwith "sign_denom failure: %s." e | Ok v -> v @@ -49,7 +59,7 @@ module Make (Conn : Pg.CONN) = struct let exchange_pub = pub in let anchor_time = stamp_start in let duration = Timestamp.diff stamp_start stamp_expire in - signf Secmod_eddsa.sign_secmod { exchange_pub; anchor_time; duration } + signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration } in Api.FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } @@ -96,7 +106,7 @@ module Make (Conn : Pg.CONN) = struct let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw in - signf Secmod_rsa.sign_secmod + signf Sm_rsa.sign_secmod { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in FutureDenom. @@ -116,6 +126,7 @@ module Make (Conn : Pg.CONN) = struct } let future_signkeys () = + let l : Sm_eddsa.info list = Sm_eddsa.keys () in let+ l = list_map (fun (pub, t1, t2) -> @@ -131,7 +142,7 @@ module Make (Conn : Pg.CONN) = struct "secmod/database stamp_start mismatch for signkey `%s`" (EddsaPublicKey.to_b32 pub) | true -> Ok None)) - (Secmod_eddsa.keys ()) + l in List.filter_map Fun.id l @@ -163,7 +174,7 @@ module Make (Conn : Pg.CONN) = struct "secmod/database stamp_start mismatch for denomination `%s`" section_name | true -> Ok None)) - (Secmod_rsa.keys ()) + (Sm_rsa.keys ()) in List.filter_map Fun.id l @@ -223,7 +234,7 @@ module Make (Conn : Pg.CONN) = struct } let certify_future_signkey pub master_sig = - Secmod_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub) + Sm_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub) |> function | None -> Error "future signkey not found" | Some (pub, t1, t2) -> @@ -240,7 +251,7 @@ module Make (Conn : Pg.CONN) = struct Ok () let certify_future_denomination h_pub master_sig = - Secmod_rsa.keys () + Sm_rsa.keys () |> List.find_opt (fun (_section_name, pub, _t1, _t2) -> let h_pub' = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in h_pub' = h_pub) @@ -272,7 +283,7 @@ module Make (Conn : Pg.CONN) = struct let revoke_signkey pub revoked_sig = let* opt = find_signkey pub in let* _sk = Option.to_result ~none:"signkey not found" opt in - let* () = Secmod_eddsa.revoke pub in + let* () = Sm_eddsa.revoke pub in let+ () = Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti in @@ -282,7 +293,7 @@ module Make (Conn : Pg.CONN) = struct let* opt = find_denomination h_pub in let* dn = Option.to_result ~none:"denomination not found" opt in let pub = dn.pub in - let* () = Secmod_rsa.revoke pub in + let* () = Sm_rsa.revoke pub in let+ () = Pg.insert_denomination_revocation conn h_pub revoked_sig |> unwrap_err_caqti diff --git a/src/keys.mli b/src/keys.mli index abf3e388..e10a135d 100644 --- a/src/keys.mli +++ b/src/keys.mli @@ -1,3 +1,8 @@ module type S = Mod_intf.KEYS module Make (_ : Pg.CONN) : S + +(* + (_ : Mod_intf.SECMOD_EDDSA) + (_ : Mod_intf.SECMOD_RSA) + *) diff --git a/src/mod_intf.mli b/src/mod_intf.mli index cf0fb2f7..0b12ac00 100644 --- a/src/mod_intf.mli +++ b/src/mod_intf.mli @@ -1,13 +1,13 @@ +open Crypto + type 'a result = ('a, string) Result.t module type KEYS = sig - open Crypto - val master_pub : eddsa_pub val secmod_rsa_pub : eddsa_pub val secmod_eddsa_pub : eddsa_pub val sign : eddsa_pub -> string -> eddsa_sig - val sign_denom : rsa_pub -> string -> string + val sign_denom : rsa_pub -> string -> rsa_sig val find_signkey : eddsa_pub -> Signkey.t option result val find_denomination : denom_hash -> Denomination.t option result val signkeys : unit -> Signkey.t list result @@ -27,3 +27,30 @@ module type KEYS = sig val revoke_denomination : denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result end + +module type SECMOD = sig + type pub + type sig_typ + type info + + val sm_pub : eddsa_pub + val keys : unit -> info list + val sign_secmod : string -> eddsa_sig + val sign : pub -> string -> (sig_typ, string) Result.t + val revoke : pub -> (unit, string) Result.t +end + +type sm_eddsa_info = eddsa_pub * Time.Absolute.t * Time.Absolute.t +type sm_rsa_info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t + +module type SECMOD_EDDSA = + SECMOD + with type pub = eddsa_pub + and type sig_typ = eddsa_sig + and type info = sm_eddsa_info + +module type SECMOD_RSA = + SECMOD + with type pub = rsa_pub + and type sig_typ = rsa_sig + and type info = sm_rsa_info diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index cd6a182b..4056b2d5 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -160,54 +160,64 @@ let init () = let+ () = list_iter write_key new_keys in t -(* --- *) +type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t -let t = - match init () with - | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e - | Ok t -> t +module Make () : + Mod_intf.SECMOD + with type pub = eddsa_pub + and type sig_typ = eddsa_sig + and type info = info = struct + type pub = EddsaPublicKey.t + type sig_typ = EddsaSignature.t + type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t -let find pub = - Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + let t = + match init () with + | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e + | Ok t -> t -let add t1 t2 = - let priv, pub = EddsaPrivateKey.generate () in - let k = { priv; pub; t1; t2 } in - Hashtbl.replace t.ht k.pub k; - () + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" -let delete pub = - let* k = find pub in - Hashtbl.remove t.ht k.pub; delete_key_file k + let add t1 t2 = + let priv, pub = EddsaPrivateKey.generate () in + let k = { priv; pub; t1; t2 } in + Hashtbl.replace t.ht k.pub k; + () -let delete_outdated ~now = - Hashtbl.to_seq_values t.ht - |> List.of_seq - |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) - |> List.map (fun k -> k.pub) - |> list_iter delete + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; delete_key_file k -(* ---- *) + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete -let sm_pub = t.sm_pub + (* ---- *) -let keys () = - Hashtbl.to_seq_values t.ht - |> List.of_seq - |> List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) + let sm_pub = t.sm_pub -let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s + let keys () = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) -let sign ~pub s = - let+ k = find pub in - let data = EddsaSignature.sign ~key:k.priv s in - data + let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s -(* delete and replace *) -let revoke pub = - let* k = find pub in - let* () = delete pub in - add k.t1 k.t2; Ok () + let sign pub s = + let+ k = find pub in + let data = EddsaSignature.sign ~key:k.priv s in + data + + (* delete and replace *) + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.t1 k.t2; Ok () +end (* TODO - more checks diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index a9e1de62..327437e2 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -183,55 +183,63 @@ let init () = let new_keys = List.concat new_keys_l in let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys in let+ () = list_iter write_key new_keys in - t -(* --- *) +type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t -let t = - match init () with - | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e - | Ok t -> t +module Make () : + Mod_intf.SECMOD + with type pub = rsa_pub + and type sig_typ = rsa_sig + and type info = info = struct + type pub = RsaPublicKey.t + type sig_typ = RsaSignature.t + type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t -let find pub = - Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" + (* --- *) + let t = + match init () with + | Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e + | Ok t -> t -let delete pub = - let* k = find pub in - Hashtbl.remove t.ht k.pub; delete_key_file k + let find pub = + Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" -let delete_outdated ~now = - Hashtbl.to_seq_values t.ht - |> List.of_seq - |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) - |> List.map (fun k -> k.pub) - |> list_iter delete + let delete pub = + let* k = find pub in + Hashtbl.remove t.ht k.pub; delete_key_file k -let add section_name t1 t2 = - let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in - let k = { section_name; priv; pub; t1; t2 } in - Hashtbl.replace t.ht k.pub k; - () + let _delete_outdated ~now = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.filter (fun k -> Absolute.compare now k.t2 >= 0) + |> List.map (fun k -> k.pub) + |> list_iter delete -(* ---- *) + let add section_name t1 t2 = + let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in + let k = { section_name; priv; pub; t1; t2 } in + Hashtbl.replace t.ht k.pub k; + () -let sm_pub = t.sm_pub + let sm_pub = t.sm_pub -let keys () = - Hashtbl.to_seq_values t.ht - |> List.of_seq - |> List.map (fun { section_name; priv= _; pub; t1; t2 } -> - (section_name, pub, t1, t2)) + let keys () = + Hashtbl.to_seq_values t.ht + |> List.of_seq + |> List.map (fun { section_name; priv= _; pub; t1; t2 } -> + (section_name, pub, t1, t2)) -let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s + let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s -let sign ~pub s = - let+ k = find pub in - let data = RsaSignature.sign ~key:k.priv s in - data + let sign pub s = + let+ k = find pub in + let data = RsaSignature.sign ~key:k.priv s in + data -let revoke pub = - let* k = find pub in - let* () = delete pub in - add k.section_name k.t1 k.t2; - Ok () + let revoke pub = + let* k = find pub in + let* () = delete pub in + add k.section_name k.t1 k.t2; + Ok () +end