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

fix secmod add/write; + wip test revoke

Browse source
This commit is contained in:
swrup 2026-02-25 00:12:05 +01:00
parent 836b9ff64a
commit 05cfa7a5b1
8 changed files with 165 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

1
keys.json Normal file
View file

File diff suppressed because one or more lines are too long

2
src/http_management.ml
View file

@ -9,7 +9,7 @@ module Keys_get = struct
Logs.info (fun m -> m "GET /management/keys/");
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
let res =
let v = Keys.make_future_keys_response () in
let* v = Keys.make_future_keys_response () in
Api.encode jsont v
in
Respond.result res req

67
src/keys.ml
View file

@ -13,7 +13,7 @@ module type S = sig
val denominations : unit -> Denomination.t list result
val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
val find_future_denomination : denom_hash -> Api.FutureDenom.t result
val make_future_keys_response : unit -> Api.FutureKeysResponse.t
val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
val certify_future_signkey :
eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@ -68,6 +68,7 @@ module Make (Conn : Pg.CONN) : S = struct
m
"some signkeys found in database are missing from secmod, \
(unclean database/secmod state?)");
Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
l
let denominations () =
@ -84,9 +85,12 @@ module Make (Conn : Pg.CONN) : S = struct
m
"some denominations found in database are missing from secmod, \
(unclean database/secmod state?)");
Logs.debug (fun m ->
m "found %d active denomination(s)" (List.length l));
l
let make_future_sk (pub, (start, expire)) =
Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
let open Time in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
@ -113,6 +117,9 @@ module Make (Conn : Pg.CONN) : S = struct
| Some v -> v
let make_future_dn (h_pub, (section_name, pub, start)) =
Logs.debug (fun m ->
m "make_future_dn: `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
let open Time in
let Config.Coin.
{
@ -187,16 +194,37 @@ module Make (Conn : Pg.CONN) : S = struct
Ok future_dn
let make_future_keys_response () =
let future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
Api.FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub= Config.Exchange.master_public_key;
denom_secmod_public_key= Sm_rsa.sm_pub;
signkey_secmod_public_key= Sm_eddsa.sm_pub;
}
let now = Timestamp.of_ptime @@ Ptime_clock.now () in
(* get keys from database to filter out keys already certified *)
let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
let sk_ht = Hashtbl.create 0xff in
List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
let future_signkeys =
Sm_eddsa.keys ()
|> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
|> List.map make_future_sk
in
let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in
let dn_ht = Hashtbl.create 0xff in
List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
let future_denoms =
Sm_rsa.keys ()
|> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
|> List.map make_future_dn
in
Logs.info (fun m ->
m "%d future signkey(s) and %d future denomination(s) to certify"
(List.length future_signkeys)
(List.length future_denoms));
Ok
Api.FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub= Config.Exchange.master_public_key;
denom_secmod_public_key= Sm_rsa.sm_pub;
signkey_secmod_public_key= Sm_eddsa.sm_pub;
}
let sk_of_future_sk future_sk master_sig =
let Api.FutureSignKey.
@ -257,8 +285,10 @@ module Make (Conn : Pg.CONN) : S = struct
(* rebuild it *)
let future_sk = make_future_sk (pub, (t1, t2)) in
let sk = sk_of_future_sk future_sk master_sig in
let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
Ok ())
let+ () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
Logs.info (fun m ->
m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
())
let certify_future_denomination h_pub master_sig =
match Sm_rsa.find_key h_pub with
@ -272,8 +302,11 @@ module Make (Conn : Pg.CONN) : S = struct
| None ->
let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
let dn = dn_of_future_dn future_dn h_pub master_sig in
let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
Ok ())
let+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in
Logs.info (fun m ->
m "certified denomination `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
())
let revoke_signkey pub revoked_sig =
let* opt = find_signkey pub in
@ -282,6 +315,7 @@ module Make (Conn : Pg.CONN) : S = struct
let+ () =
Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
in
Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
()
let revoke_denomination h_pub revoked_sig =
@ -292,5 +326,8 @@ module Make (Conn : Pg.CONN) : S = struct
Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
|> unwrap_err_caqti
in
Logs.info (fun m ->
m "revoked denomination `%s`"
(B32.encode @@ Hash.DenominationHash.to_octets h_pub));
()
end

