diff --git a/src/crypto.ml b/src/crypto.ml index 383d86f9..4ce582f9 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -207,6 +207,7 @@ module RsaPublicKey = struct let to_octets = Binary_format_rsa.pub_to_octets let of_octets = Binary_format_rsa.pub_of_octets + let to_b32 t = B32.encode (to_octets t) let jsont = let of_b32 s = @@ -214,7 +215,6 @@ module RsaPublicKey = struct let+ v = of_octets s in v in - let to_b32 t = B32.encode (to_octets t) in Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 let caqti : t Caqti_type.t = diff --git a/src/keys.ml b/src/keys.ml index 82d2b10f..1088f526 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -17,12 +17,11 @@ module Make (Conn : Pg.CONN) = struct let secmod_eddsa_pub = Sm_eddsa.sm_pub let secmod_rsa_pub = Sm_rsa.sm_pub - (* TODO error - should be a "key not found", either: + (* TODO + error "key not found", either: - we tried to sign with a key that is not ours - key was revoked - - bad keyring state - *) + - bad keyring state *) let sign pub s = match Sm_eddsa.sign pub s with | Error e -> Fmt.failwith "sign failure: %s." e @@ -37,6 +36,8 @@ module Make (Conn : Pg.CONN) = struct let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti + (* TODO + check if database is coherent with secmod *) let signkeys () : Signkey.t list result = let now = Timestamp.of_ptime @@ Ptime_clock.now () in Pg.get_active_signkeys conn ~now |> unwrap_err_caqti diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index 70a6f33e..f83ca224 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -1,3 +1,8 @@ +let src = Logs.Src.create "mte.secmod_eddsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) open Syntax open Crypto open Time @@ -18,6 +23,7 @@ type t = { (* -- util -- *) +(* TODO time *) let time_abs_of_string s = int_of_string_opt s |> Option.map (fun n -> Absolute.of_s (Int64.of_int n)) @@ -48,33 +54,43 @@ let key_fpath k = (* -- IO -- *) 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 EddsaPrivateKey.of_octets data let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); let data = EddsaPrivateKey.to_octets priv in Bos.OS.File.write fpath data |> unwrap_err_msg 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 delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () 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); + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir); let+ l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg in l (* -- *) +let gen_key t1 t2 = + let priv, pub = EddsaPrivateKey.generate () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) + (EddsaPublicKey.to_b32 pub)); + { priv; pub; t1; t2 } + let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l let split_in_periodes ~start ~end_ = @@ -91,25 +107,22 @@ let split_in_periodes ~start ~end_ = in go acc start end_ +(* TODO do not exceed lookahead (probably more important...) *) +(* try to not generate keys with validity start in the past *) let gen_additional_keys_until_lookahead ~now l = - (* TODO do not exceed lookahead (probably more important...) *) - (* try to not generate keys with validity start in the past *) let start = match List.rev (sort_keys l) with | [] -> now | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration in let end_ = Absolute.add now Cfg.lookahead_sign in - let periodes = split_in_periodes ~start ~end_ in - let new_keys = - List.map - (fun (t1, t2) -> - let priv, pub = EddsaPrivateKey.generate () in - { priv; pub; t1; t2 }) - periodes - in - new_keys + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in + new_keys +(* TODO config *) let sm_key_fpath = Result.get_ok @@ @@ -149,6 +162,8 @@ let init () = | Some t -> Ok t | None -> 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 ht = Hashtbl.create 0xff in Ok { sm_key_priv; sm_pub; ht } @@ -175,14 +190,14 @@ module Make () = struct Hashtbl.find_opt t.ht pub |> Option.to_result ~none:"key not found" let add t1 t2 = - let priv, pub = EddsaPrivateKey.generate () in - let k = { priv; pub; t1; t2 } in + let k = gen_key t1 t2 in Hashtbl.replace t.ht k.pub k; () let delete pub = 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 = Hashtbl.to_seq_values t.ht diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 5aa348b8..50aa954f 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -1,4 +1,9 @@ (* TODO refacto common parts with secmod_eddsa *) +let src = Logs.Src.create "mte.secmod_rsa" + +module Log = (val Logs.src_log src : Logs.LOG) + +(* - *) open Syntax open Crypto open Time @@ -50,14 +55,17 @@ let key_fpath k = (* -- IO -- *) let read_eddsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); let* data = Bos.OS.File.read fpath |> unwrap_err_msg in EddsaPrivateKey.of_octets data let read_rsa fpath = + Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); let* data = Bos.OS.File.read fpath |> unwrap_err_msg in RsaPrivateKey.of_octets data let write_eddsa fpath priv = + Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); let data = EddsaPrivateKey.to_octets priv in Bos.OS.File.write fpath data |> unwrap_err_msg @@ -67,24 +75,30 @@ let write_rsa fpath priv = let write_key k = write_rsa (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 delete_file fpath = + Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath); + (* TODO just to be safe~~ + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in +*) + Ok () let get_key_dir_contents dir_fpath = let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in - if b then - Logs.info (fun m -> - m "secmod_rsa: created directory `%a`" Fpath.pp dir_fpath); + if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath); let+ l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir_fpath |> unwrap_err_msg + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg in l (* -- *) +let gen_key section_name t1 t2 = + let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in + Log.debug (fun m -> + m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1) + (time_abs_to_string t2) (RsaPublicKey.to_b32 pub)); + { section_name; priv; pub; t1; t2 } + let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l let split_in_periodes ~start ~end_ = @@ -110,15 +124,13 @@ let gen_additional_keys_until_lookahead ~now ~section_name l = | hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration in let end_ = Absolute.add now Cfg.lookahead_sign in - let periodes = split_in_periodes ~start ~end_ in - let new_keys = - List.map - (fun (t1, t2) -> - let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in - { section_name; priv; pub; t1; t2 }) - periodes - in - new_keys + if Absolute.compare start end_ >= 0 then [] + else + let periodes = split_in_periodes ~start ~end_ in + let new_keys = + List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes + in + new_keys let sm_key_fpath = Result.get_ok @@ -165,6 +177,8 @@ let init () = | Some t -> Ok t | None -> 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 ht = Hashtbl.create 0xff in Ok { sm_key_priv; sm_pub; ht } @@ -202,7 +216,8 @@ module Make () = struct let delete pub = 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 = Hashtbl.to_seq_values t.ht @@ -212,8 +227,7 @@ module Make () = struct |> list_iter delete let add section_name t1 t2 = - let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in - let k = { section_name; priv; pub; t1; t2 } in + let k = gen_key section_name t1 t2 in Hashtbl.replace t.ht k.pub k; () diff --git a/src/util.ml b/src/util.ml index c690a009..bf00cd53 100644 --- a/src/util.ml +++ b/src/util.ml @@ -48,10 +48,8 @@ module Log_reporter = struct in { report } - (* TODO logs - - vif shouldn't use/set the default reporter - - Log.err all `Internal_server_error response *) let setup () = + (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*) let level = Some Logs.Info in Logs.set_level ~all:false level; Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();