This commit is contained in:
swrup 2026-02-20 10:14:33 +01:00
parent c7309f71a3
commit 0a17e307ae

View file

@ -20,6 +20,8 @@ type t = {
mutable keys: key list;
}
(* -- util -- *)
let time_abs_of_string s =
match int_of_string_opt s with
| None -> None
@ -27,7 +29,8 @@ let time_abs_of_string s =
let ts = Absolute.of_s (Int64.of_int n) in
Some ts
let t1_t2_of_filename fname =
let t1_t2_of_fpath fpath =
let fname = Fpath.filename fpath in
match String.split_on_char '-' fname with
| [] -> Fmt.failwith "not possible"
| [ t1; t2 ] -> (
@ -44,22 +47,42 @@ let time_abs_to_string abs =
|> Int64.to_int
|> string_of_int
let key_filename k =
let key_fpath k =
let t1 = time_abs_to_string k.t1 in
let t2 = time_abs_to_string k.t2 in
Fmt.str "%s-%s" t1 t2
let fname = Fmt.str "%s-%s" t1 t2 in
Fpath.(v Cfg.key_dir / fname)
let read_key fname =
let fpath = Fpath.(v Cfg.key_dir / fname) in
(* -- IO -- *)
let read_key fpath =
let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
EddsaPrivateKey.of_octets data
let write_eddsa fname priv =
let fpath = Fpath.(v Cfg.key_dir / fname) in
let write_eddsa fpath priv =
let data = EddsaPrivateKey.to_octets priv in
Bos.OS.File.write fpath data |> unwrap_err_msg
let write_key k = write_eddsa (key_filename k) k.priv
let write_key k = write_eddsa (key_fpath k) k.priv
let delete_key_file k =
let+ () =
Bos.OS.File.delete ~must_exist:true (key_fpath k) |> unwrap_err_msg
in
()
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
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
l
(* -- *)
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
let split_in_periodes ~start ~end_ =
@ -101,31 +124,26 @@ let check_periodes _l =
(* we load sm_key separately
we don't accept non-key files in key_dir *)
let load_key fpath =
let fname = Fpath.filename fpath in
match fname = Cfg.sm_priv_key with
match Fpath.filename fpath = Cfg.sm_priv_key with
| true -> Ok None
| false -> (
match t1_t2_of_filename fname with
| None -> Fmt.error "invalid filename `%s`" fname
match t1_t2_of_fpath fpath with
| None -> Fmt.error "invalid file `%a`" Fpath.pp fpath
| Some (t1, t2) ->
let* priv = read_key fname in
let* priv = read_key fpath in
let pub = EddsaPrivateKey.pub_of_priv priv in
Ok (Some { priv; pub; t1; t2 }))
let sm_key_fpath = Fpath.(v Cfg.key_dir / Cfg.sm_priv_key)
let load () =
let dir = Fpath.v Cfg.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 = get_key_dir_contents Cfg.key_dir 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 Cfg.sm_priv_key in
let* sm_key_priv = read_key sm_key_fpath in
let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
Ok (Some { sm_key_priv; sm_key_pub; keys })
@ -136,7 +154,7 @@ let init () =
| Some t -> Ok t
| None ->
let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
let* () = write_eddsa Cfg.sm_priv_key sm_key_priv in
let* () = write_eddsa sm_key_fpath sm_key_priv in
Ok { sm_key_priv; sm_key_pub; keys= [] }
in
let now = Absolute.of_ptime (Ptime_clock.now ()) in
@ -171,11 +189,8 @@ let delete_key pub =
let* k = find_key pub in
let l = List.filter (fun k -> k.pub <> pub) t.keys in
t.keys <- l;
(* rm file *)
let fname = key_filename k in
let fpath = Fpath.(v Cfg.key_dir / fname) in
let* () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
Ok ()
let+ () = delete_key_file k in
()
let delete_outdated ~now =
t.keys