28
src/secmod_eddsa.ml
View file

@ -57,11 +57,17 @@ let write_eddsa fpath priv =
let write_key k = write_eddsa (key_fpath k) k.priv
let delete_file fpath =
Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
(* TODO just to be safe~~
(* check fpath just to be safe *)
let () =
let root = Fpath.v Cfg.key_dir in
if not @@ Fpath.is_rooted ~root fpath then
Fmt.failwith
"delete_file failure: file `%a` is not contained in secmod directory"
Fpath.pp fpath
in
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
*)
Ok ()
()
let get_key_dir_contents dir =
let* dir = Fpath.of_string dir |> unwrap_err_msg in
@ -70,7 +76,7 @@ let get_key_dir_contents dir =
let+ l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
in
l
List.map Fpath.normalize l
(* -- *)
@ -131,11 +137,7 @@ let load_key fpath =
let load () =
let* l = get_key_dir_contents Cfg.key_dir in
let l =
l
|> List.map Fpath.normalize
|> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
in
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
let* keys = list_map load_key l in
match keys with
| [] -> Ok None
@ -162,7 +164,7 @@ let init () =
let now = TimeAbsolute.of_ptime (Ptime_clock.now ()) in
let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
let new_keys = gen_additional_keys_until_lookahead ~now keys in
let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in
List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys;
let+ () = list_iter write_key new_keys in
t
@ -178,6 +180,7 @@ module Make () = struct
let add t1 t2 =
let k = gen_key t1 t2 in
Hashtbl.replace t.ht k.pub k;
let+ () = write_key k in
()
let delete pub =
@ -206,7 +209,8 @@ module Make () = struct
let revoke pub =
let* k = find pub in
let* () = delete pub in
add k.t1 k.t2; Ok ()
let* () = add k.t1 k.t2 in
Ok ()
let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv

29
src/secmod_rsa.ml
View file

@ -100,11 +100,17 @@ let write_rsa fpath priv =
let write_key k = write_rsa (key_fpath k) k.priv
let delete_file fpath =
Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
(* TODO just to be safe~~
(* check fpath just to be safe *)
let () =
let root = Fpath.v Cfg.key_dir in
if not @@ Fpath.is_rooted ~root fpath then
Fmt.failwith
"delete_file failure: file `%a` is not contained in secmod directory"
Fpath.pp fpath
in
Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
*)
Ok ()
()
let get_key_dir_contents dir_fpath =
let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
@ -112,7 +118,7 @@ let get_key_dir_contents dir_fpath =
let+ l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
in
l
List.map Fpath.normalize l
(* -- *)
@ -179,11 +185,7 @@ let load_key ~section_name fpath =
let load_section section_name =
let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
let* l = get_key_dir_contents section_fpath in
let l =
l
|> List.map Fpath.normalize
|> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
in
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
let* keys = list_map (load_key ~section_name) l in
Ok keys
@ -224,7 +226,7 @@ let init () =
Cfg.sections
in
let new_keys = List.concat new_keys_l in
let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in
List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
let+ () = list_iter write_key new_keys in
t
@ -252,6 +254,7 @@ module Make () = struct
let add section_name t1 t2 =
let k = gen_key ~section_name t1 t2 in
Hashtbl.replace t.ht k.h_pub k;
let+ () = write_key k in
()
let sm_pub = t.sm_pub
@ -263,9 +266,11 @@ module Make () = struct
data
let revoke h_pub =
Log.debug (fun m ->
m "revoke `%s`" (DenominationHash.to_octets h_pub |> B32.encode));
let* k = find h_pub in
let* () = delete h_pub in
add k.section_name k.t1 k.t2;
let* () = add k.section_name k.t1 k.t2 in
Ok ()
let conv =

