+ secmod load and init

src/secmod_eddsa.ml

@@ -1,53 +1,173 @@
 open Syntax
 open Crypto
-
-let read fname = Bos.OS.File.read fname |> unwrap_err_msg
-let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
-
-let read_eddsa fname =
-  let* data = read fname in
-  EddsaPrivateKey.of_octets data
-
-let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
-
-module Config = struct
-  (* TODO config *)
-  open Config.Exchange_secmod_eddsa
-
-  let dir = Config.secmod_eddsa_dir
-  let lookahead_sign = lookahead_sign
-  let overlap_duration = overlap_duration
-  let duration = duration
-end
-
 open Mirage_crypto_ec
+open Config.Exchange_secmod_eddsa
+open Time
 
 type priv = Ed25519.priv
 type pub = Ed25519.pub
 
-type t = {
+type key = {
   priv: priv;
   pub: pub;
-  start: Timestamp.t;
-  end_: Timestamp.t;
+  t1: Absolute.t;
+  t2: Absolute.t;
 }
 
+type t = {
+  sm_key_priv: priv;
+  sm_key_pub: pub;
+  keys: key list;
+}
+
+let time_abs_of_string s =
+  match int_of_string_opt s with
+  | None -> None
+  | Some n ->
+      let ts = Absolute.of_s (Int64.of_int n) in
+      Some ts
+
+let time_abs_to_string abs =
+  abs
+  |> Timestamp.of_absolute
+  |> Timestamp.to_s
+  |> Option.get
+  |> Int64.to_int
+  |> string_of_int
+
+let read_key fname =
+  let fpath = Fpath.(v key_dir / fname) in
+  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
+  EddsaPrivateKey.of_octets data
+
+let write_eddsa fname priv =
+  let fpath = Fpath.(v key_dir / fname) in
+  let data = EddsaPrivateKey.to_octets priv in
+  Bos.OS.File.write fpath data |> unwrap_err_msg
+
+let write_key t =
+  let t1 = time_abs_to_string t.t1 in
+  let t2 = time_abs_to_string t.t2 in
+  let fname = Fmt.str "%s-%s" t1 t2 in
+  write_eddsa fname t.priv
+
+let split_in_periodes ~start ~end_ =
+  (* no overlap on first periode
+     this is to not generate a key valid in the past *)
+  let t1 = start in
+  let t2 = Absolute.add start duration in
+  let acc = [ (t1, t2) ] in
+  let start = t2 in
+  let rec go acc start end_ =
+    let t1 = Absolute.sub start overlap_duration in
+    let t2 = Absolute.add start duration in
+    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
+  in
+  go acc start end_
+
+let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
+
+let gen_additional_keys_until_lookahead ~now l =
+  let l = sort_keys l in
+  let start =
+    let l_rev = List.rev l in
+    match l_rev with
+    | [] -> now
+    | hd :: _ -> Absolute.sub hd.t2 overlap_duration
+  in
+  let end_ = Absolute.add now lookahead_sign in
+  let periodes = split_in_periodes ~start ~end_ in
+  let new_keys =
+    List.map
+      (fun (t1, t2) ->
+        let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+        { priv; pub; t1; t2 })
+      periodes
+  in
+  new_keys
+
+let check_periodes _l =
+  (* TODO *)
+  Ok ()
+
+let purge _t =
+  (* TODO *)
+  Ok ()
+
+let purge_outdated ~now l =
+  let+ l =
+    list_map
+      (fun t ->
+        if Absolute.compare now t.t2 >= 0 then
+          let* () = purge t in
+          Ok None
+        else Ok (Some t))
+      l
+  in
+  List.filter_map Fun.id l
+
+let load_key fpath =
+  let fname = Fpath.filename fpath in
+  if fname = sm_priv_key then Ok None
+  else
+    match String.split_on_char '-' fname with
+    | [] -> Fmt.failwith "not possible"
+    | [ t1; t2 ] -> (
+        match (time_abs_of_string t1, time_abs_of_string t2) with
+        | None, _ | _, None -> Fmt.error "invalid filename `%s`" fname
+        | Some t1, Some t2 ->
+            let* priv = read_key fname in
+            let pub = EddsaPrivateKey.pub_of_priv priv in
+            Ok (Some { priv; pub; t1; t2 }))
+    | _ -> Ok None
+
+let load () =
+  let dir = Fpath.v key_dir 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);
+  let* l =
+    Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
+  in
+  let* l = list_map load_key l in
+  let keys = List.filter_map Fun.id l in
+  match keys with
+  | [] -> Ok None
+  | _l ->
+      let* sm_key_priv = read_key sm_priv_key in
+      let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+      Ok (Some { sm_key_priv; sm_key_pub; keys })
+
+let init () =
+  let* opt = load () in
+  let* t =
+    match opt with
+    | Some t -> Ok t
+    | None ->
+        let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
+        let* () = write_eddsa sm_priv_key sm_key_priv in
+        Ok { sm_key_priv; sm_key_pub; keys= [] }
+  in
+  let now = Absolute.of_ptime (Ptime_clock.now ()) in
+  let* keys = purge_outdated ~now t.keys in
+  let* () = check_periodes keys in
+  let new_keys = gen_additional_keys_until_lookahead ~now keys in
+  let* () = list_iter write_key new_keys in
+  let keys = keys @ new_keys in
+  let keys = sort_keys keys in
+  let t = { t with keys } in
+  Ok t
+
+let t =
+  match init () with
+  | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
+  | Ok t -> t
+
 (*
-  create dir if not exists
-  read dir contents
-  init sm_key
-  check filename
-  build sorted list
-  check overlaps
-  just fail if not good
-  add keys until lookahead
-
-
-
   - sign
-  - verify
   - expose future_sk list
   - purge
+  - revoke
   - schedule tasks
   - !lock