JJ: Description from the destination commit:

wip debug secmod

JJ: Description from source commit:
ok secmod with logs

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,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 delete_file fpath =
-  let+ () =
+  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
-    Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
+  (* TODO just to be safe~~
-  in
+  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
+  if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir);
-    Logs.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
 
 (* -- *)
 
+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
+  if Absolute.compare start end_ >= 0 then []
+  else
     let periodes = split_in_periodes ~start ~end_ in
-  let new_keys =
+    let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
-    List.map
-      (fun (t1, t2) ->
-        let priv, pub = EddsaPrivateKey.generate () in
-        { priv; pub; 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 = gen_key t1 t2 in
-    let k = { priv; pub; 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

src/secmod_rsa.ml

@@ -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 delete_file fpath =
-  let+ () =
+  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
-    Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
+  (* TODO just to be safe~~
-  in
+  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
+  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_ =
@@ -110,13 +124,11 @@ 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
+  if Absolute.compare start end_ >= 0 then []
+  else
     let periodes = split_in_periodes ~start ~end_ in
     let new_keys =
-    List.map
+      List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes
-      (fun (t1, t2) ->
-        let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
-        { section_name; priv; pub; t1; t2 })
-      periodes
     in
     new_keys
 
@@ -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 = 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,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 ();