7
src/util.ml
View file

@ -48,8 +48,13 @@ module Log_reporter = struct
in
{ report }
let set_level_secmods lvl =
let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
()
let setup () =
(*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*)
(*set_level_secmods (Some Logs.Debug);*)
let level = Some Logs.Info in
Logs.set_level ~all:false level;
Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();

27
test/offline_management.sh
View file

@ -22,6 +22,25 @@ offline_tool sign \
offline_tool upload --input $b --url $url"/management/keys"
echo "[OK] /management/keys"
offline_tool download --output $a --url $url"/keys"
rsa_pub=$(jq -r '.denominations[0].denoms[0].rsa_pub' $a)
offline_tool revoke-denom \
--master_key $master_key \
--output $b \
--rsa \
$rsa_pub
h_denom=$(dune exec offline -- hash64 $rsa_pub)
offline_tool upload --input $b --url $url"/management/denominations/"$h_denom"/revoke"
echo "[OK] /management/denominations/\$H_DENOM/revoke"
pub=$(jq -r '.signkeys[0].key' $a)
offline_tool revoke-signkey \
--master_key $master_key \
--output $b \
$pub
offline_tool upload --input $b --url $url"/management/signkeys/"$pub"/revoke"
echo "[OK] /management/signkeys/\$EXCHANGE_PUB/revoke"
offline_tool enable-auditor \
--master_key $master_key \
--output $b \
@ -32,6 +51,8 @@ offline_tool enable-auditor \
offline_tool upload --input $b --url $url"/management/auditors"
echo "[OK] /management/auditors"
# todo test disable auditor
offline_tool wire-fee \
--master_key $master_key \
--output $b \
@ -56,3 +77,9 @@ offline_tool global-fees \
--purse_timeout 9999999
offline_tool upload --input $b --url $url"/management/global-fees"
echo "[OK] /management/global-fees"
# todo test enable wire
# todo test disable wire
# todo test drain
# todo test aml-officer
# todo test partners

49
tools/offline.ml
View file

@ -128,14 +128,54 @@ let sign_cmd =
let revoke_denom_cmd =
let doc = "Revoke denomination." in
let h_denom =
let doc = "hash of denomination public key" in
let is_rsa_pub =
let doc =
"interpret input string as a RSA public key (in Crockford-base32) \
instead of a denomination hash"
in
Arg.(value & flag & info [ "rsa" ] ~doc)
in
let v =
let doc = "hash of denomination (or RSA public key if --rsa is set)" in
Arg.(required & pos 0 (some string) None & info [] ~doc)
in
Cmd.make (Cmd.info "revoke-denom" ~doc)
@@
let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
revoke_denom ~output ~master_key ~h_denom
let+ output = output
and+ master_key = master_key
and+ is_rsa_pub = is_rsa_pub
and+ v = v in
let res =
match is_rsa_pub with
| false -> Ok v
| true -> (
match B32.decode v with
| Error e -> Error e
| Ok s ->
let h = Hash.DenominationHash.hash s in
let s = B32.encode (Hash.DenominationHash.to_octets h) in
Ok s)
in
match res with
| Error e -> Error e
| Ok h_denom -> revoke_denom ~output ~master_key ~h_denom
(* just for tests... *)
let test_hash64_cmd =
let doc =
"Compute SHA-512, print output to stdout, input and output are \
Crockford-base32 encoded"
in
let s = Arg.(required & pos 0 (some string) None & info []) in
Cmd.make (Cmd.info "hash64" ~doc)
@@
let+ s = s in
match B32.decode s with
| Error e -> Error e
| Ok s ->
let h = Hash.DenominationHash.hash s in
let s = B32.encode (Hash.DenominationHash.to_octets h) in
Fmt.pr "%s@." s; Ok ()
let revoke_signkey_cmd =
let doc = "Revoke signkey." in
@ -305,6 +345,7 @@ let cli =
wire_fee_cmd;
global_fees_cmd;
drain_cmd;
test_hash64_cmd;
]
let main () = Cmd.eval_result cli