diff options
Diffstat (limited to '')
-rw-r--r-- | gemini/dune | 2 | ||||
-rw-r--r-- | gemini/tlsUtils.ml | 39 | ||||
-rw-r--r-- | gemini/tlsUtils.mli | 14 |
3 files changed, 54 insertions, 1 deletions
diff --git a/gemini/dune b/gemini/dune index 3087c29..7e15878 100644 --- a/gemini/dune +++ b/gemini/dune @@ -1,4 +1,4 @@ (library (name gemini) - (libraries base angstrom angstrom-lwt-unix lwt lwt_ppx stdlib tls.lwt uri) + (libraries base angstrom angstrom-lwt-unix lwt lwt_ppx mirage-crypto-pk ptime stdlib tls.lwt uri) (preprocess (pps lwt_ppx))) diff --git a/gemini/tlsUtils.ml b/gemini/tlsUtils.ml new file mode 100644 index 0000000..0916185 --- /dev/null +++ b/gemini/tlsUtils.ml @@ -0,0 +1,39 @@ +module type TLS_UTILS = +sig + type authenticator = X509_lwt.authenticator Lwt.t + + val null_auth : authenticator + + val ca : Lwt_io.file_name -> authenticator + + val self_sign : ?bits:int -> ?days:int + -> X509.Distinguished_name.t + -> (Tls.Config.certchain, string) result +end + +module TlsUtils : TLS_UTILS = +struct + type authenticator = X509.Authenticator.t Lwt.t + + let null_auth = Lwt.return (fun ~host:_ -> fun _ -> Ok None) + + let ca path = if Sys.is_directory path then + X509_lwt.authenticator (`Ca_dir path) + else + X509_lwt.authenticator (`Ca_file path) + + let self_sign ?(bits=2048) ?(days=1) dnames = + let () = Mirage_crypto_rng_unix.initialize () in + let priv = Mirage_crypto_pk.Rsa.generate ~bits:bits () in + let csr = X509.Signing_request.create dnames (`RSA priv) in + let valid_from : Ptime.t = Ptime_clock.now () in + let valid_span = Ptime.Span.of_int_s (days * 24 * 60 * 60) in + let open Base in + let open Result.Monad_infix in + Result.of_option (Ptime.add_span valid_from valid_span) + ~error:"exceeds posix time range" >>= (fun valid_until -> + match X509.Signing_request.sign csr ~valid_from ~valid_until + (`RSA priv) dnames with + | Ok cert -> Ok ([cert], priv) + | Error _ -> Error "Unable to sign") +end diff --git a/gemini/tlsUtils.mli b/gemini/tlsUtils.mli new file mode 100644 index 0000000..ba89de7 --- /dev/null +++ b/gemini/tlsUtils.mli @@ -0,0 +1,14 @@ +module type TLS_UTILS = +sig + type authenticator = X509_lwt.authenticator Lwt.t + + val null_auth : authenticator + + val ca : Lwt_io.file_name -> authenticator + + val self_sign : ?bits:int -> ?days:int + -> X509.Distinguished_name.t + -> (Tls.Config.certchain, string) result +end + +module TlsUtils : TLS_UTILS |