blob: 0ea00abbc89775ea1bee57070f70c6a42b16ae1f (
plain) (
tree)
|
|
module type TLS_UTILS =
sig
type authenticator = X509_lwt.authenticator Lwt.t
type ciphers = Tls.Ciphersuite.ciphersuite list
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
(*val connect : authenticator:authenticator -> ?peer_name:string ->
?ciphers:ciphers -> string * int
-> (Lwt_io.input_channel * Lwt_io.output_channel) Lwt.t *)
end
module TlsUtils : TLS_UTILS =
struct
type authenticator = X509.Authenticator.t Lwt.t
type ciphers = Tls.Ciphersuite.ciphersuite list
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")
(*let connect authenticator ?peer_name ?(ciphers=Tls.Config.Ciphers.default)
(host, port) =
let peer_name = match peer_name with
| Some name -> name
| None -> host in
Tls_lwt.connect_ext
Tls.Config.(client ~peer_name:peer_name ~authenticator
~ciphers ()) (host, port)
*)
end
|