+fix secmod_rsa; (wip)

src/crypto.ml

@@ -238,6 +238,10 @@ module RsaPrivateKey = struct
   let of_octets = Binary_format_rsa.priv_of_octets
   let to_octets = Binary_format_rsa.priv_to_octets
 
+  let bin =
+    let of_octets_exn t = of_octets t |> Result.get_ok in
+    Bin.map Bin.cstring of_octets_exn to_octets
+
   let jsont =
     let of_b32 s =
       let* s = B32.decode s in

src/secmod_eddsa.ml

@@ -45,6 +45,19 @@ let key_bin =
   |+ field EddsaPrivateKey.bin (fun t -> t.priv)
   |> sealr
 
+(* 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 write_eddsa fs spath priv =
+  Log.debug (fun m -> m "writing key file `%a`" Spath.pp spath);
+  let data = EddsaPrivateKey.to_octets priv in
+  Fat.write fs spath data |> unwrap_msg
+
 let key_spath k =
   let sfn_res = String.sub (EddsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in
   match sfn_res with
@@ -58,23 +71,12 @@ let read_key fs spath =
   let k = Bin.decode key_bin data (ref 0) in
   Ok k
 
-let write_eddsa fs spath k =
+let write_key fs spath k =
   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 write_sm_key fs t =
+let write_key fs k = write_key fs (key_spath k) k
-  let k =
-    {
-      t1= TimeAbsolute.never;
-      t2= TimeAbsolute.never;
-      priv= t.sm_priv;
-      pub= t.sm_pub;
-    }
-  in
-  write_eddsa fs Cfg.sm_priv_key k
-
-let write_key fs k = write_eddsa fs (key_spath k) k
 
 let delete_file fs spath =
   Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
@@ -134,10 +136,10 @@ let load fs =
   match keys with
   | [] -> Ok None
   | _l ->
-      let* sm_key = read_key fs Cfg.sm_priv_key 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_priv= sm_key.priv; sm_pub= sm_key.pub; ht })
+      Ok (Some { fs; sm_priv; sm_pub; ht })
 
 let init fs =
   let* opt = load fs in
@@ -150,7 +152,7 @@ let init fs =
             m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
         let ht = Hashtbl.create 0xff in
         let t = { fs; sm_priv; sm_pub; ht } in
-        let* () = write_sm_key fs t 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

src/secmod_rsa.ml

@@ -6,12 +6,22 @@ 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
   include Exchange_secmod_rsa
 
+  (* TODO 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: *)
 
@@ -49,81 +59,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 key_bin =
-  let scan_filename s =
+  let open Bin in
-    Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
+  record (fun t1 t2 section_name priv ->
-        (TimeAbsolute.of_s t1, TimeAbsolute.of_s t2))
+      let pub = RsaPrivateKey.pub_of_priv priv in
-  in
+      let h_pub = DenominationHash.hash_of_rsa pub in
-  fun fpath -> scan_filename (Fpath.filename fpath)
+      { 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 pp_filename =
+let key_spath k =
-  let to_int64 abs =
+  let sfn_res = String.sub (RsaPublicKey.to_b32 k.pub) 0 8 |> Sfn.of_string in
-    abs |> Timestamp.of_absolute |> Timestamp.to_s |> function
+  match sfn_res with
-    | None ->
+  | Error _ -> failwith "not possible"
-        (* (= `never`) this should not happen given resonable config value *)
+  | Ok sfn -> Spath.(Cfg.key_dir / sfn)
-        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 key_fpath k =
+let read_eddsa fs spath =
-  let fname = Fmt.str "%a" pp_filename (k.t1, k.t2) in
+  Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
-  Fpath.(v Cfg.key_dir / k.section_name / fname)
+  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)
 
-(* -- IO -- *)
+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
+  Fat.write fs spath data |> unwrap_msg
 
-let read_eddsa fs fpath =
+let read_key fs spath =
-  Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
+  Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
-  let fpath = Fpath.to_string fpath in
+  let* data = Fat.read fs spath |> unwrap_msg in
-  let* data = Fat.read fs fpath |> unwrap_msg in
+  (* todo: catch failure *)
-  EddsaPrivateKey.of_octets data
+  let k = Bin.decode key_bin data (ref 0) in
+  Ok k
 
-let read_rsa fs fpath =
+let read_rsa fs spath =
-  Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath);
+  Log.debug (fun m -> m "reading key file `%a`" Spath.pp spath);
-  let fpath = Fpath.to_string fpath in
+  let* data = Fat.read fs spath |> unwrap_msg in
-  let* data = Fat.read fs fpath |> unwrap_msg in
   RsaPrivateKey.of_octets data
 
-let write_eddsa fs fpath priv =
+let write_rsa fs spath priv =
-  Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
-  let data = EddsaPrivateKey.to_octets priv in
-  let fpath = Fpath.to_string fpath in
-  Fat.write fs fpath 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 spath data |> unwrap_msg
-  Fat.write fs fpath data |> unwrap_msg
 
-let write_key fs k = write_rsa fs (key_fpath k) k.priv
+let write_key fs k = write_rsa fs (key_spath k) k.priv
 
-let delete_file fs fpath =
+let delete_file fs spath =
-  (* check fpath just to be safe *)
+  Log.debug (fun m -> m "delete key file `%a`" Spath.pp spath);
-  let () =
+  let+ () = Fat.remove fs spath |> unwrap_msg in
-    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 get_key_dir_contents fs dir_fpath =
+let get_key_dir_contents fs dir =
-  let dir_fpath = Fpath.to_string dir_fpath in
+  Log.debug (fun m -> m "get_key_dir_contents `%a`" Spath.pp dir);
-  let* () = Fat.mkdir fs dir_fpath |> unwrap_msg in
+  let* () = Fat.mkdir fs dir |> unwrap_msg in
-  Log.info (fun m -> m "created directory `%s`" dir_fpath);
+  let+ l = Fat.ls fs dir |> unwrap_msg in
-  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
+  let l = List.map (Spath.add dir) l in
   l
 
 (* -- *)
@@ -132,10 +131,10 @@ 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)
+      m "generated key %s `%s`" section_name (DenominationHash.to_b32 k.h_pub));
-        (DenominationHash.to_octets h_pub |> B32.encode));
+  k
-  { section_name; priv; pub; h_pub; t1; t2 }
 
 let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
 
@@ -171,28 +170,19 @@ 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
+  (* TODO section_name *)
-  let* l = get_key_dir_contents fs section_fpath in
+  let section_name =
-  let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
+    match Sfn.of_string section_name with
-  let* keys = list_map (load_key fs ~section_name) l in
+    | Error (`Msg e) -> Fmt.failwith "invalid section_name %s" e
+    | Ok sfn -> sfn
+  in
+  let section_spath = Spath.(Cfg.key_dir / section_name) in
+  let* l = get_key_dir_contents fs section_spath 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
   Ok keys
 
 let load fs =
@@ -201,11 +191,10 @@ let load fs =
   match keys with
   | [] -> Ok None
   | _l ->
-      let* sm_key_priv = read_eddsa fs sm_key_fpath in
+      let* sm_priv, sm_pub = read_eddsa fs Cfg.sm_priv_key in
-      let sm_pub = EddsaPrivateKey.pub_of_priv sm_key_priv 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 +203,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 +237,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 +253,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