Merge pull request #228 from hannesm/dsa-sexp

roll our own dsa_to/of_sexp, since mirage-crypto-pk will remove these functions soon
hannesm · Feb 28, 2024 · 31b9027 · 31b9027
2 parents a7acd19 + 74e7ab8
commit 31b9027
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 3 deletions.
diff --git a/src/persistency.ml b/src/persistency.ml
@@ -199,10 +199,16 @@ let load_password cfgdir =
 
 let otr_dsa = "otr_dsa.sexp"
 
+let sexp_of_priv Mirage_crypto_pk.Dsa.{ p ; q ; gg ; x ; y } =
+  let open Conv in
+  let sexp_of_z z = sexp_of_string (Z.to_string z) in
+  sexp_of_list (sexp_of_pair sexp_of_string sexp_of_z)
+    [ "p", p; "q", q; "gg", gg; "x", x; "y", y ]
+
 let dump_dsa cfgdir dsa =
-  write cfgdir otr_dsa (Bytes.of_string (Sexp.to_string_hum (Mirage_crypto_pk.Dsa.sexp_of_priv dsa)))
+  write cfgdir otr_dsa (Bytes.of_string (Sexp.to_string_hum (sexp_of_priv dsa)))
 
 let load_dsa cfgdir =
   read cfgdir otr_dsa >|= function
   | None -> None
-  | Some x -> Some (Mirage_crypto_pk.Dsa.priv_of_sexp (Sexp.of_string x))
+  | Some x -> Some (Xconfig.dsa_priv_of_sexp (Sexp.of_string x))
diff --git a/src/xconfig.ml b/src/xconfig.ml
@@ -25,6 +25,15 @@ type t = {
 
 let current_version = 3
 
+let dsa_priv_of_sexp s =
+  let z_of_sexp s = Z.of_string (string_of_sexp s) in
+  match list_of_sexp (pair_of_sexp string_of_sexp z_of_sexp) s with
+  | [ "p", p; "q", q; "gg", gg; "x", x; "y", y ] ->
+    (match Mirage_crypto_pk.Dsa.priv ?fips:None ~p ~q ~gg ~x ~y () with
+     | Ok p -> p
+     | Error (`Msg m) -> invalid_arg ("bad private " ^ m))
+  | _ -> raise (Of_sexp_error (Failure "expected p, q, gg, x, and y'", s))
+
 let dsa_of_cfg_sexp t =
   match t with
   | Sexp.List l ->
@@ -33,7 +42,7 @@ let dsa_of_cfg_sexp t =
            List.fold_left (fun (dsa, cfg) -> function
                | Sexp.List [ Sexp.Atom "policies" ; _ ] as p -> (dsa, p :: cfg)
                | Sexp.List [ Sexp.Atom "versions" ; _ ] as v -> (dsa, v :: cfg)
-               | Sexp.List [ Sexp.Atom "dsa" ; d ] -> (Some (Mirage_crypto_pk.Dsa.priv_of_sexp d), cfg)
+               | Sexp.List [ Sexp.Atom "dsa" ; d ] -> (Some (dsa_priv_of_sexp d), cfg)
                | _ -> raise (Invalid_argument "broken sexp while trying to find dsa"))
              (dsa, cfg) data
          | _ -> (dsa, cfg))