+ mutex

src/secmod_eddsa.ml

@@ -1,11 +1,3 @@
-(* TODO
-   ! use lock
-   schedule tasks *)
-(* IMPROVE
-   list_issue_date: save timestamp of key generation
-   key validity period:
-     more checks + do not exceed lookahead
-   refacto common parts with secmod_rsa *)
 let src = Logs.Src.create "mte.secmod_eddsa"
 
 module Log = (val Logs.src_log src : Logs.LOG)
@@ -33,6 +25,7 @@ type t = {
   sm_priv: Eddsa.priv;
   sm_pub: Eddsa.pub;
   ht: (Eddsa.pub, key) Hashtbl.t;
+  mutex: Miou.Mutex.t;
 }
 
 open struct
@@ -110,7 +103,8 @@ open struct
         let sm_pub = Eddsa.pub_of_priv sm_priv 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_pub; ht })
+        let mutex = Miou.Mutex.create () in
+        Ok (Some { fs; sm_priv; sm_pub; ht; mutex })
 
   let create fs =
     let* opt = load fs in
@@ -121,10 +115,10 @@ open struct
           let sm_priv, sm_pub = Eddsa.generate () in
           Log.debug (fun m ->
               m "generated secmod key: `%a`" Eddsa.pp_pub sm_pub);
-          let ht = Hashtbl.create 0xff in
-          let t = { fs; sm_priv; sm_pub; ht } in
           let* () = write_sm_key fs Cfg.sm_key_path sm_priv in
-          Ok t
+          let ht = Hashtbl.create 0xff in
+          let mutex = Miou.Mutex.create () in
+          Ok { fs; sm_priv; sm_pub; ht; mutex }
     in
     let now = TimeAbsolute.of_ptime (Mirage_ptime.now ()) in
     let keys = Hashtbl.to_seq_values t.ht |> List.of_seq in
@@ -139,6 +133,19 @@ open struct
     List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys;
     let+ () = list_iter (write_key fs) new_keys in
     t
+
+  (* XXX ERR
+     either:
+       - we tried to sign with a key that is not ours
+       - key was revoked bywhile we were holding on it
+       - broken keyring state *)
+  let find_exn t pub =
+    Log.debug (fun m -> m "find_exn: `%a`" Eddsa.pp_pub pub);
+    match Hashtbl.find_opt t.ht pub with
+    | None -> Fmt.failwith "secmod_eddsa operation on unknown key"
+    | Some v -> v
+
+  let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
 end
 
 (* ### *)
@@ -149,28 +156,23 @@ let create fs =
       Fmt.failwith "secmod_eddsa initialization failure: %a." Result.pp_err e
   | Ok t -> t
 
-(* XXX ERR
-     either:
-       - we tried to sign with a key that is not ours
-       - key was revoked bywhile we were holding on it
-       - broken keyring state *)
-let find_exn t pub =
-  Log.debug (fun m -> m "find_exn: `%a`" Eddsa.pp_pub pub);
-  match Hashtbl.find_opt t.ht pub with
-  | None -> Fmt.failwith "secmod_eddsa operation on unknown key"
-  | Some v -> v
-
 let sm_pub t = t.sm_pub
-let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
-let keys t = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
-let find_key t pub = Hashtbl.find_opt t.ht pub |> Option.map conv
 let sign_secmod t s = Eddsa.sign ~key:t.sm_priv s
 
+let keys t =
+  Miou.Mutex.protect t.mutex @@ fun () ->
+  Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
+
+let find_key t pub =
+  Miou.Mutex.protect t.mutex @@ fun () ->
+  Hashtbl.find_opt t.ht pub |> Option.map conv
+
 let sign t pub s =
-  let k = find_exn t pub in
+  let k = Miou.Mutex.protect t.mutex @@ fun () -> find_exn t pub in
   Eddsa.sign ~key:k.priv s
 
 let revoke t pub =
+  Miou.Mutex.protect t.mutex @@ fun () ->
   let k = find_exn t pub in
   Hashtbl.remove t.ht pub;
   let* () = delete_file t.fs (key_spath k) in

src/secmod_rsa.ml

@@ -29,6 +29,7 @@ type t = {
   sm_priv: Eddsa.priv;
   sm_pub: Eddsa.pub;
   ht: (DenominationHash.t, key) Hashtbl.t;
+  mutex: Miou.Mutex.t;
 }
 
 open struct
@@ -134,7 +135,8 @@ open struct
         let sm_pub = Eddsa.pub_of_priv sm_priv in
         let ht = Hashtbl.create 0xff in
         List.iter (fun k -> Hashtbl.replace ht k.h_pub k) keys;
-        Ok (Some { fs; sm_priv; sm_pub; ht })
+        let mutex = Miou.Mutex.create () in
+        Ok (Some { fs; sm_priv; sm_pub; ht; mutex })
 
   let create fs =
     let* opt = load fs in
@@ -148,7 +150,8 @@ open struct
               m "generated secmod key: `%a`" Eddsa.pp_pub sm_pub);
           let* () = write_sm_key fs Cfg.sm_key_path sm_priv in
           let ht = Hashtbl.create 0xff in
-          Ok { fs; sm_priv; sm_pub; ht }
+          let mutex = Miou.Mutex.create () in
+          Ok { fs; sm_priv; sm_pub; ht; mutex }
     in
     let keys = Hashtbl.to_seq_values t.ht |> List.of_seq in
     let new_keys =
@@ -168,6 +171,14 @@ open struct
     List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
     let+ () = list_iter (write_key fs) new_keys in
     t
+
+  let find_exn t h_pub =
+    Log.debug (fun m -> m "find_exn: `%a`" DenominationHash.pp h_pub);
+    match Hashtbl.find_opt t.ht h_pub with
+    | None -> Fmt.failwith "secmod_rsa operation on unknown key"
+    | Some v -> v
+
+  let conv k = (k.h_pub, (k.coin, k.pub, k.t1))
 end
 
 (* ### *)
@@ -178,23 +189,23 @@ let create fs =
       Fmt.failwith "secmod_rsa initialization failure: %a." Result.pp_err e
   | Ok t -> t
 
-let find_exn t h_pub =
-  Log.debug (fun m -> m "find_exn: `%a`" DenominationHash.pp h_pub);
-  match Hashtbl.find_opt t.ht h_pub with
-  | None -> Fmt.failwith "secmod_rsa operation on unknown key"
-  | Some v -> v
-
 let sm_pub t = t.sm_pub
-let conv k = (k.h_pub, (k.coin, k.pub, k.t1))
-let keys t = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
-let find_key t h_pub = Hashtbl.find_opt t.ht h_pub |> Option.map conv
 let sign_secmod t s = Eddsa.sign ~key:t.sm_priv s
 
+let keys t =
+  Miou.Mutex.protect t.mutex @@ fun () ->
+  Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv
+
+let find_key t h_pub =
+  Miou.Mutex.protect t.mutex @@ fun () ->
+  Hashtbl.find_opt t.ht h_pub |> Option.map conv
+
 let sign t h_pub s =
-  let k = find_exn t h_pub in
+  let k = Miou.Mutex.protect t.mutex @@ fun () -> find_exn t h_pub in
   Rsa.sign ~key:k.priv s
 
 let revoke t h_pub =
+  Miou.Mutex.protect t.mutex @@ fun () ->
   let k = find_exn t h_pub in
   Hashtbl.remove t.ht h_pub;
   let* () = delete_file t.fs (key_spath k) in