JJ: Description from the destination commit:
JJ: Description from source commit: wip fix FAT JJ: Description from source commit: fix secmod_eddsa; use Mfat.Spath JJ: Description from source commit: +fix secmod_rsa; (wip) JJ: Description from source commit: secmod ok
This commit is contained in:
parent
67e09d38b6
commit
bd8e72f4f1
10 changed files with 170 additions and 206 deletions
|
|
@ -4,7 +4,7 @@ vendor_list := \
|
|||
x509 vifu cachet mfat caqti \
|
||||
base32 cohttp mirage-mtime mirage-ptime
|
||||
|
||||
secmod_fat=secrets/secmod.fat
|
||||
secmod_fat=assets/secmod.fat
|
||||
tap_device=tap0
|
||||
|
||||
check-kvm:
|
||||
|
|
@ -44,8 +44,8 @@ clean:
|
|||
rm -rf vendors/
|
||||
|
||||
# todo: don't erase already existing
|
||||
secmod-storage:
|
||||
@mkdir -p secrets
|
||||
secmod.fat:
|
||||
@mkdir -p assets
|
||||
mfat make --sectors=2048 $(secmod_fat)
|
||||
|
||||
assets:
|
||||
|
|
|
|||
|
|
@ -43,15 +43,11 @@ config = "pgx://mte:hunter2@10.0.0.1:5432/taler-exchange"
|
|||
lookahead_sign = "7 weeks"
|
||||
overlap_duration = "1 hour"
|
||||
duration = "3 weeks"
|
||||
key_dir = "secrets/secmod_rsa"
|
||||
sm_priv_key = "secrets/secmod_rsa/sm_key"
|
||||
|
||||
[taler-exchange-secmod-eddsa]
|
||||
lookahead_sign = "1 year"
|
||||
overlap_duration = "1 hour"
|
||||
duration = "3 weeks"
|
||||
key_dir = "secrets/secmod_eddsa"
|
||||
sm_priv_key = "secrets/secmod_eddsa/sm_key"
|
||||
|
||||
[coin_kudo_1]
|
||||
value= KUDOS:0.01
|
||||
|
|
|
|||
|
|
@ -211,6 +211,10 @@ module Coin = struct
|
|||
let all_coins = List.map parse_coin coin_sections
|
||||
end
|
||||
|
||||
let spath s =
|
||||
let open Fat.Spath in
|
||||
match of_string s with Error (`Msg e) -> fail "%s" e | Ok v -> v
|
||||
|
||||
module Exchange_secmod_rsa = struct
|
||||
let get field =
|
||||
let section = "taler-exchange-secmod-" ^ "rsa" in
|
||||
|
|
@ -218,8 +222,10 @@ module Exchange_secmod_rsa = struct
|
|||
|
||||
let lookahead_sign = get "lookahead_sign" |> duration
|
||||
let overlap_duration = get "overlap_duration" |> duration
|
||||
let key_dir = get "key_dir"
|
||||
let sm_priv_key = get "sm_priv_key"
|
||||
|
||||
(* 8.3 filenames for FAT *)
|
||||
let key_dir = "rsa" |> spath
|
||||
let sm_priv_key = "sm_rsa" |> spath
|
||||
end
|
||||
|
||||
module Exchange_secmod_eddsa = struct
|
||||
|
|
@ -230,8 +236,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
|
||||
let key_dir = get "key_dir"
|
||||
let sm_priv_key = get "sm_priv_key"
|
||||
let key_dir = "eddsa" |> spath
|
||||
let sm_priv_key = "sm_eddsa" |> spath
|
||||
end
|
||||
|
||||
(* -- *)
|
||||
|
|
|
|||
|
|
@ -238,6 +238,23 @@ module RsaPrivateKey = struct
|
|||
let of_octets = Binary_format_rsa.priv_of_octets
|
||||
let to_octets = Binary_format_rsa.priv_to_octets
|
||||
|
||||
(* we use Bin.cstring because size of key (~bits) can change depending on section_name
|
||||
we also have to b32 encode/decode our octets because of null-char
|
||||
|
||||
enforce all to be of the same size instead? *)
|
||||
let bin =
|
||||
let of_octets_exn s =
|
||||
let res =
|
||||
let* s = B32.decode s in
|
||||
of_octets s
|
||||
in
|
||||
match res with
|
||||
| Error e -> Fmt.failwith "RsaPrivateKey.bin decoding failure: %s." e
|
||||
| Ok t -> t
|
||||
in
|
||||
let to_octets t = to_octets t |> B32.encode in
|
||||
Bin.map Bin.cstring of_octets_exn to_octets
|
||||
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
let* s = B32.decode s in
|
||||
|
|
|
|||
|
|
@ -5,10 +5,12 @@ module Fat = Mfat.Make (struct
|
|||
let write = atomic_write
|
||||
end)
|
||||
|
||||
module Sfn = Mfat.Sfn
|
||||
module Spath = Mfat.Spath
|
||||
include Fat
|
||||
|
||||
type entry = Mfat.entry = {
|
||||
name: string;
|
||||
name: Sfn.t;
|
||||
is_dir: bool;
|
||||
size: int32;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,6 +4,9 @@
|
|||
schedule tasks
|
||||
sign: check timestamps before signing *)
|
||||
(* IMPROVE
|
||||
Bin encode/decode
|
||||
- catch failure
|
||||
- should use little-endian
|
||||
list_issue_date: save timestamp of key generation
|
||||
key validity period:
|
||||
more checks + do not exceed lookahead
|
||||
|
|
@ -16,6 +19,8 @@ module Log = (val Logs.src_log src : Logs.LOG)
|
|||
open Syntax
|
||||
open Crypto
|
||||
open Time
|
||||
module Sfn = Mfat.Sfn
|
||||
module Spath = Mfat.Spath
|
||||
module Cfg = Config.Exchange_secmod_eddsa
|
||||
|
||||
type key = {
|
||||
|
|
@ -27,81 +32,64 @@ type key = {
|
|||
|
||||
type t = {
|
||||
fs: Fat.t;
|
||||
sm_key_priv: EddsaPrivateKey.t;
|
||||
sm_priv: EddsaPrivateKey.t;
|
||||
sm_pub: EddsaPublicKey.t;
|
||||
ht: (EddsaPublicKey.t, key) Hashtbl.t;
|
||||
}
|
||||
|
||||
let parse_filename =
|
||||
let scan_filename s =
|
||||
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
|
||||
(TimeAbsolute.of_s t1, TimeAbsolute.of_s t2))
|
||||
in
|
||||
fun fpath -> scan_filename (Fpath.filename fpath)
|
||||
(* todo: this should be encoded in little-endian *)
|
||||
let key_bin =
|
||||
let open Bin in
|
||||
record (fun t1 t2 priv ->
|
||||
let pub = EddsaPrivateKey.pub_of_priv priv in
|
||||
{ t1; t2; priv; pub })
|
||||
|+ field TimeAbsolute.bin (fun t -> t.t1)
|
||||
|+ field TimeAbsolute.bin (fun t -> t.t2)
|
||||
|+ field EddsaPrivateKey.bin (fun t -> t.priv)
|
||||
|> sealr
|
||||
|
||||
let pp_filename =
|
||||
let to_int64 abs =
|
||||
abs |> Timestamp.of_absolute |> Timestamp.to_s |> function
|
||||
| None ->
|
||||
(* (= `never`) this should not happen given resonable config value *)
|
||||
Fmt.failwith "encountered timestamp with value `never`"
|
||||
| Some i -> i
|
||||
in
|
||||
fun ppf (t1, t2) -> Fmt.pf ppf "%Lu-%Lu" (to_int64 t1) (to_int64 t2)
|
||||
(* for sm_key only *)
|
||||
let read_eddsa fs spath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
||||
let* data = Fat.read fs spath |> unwrap_msg in
|
||||
let* priv = EddsaPrivateKey.of_octets data in
|
||||
let pub = EddsaPrivateKey.pub_of_priv priv in
|
||||
Ok (priv, pub)
|
||||
|
||||
let key_fpath k =
|
||||
let fname = Fmt.str "%a" pp_filename (k.t1, k.t2) in
|
||||
Fpath.(v Cfg.key_dir / fname)
|
||||
|
||||
(* -- IO -- *)
|
||||
|
||||
let read_key fs fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let fpath = Fpath.to_string fpath in
|
||||
let* data = Fat.read fs fpath |> unwrap_msg in
|
||||
EddsaPrivateKey.of_octets data
|
||||
|
||||
let write_eddsa fs fpath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||
let write_eddsa fs spath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||
let data = EddsaPrivateKey.to_octets priv in
|
||||
let fpath = Fpath.to_string fpath in
|
||||
Fat.write fs fpath data |> unwrap_msg
|
||||
Fat.write fs spath data |> unwrap_msg
|
||||
|
||||
let write_key fs k = write_eddsa fs (key_fpath k) k.priv
|
||||
let key_spath k =
|
||||
let sfn_res = String.sub (EddsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in
|
||||
match sfn_res with
|
||||
| Error _ -> failwith "not possible"
|
||||
| Ok sfn -> Spath.(Cfg.key_dir / sfn)
|
||||
|
||||
let delete_file fs fpath =
|
||||
(* 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 fpath = Fpath.to_string fpath in
|
||||
let+ () = Fat.remove fs fpath |> unwrap_msg in
|
||||
let read_key fs spath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
||||
let* data = Fat.read fs spath |> unwrap_msg in
|
||||
(* todo: catch failure *)
|
||||
let k = Bin.decode key_bin data (ref 0) in
|
||||
Ok k
|
||||
|
||||
let write_key fs k =
|
||||
let spath = key_spath k in
|
||||
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||
let data = Bin.to_string key_bin k in
|
||||
Fat.write fs spath data |> unwrap_msg
|
||||
|
||||
let delete_file fs spath =
|
||||
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
||||
let+ () = Fat.remove fs spath |> unwrap_msg in
|
||||
()
|
||||
|
||||
let get_key_dir_contents fs dir =
|
||||
let* dir = Fpath.of_string dir |> unwrap_msg in
|
||||
let dir = Fpath.to_string dir in
|
||||
let* () = Fat.mkdir fs dir |> unwrap_msg in
|
||||
Log.info (fun m -> m "created directory `%s`" dir);
|
||||
let+ l = Fat.ls fs dir |> unwrap_msg in
|
||||
(* List.map Fpath.normalize l *)
|
||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
||||
let l = List.map Fpath.v l in
|
||||
l
|
||||
|
||||
(* -- *)
|
||||
|
||||
let gen_key t1 t2 =
|
||||
let priv, pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated key (%a):@,`%s`" pp_filename (t1, t2)
|
||||
(EddsaPublicKey.to_b32 pub));
|
||||
{ priv; pub; t1; t2 }
|
||||
let k = { priv; pub; t1; t2 } in
|
||||
Log.debug (fun m -> m "generated key `%s`" (EddsaPublicKey.to_b32 pub));
|
||||
k
|
||||
|
||||
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
|
||||
|
||||
|
|
@ -133,34 +121,25 @@ let gen_additional_keys_until_lookahead ~now l =
|
|||
let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
|
||||
new_keys
|
||||
|
||||
let sm_key_fpath =
|
||||
Result.get_ok
|
||||
@@
|
||||
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in
|
||||
Fpath.normalize fpath
|
||||
|
||||
(* we load sm_key separately
|
||||
we don't accept non-key files in key_dir *)
|
||||
let load_key fs fpath =
|
||||
match parse_filename fpath with
|
||||
| None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
|
||||
| Some (t1, t2) ->
|
||||
let+ priv = read_key fs fpath in
|
||||
let pub = EddsaPrivateKey.pub_of_priv priv in
|
||||
{ priv; pub; t1; t2 }
|
||||
|
||||
let load fs =
|
||||
let* l = get_key_dir_contents fs Cfg.key_dir in
|
||||
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
|
||||
let* keys = list_map (load_key fs) l in
|
||||
let* () =
|
||||
if Fat.exists fs Cfg.key_dir then Ok ()
|
||||
else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
|
||||
in
|
||||
let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
|
||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
||||
let l = List.map (Spath.add Cfg.key_dir) l in
|
||||
let l =
|
||||
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
||||
in
|
||||
let* keys = list_map (read_key fs) l in
|
||||
match keys with
|
||||
| [] -> Ok None
|
||||
| _l ->
|
||||
let* sm_key_priv = read_key fs sm_key_fpath in
|
||||
let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
|
||||
let* sm_priv, sm_pub = read_eddsa fs Cfg.sm_priv_key in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
let () = List.iter (fun k -> Hashtbl.replace ht k.pub k) keys in
|
||||
Ok (Some { fs; sm_key_priv; sm_pub; ht })
|
||||
Ok (Some { fs; sm_priv; sm_pub; ht })
|
||||
|
||||
let init fs =
|
||||
let* opt = load fs in
|
||||
|
|
@ -168,12 +147,13 @@ let init fs =
|
|||
match opt with
|
||||
| Some t -> Ok t
|
||||
| None ->
|
||||
let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
let sm_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
|
||||
let* () = write_eddsa fs sm_key_fpath sm_key_priv in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
Ok { fs; sm_key_priv; sm_pub; ht }
|
||||
let t = { fs; sm_priv; sm_pub; ht } in
|
||||
let* () = write_eddsa fs Cfg.sm_priv_key t.sm_priv in
|
||||
Ok t
|
||||
in
|
||||
let now = TimeAbsolute.of_ptime (Mirage_ptime.now ()) in
|
||||
let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
|
||||
|
|
@ -200,7 +180,7 @@ module Make (Fs : Fat.FS) = struct
|
|||
let delete pub =
|
||||
let* k = find pub in
|
||||
Hashtbl.remove t.ht k.pub;
|
||||
delete_file t.fs (key_fpath k)
|
||||
delete_file t.fs (key_spath k)
|
||||
|
||||
let _delete_outdated ~now =
|
||||
Hashtbl.to_seq_values t.ht
|
||||
|
|
@ -212,7 +192,7 @@ module Make (Fs : Fat.FS) = struct
|
|||
(* ---- *)
|
||||
|
||||
let sm_pub = t.sm_pub
|
||||
let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
|
||||
let sign_secmod s = EddsaSignature.sign ~key:t.sm_priv s
|
||||
|
||||
let sign pub s =
|
||||
let+ k = find pub in
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@ module Log = (val Logs.src_log src : Logs.LOG)
|
|||
open Syntax
|
||||
open Crypto
|
||||
open Time
|
||||
module Sfn = Mfat.Sfn
|
||||
module Spath = Mfat.Spath
|
||||
|
||||
module Cfg = struct
|
||||
open Config
|
||||
|
|
@ -49,93 +51,70 @@ type key = {
|
|||
|
||||
type t = {
|
||||
fs: Fat.t;
|
||||
sm_key_priv: EddsaPrivateKey.t;
|
||||
sm_priv: EddsaPrivateKey.t;
|
||||
sm_pub: EddsaPublicKey.t;
|
||||
ht: (DenominationHash.t, key) Hashtbl.t;
|
||||
}
|
||||
|
||||
let parse_filename =
|
||||
let scan_filename s =
|
||||
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
|
||||
(TimeAbsolute.of_s t1, TimeAbsolute.of_s t2))
|
||||
let key_bin =
|
||||
let open Bin in
|
||||
record (fun t1 t2 section_name priv ->
|
||||
let pub = RsaPrivateKey.pub_of_priv priv in
|
||||
let h_pub = DenominationHash.hash_of_rsa pub in
|
||||
{ section_name; t1; t2; priv; pub; h_pub })
|
||||
|+ field TimeAbsolute.bin (fun t -> t.t1)
|
||||
|+ field TimeAbsolute.bin (fun t -> t.t2)
|
||||
|+ field cstring (fun t -> t.section_name)
|
||||
|+ field RsaPrivateKey.bin (fun t -> t.priv)
|
||||
|> sealr
|
||||
|
||||
let key_spath k =
|
||||
let sfn_res =
|
||||
String.sub (DenominationHash.to_b32 k.h_pub) 0 8 |> Sfn.of_string
|
||||
in
|
||||
fun fpath -> scan_filename (Fpath.filename fpath)
|
||||
match sfn_res with
|
||||
| Error _ -> failwith "not possible"
|
||||
| Ok sfn -> Spath.(Cfg.key_dir / sfn)
|
||||
|
||||
let pp_filename =
|
||||
let to_int64 abs =
|
||||
abs |> Timestamp.of_absolute |> Timestamp.to_s |> function
|
||||
| None ->
|
||||
(* (= `never`) this should not happen given resonable config value *)
|
||||
Fmt.failwith "encountered timestamp with value `never`"
|
||||
| Some i -> i
|
||||
in
|
||||
fun ppf (t1, t2) -> Fmt.pf ppf "%Lu-%Lu" (to_int64 t1) (to_int64 t2)
|
||||
let read_eddsa fs spath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
||||
let* data = Fat.read fs spath |> unwrap_msg in
|
||||
let* priv = EddsaPrivateKey.of_octets data in
|
||||
let pub = EddsaPrivateKey.pub_of_priv priv in
|
||||
Ok (priv, pub)
|
||||
|
||||
let key_fpath k =
|
||||
let fname = Fmt.str "%a" pp_filename (k.t1, k.t2) in
|
||||
Fpath.(v Cfg.key_dir / k.section_name / fname)
|
||||
|
||||
(* -- IO -- *)
|
||||
|
||||
let read_eddsa fs fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let fpath = Fpath.to_string fpath in
|
||||
let* data = Fat.read fs fpath |> unwrap_msg in
|
||||
EddsaPrivateKey.of_octets data
|
||||
|
||||
let read_rsa fs fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let fpath = Fpath.to_string fpath in
|
||||
let* data = Fat.read fs fpath |> unwrap_msg in
|
||||
RsaPrivateKey.of_octets data
|
||||
|
||||
let write_eddsa fs fpath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||
let write_eddsa fs spath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||
let data = EddsaPrivateKey.to_octets priv in
|
||||
let fpath = Fpath.to_string fpath in
|
||||
Fat.write fs fpath data |> unwrap_msg
|
||||
Fat.write fs spath data |> unwrap_msg
|
||||
|
||||
let write_rsa fs fpath priv =
|
||||
let data = RsaPrivateKey.to_octets priv in
|
||||
let fpath = Fpath.to_string fpath in
|
||||
Fat.write fs fpath data |> unwrap_msg
|
||||
let read_key fs spath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
||||
let* data = Fat.read fs spath |> unwrap_msg in
|
||||
let k = Bin.decode key_bin data (ref 0) in
|
||||
Ok k
|
||||
|
||||
let write_key fs k = write_rsa fs (key_fpath k) k.priv
|
||||
let write_key fs k =
|
||||
let spath = key_spath k in
|
||||
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||
let data = Bin.to_string key_bin k in
|
||||
Fat.write fs spath data |> unwrap_msg
|
||||
|
||||
let delete_file fs fpath =
|
||||
(* 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 fpath = Fpath.to_string fpath in
|
||||
let+ () = Fat.remove fs fpath |> unwrap_msg in
|
||||
let delete_file fs spath =
|
||||
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
||||
let+ () = Fat.remove fs spath |> unwrap_msg in
|
||||
()
|
||||
|
||||
let get_key_dir_contents fs dir_fpath =
|
||||
let dir_fpath = Fpath.to_string dir_fpath in
|
||||
let* () = Fat.mkdir fs dir_fpath |> unwrap_msg in
|
||||
Log.info (fun m -> m "created directory `%s`" dir_fpath);
|
||||
let+ l = Fat.ls fs dir_fpath |> unwrap_msg in
|
||||
(* List.map Fpath.normalize l *)
|
||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
||||
let l = List.map Fpath.v l in
|
||||
l
|
||||
|
||||
(* -- *)
|
||||
|
||||
let gen_key ~section_name t1 t2 =
|
||||
let bits = Cfg.rsa_keysize ~section_name in
|
||||
let priv, pub = RsaPrivateKey.generate ~bits () in
|
||||
let h_pub = DenominationHash.hash_of_rsa pub in
|
||||
let k = { section_name; priv; pub; h_pub; t1; t2 } in
|
||||
Log.debug (fun m ->
|
||||
m "generated key (%a):@,`%s`" pp_filename (t1, t2)
|
||||
(DenominationHash.to_octets h_pub |> B32.encode));
|
||||
{ section_name; priv; pub; h_pub; t1; t2 }
|
||||
m "generated key %s `%s`" section_name (DenominationHash.to_b32 k.h_pub));
|
||||
k
|
||||
|
||||
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
|
||||
|
||||
|
|
@ -154,8 +133,6 @@ let split_in_periodes ~start ~end_ ~duration_withdraw =
|
|||
go acc start end_
|
||||
|
||||
let gen_additional_keys_until_lookahead ~now ~section_name 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
|
||||
|
|
@ -171,41 +148,25 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
|||
in
|
||||
new_keys
|
||||
|
||||
let sm_key_fpath =
|
||||
Result.get_ok
|
||||
@@
|
||||
let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in
|
||||
Fpath.normalize fpath
|
||||
|
||||
(* we load sm_key separately
|
||||
we don't accept non-key files in key_dir *)
|
||||
let load_key fs ~section_name fpath =
|
||||
match parse_filename fpath with
|
||||
| None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
|
||||
| Some (t1, t2) ->
|
||||
let+ priv = read_rsa fs fpath in
|
||||
let pub = RsaPrivateKey.pub_of_priv priv in
|
||||
let h_pub = DenominationHash.hash_of_rsa pub in
|
||||
{ section_name; priv; pub; h_pub; t1; t2 }
|
||||
|
||||
let load_section fs section_name =
|
||||
let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
|
||||
let* l = get_key_dir_contents fs section_fpath in
|
||||
let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
|
||||
let* keys = list_map (load_key fs ~section_name) l in
|
||||
Ok keys
|
||||
|
||||
let load fs =
|
||||
let* keys_l = list_map (load_section fs) Cfg.sections in
|
||||
let keys = List.concat keys_l in
|
||||
let* () =
|
||||
if Fat.exists fs Cfg.key_dir then Ok ()
|
||||
else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
|
||||
in
|
||||
let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
|
||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
||||
let l = List.map (Spath.add Cfg.key_dir) l in
|
||||
let l =
|
||||
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
||||
in
|
||||
let* keys = list_map (read_key fs) l in
|
||||
match keys with
|
||||
| [] -> Ok None
|
||||
| _l ->
|
||||
let* sm_key_priv = read_eddsa fs sm_key_fpath in
|
||||
let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
|
||||
let* sm_priv, sm_pub = read_eddsa fs Cfg.sm_priv_key in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
let () = List.iter (fun k -> Hashtbl.replace ht k.h_pub k) keys in
|
||||
Ok (Some { fs; sm_key_priv; sm_pub; ht })
|
||||
Ok (Some { fs; sm_priv; sm_pub; ht })
|
||||
|
||||
let init fs =
|
||||
let* opt = load fs in
|
||||
|
|
@ -214,12 +175,12 @@ let init fs =
|
|||
match opt with
|
||||
| Some t -> Ok t
|
||||
| None ->
|
||||
let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
let sm_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
|
||||
let* () = write_eddsa fs sm_key_fpath sm_key_priv in
|
||||
let* () = write_eddsa fs Cfg.sm_priv_key sm_priv in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
Ok { fs; sm_key_priv; sm_pub; ht }
|
||||
Ok { fs; sm_priv; sm_pub; ht }
|
||||
in
|
||||
let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
|
||||
let new_keys_l =
|
||||
|
|
@ -248,7 +209,7 @@ module Make (Fs : Fat.FS) = struct
|
|||
let delete h_pub =
|
||||
let* k = find h_pub in
|
||||
Hashtbl.remove t.ht h_pub;
|
||||
delete_file t.fs (key_fpath k)
|
||||
delete_file t.fs (key_spath k)
|
||||
|
||||
let _delete_outdated ~now =
|
||||
Hashtbl.to_seq t.ht
|
||||
|
|
@ -264,7 +225,7 @@ module Make (Fs : Fat.FS) = struct
|
|||
()
|
||||
|
||||
let sm_pub = t.sm_pub
|
||||
let sign_secmod s = EddsaSignature.sign ~key:t.sm_key_priv s
|
||||
let sign_secmod s = EddsaSignature.sign ~key:t.sm_priv s
|
||||
|
||||
let sign h_pub msg =
|
||||
let+ k = find h_pub in
|
||||
|
|
|
|||
|
|
@ -92,6 +92,7 @@ module TimeAbsolute = struct
|
|||
if Int64.unsigned_div v 1_000_000L <> s then never else v
|
||||
|
||||
let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
|
||||
let bin = Bin.beint64
|
||||
let pp ppf t = if t = never then Fmt.pf ppf "never" else Fmt.pf ppf "%Lu" t
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -32,6 +32,7 @@ module TimeAbsolute : sig
|
|||
val sub : t -> TimeRelative.t -> t
|
||||
val of_s : int64 -> t
|
||||
val of_ptime : Ptime.t -> t
|
||||
val bin : t Bin.t
|
||||
|
||||
(* TODO rename pp_dump *)
|
||||
val pp : Format.formatter -> t -> unit
|
||||
|
|
|
|||
|
|
@ -54,8 +54,8 @@ module Log_reporter = struct
|
|||
()
|
||||
|
||||
let setup () =
|
||||
(*set_level_secmods (Some Logs.Debug);*)
|
||||
let level = Some Logs.Info in
|
||||
set_level_secmods (Some Logs.Debug);
|
||||
let level = Some Logs.Debug in
|
||||
Logs.set_level ~all:false level;
|
||||
Logs.Src.set_level Logs.default level;
|
||||
Logs.set_reporter reporter;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue