src/crypto.ml

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

src/keys.ml

@@ -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
+  (* TODO
-     should be a "key not found", either:
+     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

src/secmod_eddsa.ml

@@ -1,4 +1,8 @@
-module Log = (val Logs.src_log (Logs.Src.create "mte.secmod_eddsa") : Logs.LOG)
+let src = Logs.Src.create "mte.secmod_eddsa"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* - *)
 open Syntax
 open Crypto
 open Time
@@ -71,10 +75,9 @@ let delete_file fpath =
 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
+  if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
-    Log.info (fun m -> m "secmod_eddsa: 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
 
@@ -83,9 +86,9 @@ let get_key_dir_contents dir =
 let gen_key t1 t2 =
   let priv, pub = EddsaPrivateKey.generate () in
   Log.debug (fun m ->
-      m "generated key: %s  %s-%s"
+      m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
-        (EddsaPublicKey.to_b32 pub)
+        (time_abs_to_string t2)
-        (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
@@ -113,9 +116,11 @@ let gen_additional_keys_until_lookahead ~now 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
+  if Absolute.compare start end_ >= 0 then []
-  let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
+  else
-  new_keys
+    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 =
@@ -158,7 +163,7 @@ let init () =
     | None ->
         let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in
         Log.debug (fun m ->
-            m "generated secmod key: %s" (EddsaPublicKey.to_b32 sm_pub));
+            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 }

src/secmod_rsa.ml

@@ -1,5 +1,9 @@
 (* TODO refacto common parts with secmod_eddsa *)
-module Log = (val Logs.src_log (Logs.Src.create "mte.secmod_rsa") : Logs.LOG)
+let src = Logs.Src.create "mte.secmod_rsa"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* - *)
 open Syntax
 open Crypto
 open Time
@@ -51,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
 
@@ -77,16 +84,21 @@ let delete_file fpath =
 
 let get_key_dir_contents dir_fpath =
   let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
-  if b then
+  if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath);
-    Logs.info (fun m ->
-        m "secmod_rsa: 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_ =
@@ -112,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
+  if Absolute.compare start end_ >= 0 then []
-  let new_keys =
+  else
-    List.map
+    let periodes = split_in_periodes ~start ~end_ in
-      (fun (t1, t2) ->
+    let new_keys =
-        let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
+      List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes
-        { section_name; priv; pub; t1; t2 })
+    in
-      periodes
+    new_keys
-  in
-  new_keys
 
 let sm_key_fpath =
   Result.get_ok
@@ -167,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 }
@@ -215,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 = gen_key section_name t1 t2 in
-    let k = { section_name; priv; pub; t1; t2 } in
     Hashtbl.replace t.ht k.pub k;
     ()
 

src/util.ml

@@ -48,10 +48,9 @@ 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_eddsa.src (Some Logs.Debug);
+    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 ();