swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

functorize secmod

Browse source
This commit is contained in:
swrup 2026-02-21 18:43:47 +01:00
parent 7f440077ed
commit cb33942711
6 changed files with 110 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/crypto.ml
View file

@ -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

4
src/devices.ml
View file

@ -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

35
src/keys.ml
View file

@ -1,17 +1,21 @@
open Syntax
open Crypto
(* TODO better error type *)
type 'a result = ('a, string) Result.t
module type S = Mod_intf.KEYS
module Make (Conn : Pg.CONN) = struct
module Sm_eddsa = Secmod_eddsa.Make ()
module Sm_rsa = Secmod_rsa.Make ()
let conn = (module Conn : Pg.CONN)
open Syntax
open Crypto
(* - *)
let master_pub = Config.Exchange.master_public_key
let secmod_rsa_pub = Secmod_rsa.sm_pub
let secmod_eddsa_pub = Secmod_eddsa.sm_pub
let secmod_eddsa_pub = Sm_eddsa.sm_pub
let secmod_rsa_pub = Sm_rsa.sm_pub
(* TODO error
should be a "key not found", either:
@ -20,12 +24,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 +53,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 +100,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 +120,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 +136,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 +168,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 +228,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 +245,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 +277,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 +287,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

6
src/mod_intf.mli
View file

@ -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

79
src/secmod_eddsa.ml
View file

@ -160,54 +160,59 @@ 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 () = struct
type pub = EddsaPublicKey.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

81
src/secmod_rsa.ml
View file

@ -183,55 +183,58 @@ 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 () = struct
type pub = RsaPublicKey.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