This commit is contained in:
parent
c30fc5c059
commit
14cd8d2c5e
4 changed files with 42 additions and 57 deletions
|
|
@ -225,7 +225,7 @@ module Exchange_secmod_rsa = struct
|
||||||
|
|
||||||
(* 8.3 filenames for FAT *)
|
(* 8.3 filenames for FAT *)
|
||||||
let key_dir = "rsa" |> spath
|
let key_dir = "rsa" |> spath
|
||||||
let sm_priv_key = "rsa/sm_key" |> spath
|
let sm_priv_key = "sm_rsa" |> spath
|
||||||
end
|
end
|
||||||
|
|
||||||
module Exchange_secmod_eddsa = struct
|
module Exchange_secmod_eddsa = struct
|
||||||
|
|
@ -237,7 +237,7 @@ module Exchange_secmod_eddsa = struct
|
||||||
let overlap_duration = get "overlap_duration" |> duration
|
let overlap_duration = get "overlap_duration" |> duration
|
||||||
let duration = get "duration" |> duration
|
let duration = get "duration" |> duration
|
||||||
let key_dir = "eddsa" |> spath
|
let key_dir = "eddsa" |> spath
|
||||||
let sm_priv_key = "eddsa/sm_key" |> spath
|
let sm_priv_key = "sm_eddsa" |> spath
|
||||||
end
|
end
|
||||||
|
|
||||||
(* -- *)
|
(* -- *)
|
||||||
|
|
|
||||||
|
|
@ -238,8 +238,21 @@ module RsaPrivateKey = struct
|
||||||
let of_octets = Binary_format_rsa.priv_of_octets
|
let of_octets = Binary_format_rsa.priv_of_octets
|
||||||
let to_octets = Binary_format_rsa.priv_to_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 bin =
|
||||||
let of_octets_exn t = of_octets t |> Result.get_ok in
|
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
|
Bin.map Bin.cstring of_octets_exn to_octets
|
||||||
|
|
||||||
let jsont =
|
let jsont =
|
||||||
|
|
|
||||||
|
|
@ -4,6 +4,9 @@
|
||||||
schedule tasks
|
schedule tasks
|
||||||
sign: check timestamps before signing *)
|
sign: check timestamps before signing *)
|
||||||
(* IMPROVE
|
(* IMPROVE
|
||||||
|
Bin encode/decode
|
||||||
|
- catch failure
|
||||||
|
- should use little-endian
|
||||||
list_issue_date: save timestamp of key generation
|
list_issue_date: save timestamp of key generation
|
||||||
key validity period:
|
key validity period:
|
||||||
more checks + do not exceed lookahead
|
more checks + do not exceed lookahead
|
||||||
|
|
@ -71,26 +74,17 @@ let read_key fs spath =
|
||||||
let k = Bin.decode key_bin data (ref 0) in
|
let k = Bin.decode key_bin data (ref 0) in
|
||||||
Ok k
|
Ok k
|
||||||
|
|
||||||
let write_key fs spath k =
|
let write_key fs k =
|
||||||
|
let spath = key_spath k in
|
||||||
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||||
let data = Bin.to_string key_bin k in
|
let data = Bin.to_string key_bin k in
|
||||||
Fat.write fs spath data |> unwrap_msg
|
Fat.write fs spath data |> unwrap_msg
|
||||||
|
|
||||||
let write_key fs k = write_key fs (key_spath k) k
|
|
||||||
|
|
||||||
let delete_file fs spath =
|
let delete_file fs spath =
|
||||||
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
||||||
let+ () = Fat.remove fs spath |> unwrap_msg in
|
let+ () = Fat.remove fs spath |> unwrap_msg in
|
||||||
()
|
()
|
||||||
|
|
||||||
let get_key_dir_contents fs dir =
|
|
||||||
Log.debug (fun m -> m "get_key_dir_contents `%a`" Spath.pp dir);
|
|
||||||
let* () = Fat.mkdir fs dir |> unwrap_msg in
|
|
||||||
let+ l = Fat.ls fs dir |> unwrap_msg in
|
|
||||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
|
||||||
let l = List.map (Spath.add dir) l in
|
|
||||||
l
|
|
||||||
|
|
||||||
let gen_key t1 t2 =
|
let gen_key t1 t2 =
|
||||||
let priv, pub = EddsaPrivateKey.generate () in
|
let priv, pub = EddsaPrivateKey.generate () in
|
||||||
let k = { priv; pub; t1; t2 } in
|
let k = { priv; pub; t1; t2 } in
|
||||||
|
|
@ -128,7 +122,13 @@ let gen_additional_keys_until_lookahead ~now l =
|
||||||
new_keys
|
new_keys
|
||||||
|
|
||||||
let load fs =
|
let load fs =
|
||||||
let* l = get_key_dir_contents fs Cfg.key_dir 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 =
|
let l =
|
||||||
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
||||||
in
|
in
|
||||||
|
|
|
||||||
|
|
@ -13,15 +13,7 @@ module Cfg = struct
|
||||||
open Config
|
open Config
|
||||||
include Exchange_secmod_rsa
|
include Exchange_secmod_rsa
|
||||||
|
|
||||||
(* TODO section_name *)
|
|
||||||
let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
|
let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
|
||||||
(*
|
|
||||||
|> list_map Sfn.of_string
|
|
||||||
|> unwrap_msg
|
|
||||||
|> function
|
|
||||||
| Error e -> Fmt.failwith "invalid section_name %s" e
|
|
||||||
| Ok l -> l
|
|
||||||
*)
|
|
||||||
|
|
||||||
(* helper functions to get config value from section_name: *)
|
(* helper functions to get config value from section_name: *)
|
||||||
|
|
||||||
|
|
@ -77,7 +69,9 @@ let key_bin =
|
||||||
|> sealr
|
|> sealr
|
||||||
|
|
||||||
let key_spath k =
|
let key_spath k =
|
||||||
let sfn_res = String.sub (RsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in
|
let sfn_res =
|
||||||
|
String.sub (DenominationHash.to_b32 k.h_pub) 0 8 |> Sfn.of_string
|
||||||
|
in
|
||||||
match sfn_res with
|
match sfn_res with
|
||||||
| Error _ -> failwith "not possible"
|
| Error _ -> failwith "not possible"
|
||||||
| Ok sfn -> Spath.(Cfg.key_dir / sfn)
|
| Ok sfn -> Spath.(Cfg.key_dir / sfn)
|
||||||
|
|
@ -97,34 +91,20 @@ let write_eddsa fs spath priv =
|
||||||
let read_key fs spath =
|
let read_key fs spath =
|
||||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
||||||
let* data = Fat.read fs spath |> unwrap_msg in
|
let* data = Fat.read fs spath |> unwrap_msg in
|
||||||
(* todo: catch failure *)
|
|
||||||
let k = Bin.decode key_bin data (ref 0) in
|
let k = Bin.decode key_bin data (ref 0) in
|
||||||
Ok k
|
Ok k
|
||||||
|
|
||||||
let read_rsa fs spath =
|
let write_key fs k =
|
||||||
Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
|
let spath = key_spath k in
|
||||||
let* data = Fat.read fs spath |> unwrap_msg in
|
Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
|
||||||
RsaPrivateKey.of_octets data
|
let data = Bin.to_string key_bin k in
|
||||||
|
|
||||||
let write_rsa fs spath priv =
|
|
||||||
let data = RsaPrivateKey.to_octets priv in
|
|
||||||
Fat.write fs spath data |> unwrap_msg
|
Fat.write fs spath data |> unwrap_msg
|
||||||
|
|
||||||
let write_key fs k = write_rsa fs (key_spath k) k.priv
|
|
||||||
|
|
||||||
let delete_file fs spath =
|
let delete_file fs spath =
|
||||||
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
|
||||||
let+ () = Fat.remove fs spath |> unwrap_msg in
|
let+ () = Fat.remove fs spath |> unwrap_msg in
|
||||||
()
|
()
|
||||||
|
|
||||||
let get_key_dir_contents fs dir =
|
|
||||||
Log.debug (fun m -> m "get_key_dir_contents `%a`" Spath.pp dir);
|
|
||||||
let* () = Fat.mkdir fs dir |> unwrap_msg in
|
|
||||||
let+ l = Fat.ls fs dir |> unwrap_msg in
|
|
||||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
|
||||||
let l = List.map (Spath.add dir) l in
|
|
||||||
l
|
|
||||||
|
|
||||||
(* -- *)
|
(* -- *)
|
||||||
|
|
||||||
let gen_key ~section_name t1 t2 =
|
let gen_key ~section_name t1 t2 =
|
||||||
|
|
@ -153,8 +133,6 @@ let split_in_periodes ~start ~end_ ~duration_withdraw =
|
||||||
go acc start end_
|
go acc start end_
|
||||||
|
|
||||||
let gen_additional_keys_until_lookahead ~now ~section_name l =
|
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 =
|
let start =
|
||||||
match List.rev (sort_keys l) with
|
match List.rev (sort_keys l) with
|
||||||
| [] -> now
|
| [] -> now
|
||||||
|
|
@ -170,24 +148,18 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
||||||
in
|
in
|
||||||
new_keys
|
new_keys
|
||||||
|
|
||||||
let load_section fs section_name =
|
let load fs =
|
||||||
(* TODO section_name *)
|
let* () =
|
||||||
let section_name =
|
if Fat.exists fs Cfg.key_dir then Ok ()
|
||||||
match Sfn.of_string section_name with
|
else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
|
||||||
| Error (`Msg e) -> Fmt.failwith "invalid section_name %s" e
|
|
||||||
| Ok sfn -> sfn
|
|
||||||
in
|
in
|
||||||
let section_spath = Spath.(Cfg.key_dir / section_name) in
|
let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
|
||||||
let* l = get_key_dir_contents fs section_spath 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 =
|
let l =
|
||||||
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
||||||
in
|
in
|
||||||
let* keys = list_map (read_key fs) l in
|
let* keys = list_map (read_key fs) 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
|
|
||||||
match keys with
|
match keys with
|
||||||
| [] -> Ok None
|
| [] -> Ok None
|
||||||
| _l ->
|
| _l ->
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue