ok secmod + logs
This commit is contained in:
parent
cb33942711
commit
37ed47326a
5 changed files with 79 additions and 51 deletions
|
|
@ -207,6 +207,7 @@ module RsaPublicKey = struct
|
|||
|
||||
let to_octets = Binary_format_rsa.pub_to_octets
|
||||
let of_octets = Binary_format_rsa.pub_of_octets
|
||||
let to_b32 t = B32.encode (to_octets t)
|
||||
|
||||
let jsont =
|
||||
let of_b32 s =
|
||||
|
|
@ -214,7 +215,6 @@ module RsaPublicKey = struct
|
|||
let+ v = of_octets s in
|
||||
v
|
||||
in
|
||||
let to_b32 t = B32.encode (to_octets t) in
|
||||
Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
|
||||
|
||||
let caqti : t Caqti_type.t =
|
||||
|
|
|
|||
|
|
@ -17,12 +17,11 @@ module Make (Conn : Pg.CONN) = struct
|
|||
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:
|
||||
(* TODO
|
||||
error "key not found", either:
|
||||
- we tried to sign with a key that is not ours
|
||||
- key was revoked
|
||||
- bad keyring state
|
||||
*)
|
||||
- bad keyring state *)
|
||||
let sign pub s =
|
||||
match Sm_eddsa.sign pub s with
|
||||
| Error e -> Fmt.failwith "sign failure: %s." e
|
||||
|
|
@ -37,6 +36,8 @@ module Make (Conn : Pg.CONN) = struct
|
|||
let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti
|
||||
let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti
|
||||
|
||||
(* TODO
|
||||
check if database is coherent with secmod *)
|
||||
let signkeys () : Signkey.t list result =
|
||||
let now = Timestamp.of_ptime @@ Ptime_clock.now () in
|
||||
Pg.get_active_signkeys conn ~now |> unwrap_err_caqti
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
let src = Logs.Src.create "mte.secmod_eddsa"
|
||||
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
(* - *)
|
||||
open Syntax
|
||||
open Crypto
|
||||
open Time
|
||||
|
|
@ -18,6 +23,7 @@ type t = {
|
|||
|
||||
(* -- util -- *)
|
||||
|
||||
(* TODO time *)
|
||||
let time_abs_of_string s =
|
||||
int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n))
|
||||
|
||||
|
|
@ -48,33 +54,43 @@ let key_fpath k =
|
|||
(* -- IO -- *)
|
||||
|
||||
let read_key fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
||||
EddsaPrivateKey.of_octets data
|
||||
|
||||
let write_eddsa fpath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||
let data = EddsaPrivateKey.to_octets priv in
|
||||
Bos.OS.File.write fpath data |> unwrap_err_msg
|
||||
|
||||
let write_key k = write_eddsa (key_fpath k) k.priv
|
||||
|
||||
let delete_key_file k =
|
||||
let+ () =
|
||||
Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
|
||||
in
|
||||
()
|
||||
let delete_file fpath =
|
||||
Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
|
||||
(* TODO just to be safe~~
|
||||
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
|
||||
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
|
||||
if b then
|
||||
Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
|
||||
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
|
||||
let+ l =
|
||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
|
||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
|
||||
in
|
||||
l
|
||||
|
||||
(* -- *)
|
||||
|
||||
let gen_key t1 t2 =
|
||||
let priv, pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
|
||||
(time_abs_to_string t2)
|
||||
(EddsaPublicKey.to_b32 pub));
|
||||
{ priv; pub; t1; t2 }
|
||||
|
||||
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
|
||||
|
||||
let split_in_periodes ~start ~end_ =
|
||||
|
|
@ -91,25 +107,22 @@ let split_in_periodes ~start ~end_ =
|
|||
in
|
||||
go acc start end_
|
||||
|
||||
(* TODO do not exceed lookahead (probably more important...) *)
|
||||
(* try to not generate keys with validity start in the past *)
|
||||
let gen_additional_keys_until_lookahead ~now l =
|
||||
(* TODO do not exceed lookahead (probably more important...) *)
|
||||
(* try to not generate keys with validity start in the past *)
|
||||
let start =
|
||||
match List.rev (sort_keys l) with
|
||||
| [] -> now
|
||||
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
|
||||
in
|
||||
let end_ = Absolute.add now Cfg.lookahead_sign in
|
||||
let periodes = split_in_periodes ~start ~end_ in
|
||||
let new_keys =
|
||||
List.map
|
||||
(fun (t1, t2) ->
|
||||
let priv, pub = EddsaPrivateKey.generate () in
|
||||
{ priv; pub; t1; t2 })
|
||||
periodes
|
||||
in
|
||||
new_keys
|
||||
if Absolute.compare start end_ >= 0 then []
|
||||
else
|
||||
let periodes = split_in_periodes ~start ~end_ in
|
||||
let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
|
||||
new_keys
|
||||
|
||||
(* TODO config *)
|
||||
let sm_key_fpath =
|
||||
Result.get_ok
|
||||
@@
|
||||
|
|
@ -149,6 +162,8 @@ let init () =
|
|||
| Some t -> Ok t
|
||||
| None ->
|
||||
let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
|
||||
let* () = write_eddsa sm_key_fpath sm_key_priv in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
Ok { sm_key_priv; sm_pub; ht }
|
||||
|
|
@ -175,14 +190,14 @@ module Make () = struct
|
|||
Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
|
||||
|
||||
let add t1 t2 =
|
||||
let priv, pub = EddsaPrivateKey.generate () in
|
||||
let k = { priv; pub; t1; t2 } in
|
||||
let k = gen_key t1 t2 in
|
||||
Hashtbl.replace t.ht k.pub k;
|
||||
()
|
||||
|
||||
let delete pub =
|
||||
let* k = find pub in
|
||||
Hashtbl.remove t.ht k.pub; delete_key_file k
|
||||
Hashtbl.remove t.ht k.pub;
|
||||
delete_file (key_fpath k)
|
||||
|
||||
let _delete_outdated ~now =
|
||||
Hashtbl.to_seq_values t.ht
|
||||
|
|
|
|||
|
|
@ -1,4 +1,9 @@
|
|||
(* TODO refacto common parts with secmod_eddsa *)
|
||||
let src = Logs.Src.create "mte.secmod_rsa"
|
||||
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
(* - *)
|
||||
open Syntax
|
||||
open Crypto
|
||||
open Time
|
||||
|
|
@ -50,14 +55,17 @@ let key_fpath k =
|
|||
(* -- IO -- *)
|
||||
|
||||
let read_eddsa fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
||||
EddsaPrivateKey.of_octets data
|
||||
|
||||
let read_rsa fpath =
|
||||
Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
|
||||
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
|
||||
RsaPrivateKey.of_octets data
|
||||
|
||||
let write_eddsa fpath priv =
|
||||
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
|
||||
let data = EddsaPrivateKey.to_octets priv in
|
||||
Bos.OS.File.write fpath data |> unwrap_err_msg
|
||||
|
||||
|
|
@ -67,24 +75,30 @@ let write_rsa fpath priv =
|
|||
|
||||
let write_key k = write_rsa (key_fpath k) k.priv
|
||||
|
||||
let delete_key_file k =
|
||||
let+ () =
|
||||
Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
|
||||
in
|
||||
()
|
||||
let delete_file fpath =
|
||||
Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
|
||||
(* TODO just to be safe~~
|
||||
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
|
||||
if b then
|
||||
Logs.info (fun m ->
|
||||
m "secmod_rsa: created directory `%a`" Fpath.pp dir_fpath);
|
||||
if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath);
|
||||
let+ l =
|
||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir_fpath |> unwrap_err_msg
|
||||
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
|
||||
in
|
||||
l
|
||||
|
||||
(* -- *)
|
||||
|
||||
let gen_key section_name t1 t2 =
|
||||
let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
|
||||
Log.debug (fun m ->
|
||||
m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
|
||||
(time_abs_to_string t2) (RsaPublicKey.to_b32 pub));
|
||||
{ section_name; priv; pub; t1; t2 }
|
||||
|
||||
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
|
||||
|
||||
let split_in_periodes ~start ~end_ =
|
||||
|
|
@ -110,15 +124,13 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
|||
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
|
||||
in
|
||||
let end_ = Absolute.add now Cfg.lookahead_sign in
|
||||
let periodes = split_in_periodes ~start ~end_ in
|
||||
let new_keys =
|
||||
List.map
|
||||
(fun (t1, t2) ->
|
||||
let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
|
||||
{ section_name; priv; pub; t1; t2 })
|
||||
periodes
|
||||
in
|
||||
new_keys
|
||||
if Absolute.compare start end_ >= 0 then []
|
||||
else
|
||||
let periodes = split_in_periodes ~start ~end_ in
|
||||
let new_keys =
|
||||
List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes
|
||||
in
|
||||
new_keys
|
||||
|
||||
let sm_key_fpath =
|
||||
Result.get_ok
|
||||
|
|
@ -165,6 +177,8 @@ let init () =
|
|||
| Some t -> Ok t
|
||||
| None ->
|
||||
let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
|
||||
let* () = write_eddsa sm_key_fpath sm_key_priv in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
Ok { sm_key_priv; sm_pub; ht }
|
||||
|
|
@ -202,7 +216,8 @@ module Make () = struct
|
|||
|
||||
let delete pub =
|
||||
let* k = find pub in
|
||||
Hashtbl.remove t.ht k.pub; delete_key_file k
|
||||
Hashtbl.remove t.ht k.pub;
|
||||
delete_file (key_fpath k)
|
||||
|
||||
let _delete_outdated ~now =
|
||||
Hashtbl.to_seq_values t.ht
|
||||
|
|
@ -212,8 +227,7 @@ module Make () = struct
|
|||
|> 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
|
||||
let k = gen_key section_name t1 t2 in
|
||||
Hashtbl.replace t.ht k.pub k;
|
||||
()
|
||||
|
||||
|
|
|
|||
|
|
@ -48,10 +48,8 @@ module Log_reporter = struct
|
|||
in
|
||||
{ report }
|
||||
|
||||
(* TODO logs
|
||||
- vif shouldn't use/set the default reporter
|
||||
- Log.err all `Internal_server_error response *)
|
||||
let setup () =
|
||||
(*Logs.Src.set_level Secmod_rsa.src (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 ();
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue