wip debug secmod

This commit is contained in:
swrup 2026-02-21 19:25:31 +01:00
parent cb33942711
commit ef99df55a4

View file

@ -1,3 +1,6 @@
let src = Logs.Src.create "mte.secmod_eddsa"
module Log = (val Logs.src_log src : Logs.LOG)
open Syntax open Syntax
open Crypto open Crypto
open Time open Time
@ -18,6 +21,7 @@ type t = {
(* -- util -- *) (* -- util -- *)
(* TODO time *)
let time_abs_of_string s = let time_abs_of_string s =
int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n))
@ -48,26 +52,29 @@ let key_fpath k =
(* -- IO -- *) (* -- IO -- *)
let read_key fpath = 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 let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
EddsaPrivateKey.of_octets data EddsaPrivateKey.of_octets data
let write_eddsa fpath priv = let write_eddsa fpath priv =
Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath);
let data = EddsaPrivateKey.to_octets priv in let data = EddsaPrivateKey.to_octets priv in
Bos.OS.File.write fpath data |> unwrap_err_msg Bos.OS.File.write fpath data |> unwrap_err_msg
let write_key k = write_eddsa (key_fpath k) k.priv 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 get_key_dir_contents dir =
let* dir = Fpath.of_string dir |> unwrap_err_msg in let* dir = Fpath.of_string dir |> unwrap_err_msg in
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
if b then if b then
Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir); Log.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
let+ l = let+ l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
in in
@ -75,6 +82,14 @@ 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"
(EddsaPublicKey.to_b32 pub)
(time_abs_to_string t1) (time_abs_to_string t2));
{ priv; pub; t1; t2 }
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
let split_in_periodes ~start ~end_ = let split_in_periodes ~start ~end_ =
@ -91,9 +106,9 @@ let split_in_periodes ~start ~end_ =
in in
go acc start end_ go acc start end_
let gen_additional_keys_until_lookahead ~now l =
(* TODO do not exceed lookahead (probably more important...) *) (* TODO do not exceed lookahead (probably more important...) *)
(* try to not generate keys with validity start in the past *) (* try to not generate keys with validity start in the past *)
let gen_additional_keys_until_lookahead ~now l =
let start = let start =
match List.rev (sort_keys l) with match List.rev (sort_keys l) with
| [] -> now | [] -> now
@ -101,15 +116,10 @@ let gen_additional_keys_until_lookahead ~now l =
in in
let end_ = Absolute.add now Cfg.lookahead_sign in let end_ = Absolute.add now Cfg.lookahead_sign in
let periodes = split_in_periodes ~start ~end_ in 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 new_keys
(* TODO config *)
let sm_key_fpath = let sm_key_fpath =
Result.get_ok Result.get_ok
@@ @@
@ -149,6 +159,8 @@ let init () =
| Some t -> Ok t | Some t -> Ok t
| None -> | None ->
let sm_key_priv, sm_pub = EddsaPrivateKey.generate () in 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* () = write_eddsa sm_key_fpath sm_key_priv in
let ht = Hashtbl.create 0xff in let ht = Hashtbl.create 0xff in
Ok { sm_key_priv; sm_pub; ht } Ok { sm_key_priv; sm_pub; ht }
@ -175,14 +187,14 @@ module Make () = struct
Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found"
let add t1 t2 = 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; Hashtbl.replace t.ht k.pub k;
() ()
let delete pub = let delete pub =
let* k = find pub in 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 = let _delete_outdated ~now =
Hashtbl.to_seq_values t.ht Hashtbl.to_seq_values t.ht