TLS applications: initialize RNG

This commit is contained in:
Hannes Mehnert 2020-06-15 16:32:26 +02:00
parent ceafacbd2a
commit a4c4331b71
6 changed files with 9 additions and 9 deletions

View file

@ -24,7 +24,7 @@ depends: [
"x509" {>= "0.11.0"} "x509" {>= "0.11.0"}
"tls" {>= "0.12.0"} "tls" {>= "0.12.0"}
"mirage-crypto-pk" "mirage-crypto-pk"
"mirage-crypto-rng" "mirage-crypto-rng" {>= "0.7.0"}
"asn1-combinators" {>= "0.2.0"} "asn1-combinators" {>= "0.2.0"}
"duration" "duration"
"decompress" {>= "0.9.0" & < "1.0.0"} "decompress" {>= "0.9.0" & < "1.0.0"}

View file

@ -15,6 +15,7 @@ let rec read_tls_write_cons t =
| Error e -> Lwt.return e | Error e -> Lwt.return e
let client cas host port cert priv_key = let client cas host port cert priv_key =
Mirage_crypto_rng_lwt.initialize () >>= fun () ->
let auth = if Sys.is_directory cas then `Ca_dir cas else `Ca_file cas in let auth = if Sys.is_directory cas then `Ca_dir cas else `Ca_file cas in
X509_lwt.authenticator auth >>= fun authenticator -> X509_lwt.authenticator auth >>= fun authenticator ->
Lwt.catch (fun () -> Lwt.catch (fun () ->
@ -46,7 +47,6 @@ let run_client _ cas cert key (host, port) =
| Tls_lwt.Tls_failure f -> Some ("TLS failure: " ^ Tls.Engine.string_of_failure f) | Tls_lwt.Tls_failure f -> Some ("TLS failure: " ^ Tls.Engine.string_of_failure f)
| _ -> None) ; | _ -> None) ;
Sys.(set_signal sigpipe Signal_ignore) ; Sys.(set_signal sigpipe Signal_ignore) ;
Mirage_crypto_rng_unix.initialize ();
Lwt_main.run (client cas host port cert key) Lwt_main.run (client cas host port cert key)
open Cmdliner open Cmdliner

View file

@ -17,4 +17,4 @@
(public_name albatross-client-remote-tls) (public_name albatross-client-remote-tls)
(package albatross) (package albatross)
(modules albatross_client_remote_tls) (modules albatross_client_remote_tls)
(libraries albatross.cli albatross albatross.tls albatross_tls_cli)) (libraries albatross.cli albatross albatross.tls albatross_tls_cli mirage-crypto-rng.lwt))

View file

@ -15,10 +15,10 @@ let server_socket port =
let jump _ cacert cert priv_key port tmpdir = let jump _ cacert cert priv_key port tmpdir =
Sys.(set_signal sigpipe Signal_ignore); Sys.(set_signal sigpipe Signal_ignore);
Mirage_crypto_rng_unix.initialize ();
Albatross_cli.set_tmpdir tmpdir; Albatross_cli.set_tmpdir tmpdir;
Lwt_main.run Lwt_main.run
(server_socket port >>= fun socket -> (Mirage_crypto_rng_lwt.initialize () >>= fun () ->
server_socket port >>= fun socket ->
tls_config cacert cert priv_key >>= fun config -> tls_config cacert cert priv_key >>= fun config ->
let rec loop () = let rec loop () =
Lwt.catch (fun () -> Lwt.catch (fun () ->

View file

@ -5,10 +5,10 @@ open Albatross_tls_common
let jump cacert cert priv_key tmpdir = let jump cacert cert priv_key tmpdir =
Sys.(set_signal sigpipe Signal_ignore) ; Sys.(set_signal sigpipe Signal_ignore) ;
Mirage_crypto_rng_unix.initialize ();
Albatross_cli.set_tmpdir tmpdir; Albatross_cli.set_tmpdir tmpdir;
Lwt_main.run Lwt_main.run
(tls_config cacert cert priv_key >>= fun config -> (Mirage_crypto_rng_lwt.initialize () >>= fun () ->
tls_config cacert cert priv_key >>= fun config ->
let fd = Lwt_unix.of_unix_file_descr Unix.stdin in let fd = Lwt_unix.of_unix_file_descr Unix.stdin in
Lwt.catch Lwt.catch
(fun () -> Tls_lwt.Unix.server_of_fd config fd) (fun () -> Tls_lwt.Unix.server_of_fd config fd)

View file

@ -16,11 +16,11 @@
(public_name albatross-tls-endpoint) (public_name albatross-tls-endpoint)
(package albatross) (package albatross)
(modules albatross_tls_endpoint) (modules albatross_tls_endpoint)
(libraries albatross_cli albatross_tls_cli albatross)) (libraries albatross_cli albatross_tls_cli albatross mirage-crypto-rng.lwt))
(executable (executable
(name albatross_tls_inetd) (name albatross_tls_inetd)
(public_name albatross-tls-inetd) (public_name albatross-tls-inetd)
(package albatross) (package albatross)
(modules albatross_tls_inetd) (modules albatross_tls_inetd)
(libraries albatross_cli albatross_tls_cli albatross)) (libraries albatross_cli albatross_tls_cli albatross mirage-crypto-rng.lwt))