Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Clean tests #334

Merged
merged 2 commits into from
Oct 19, 2020
+5 −84
Merged

Clean tests #334

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
2c2c911
Clean tests
dinosaure Oct 19, 2020
8273960
Lint OPAM files
dinosaure Oct 19, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions conduit-async.opam
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,4 @@ depends: [
"ke" {with-test}
"fmt" {with-test}
"rresult" {with-test}
"conduit-async-tls" {with-test & post}
"conduit-async-ssl" {with-test & post}
]
2 changes: 0 additions & 2 deletions conduit-lwt.opam
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,4 @@ depends: [
"ke" {with-test}
"fmt" {with-test}
"rresult" {with-test}
"conduit-lwt-tls" {with-test & post}
"conduit-lwt-ssl" {with-test & post}
]
8 changes: 4 additions & 4 deletions tests/ping-pong/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
(name with_lwt)
(modules with_lwt)
(libraries common fmt.tty logs.fmt mirage-crypto-rng.unix conduit-lwt
conduit-lwt-tls conduit-lwt-ssl))
conduit-lwt-tls))

(executable
(name test_lwt)
Expand All @@ -16,7 +16,7 @@

(rule
(alias runtest)
(package conduit-lwt)
(package conduit-lwt-tls)
(deps
(:test test_lwt.exe)
with_lwt.exe
Expand All @@ -32,7 +32,7 @@
(name with_async)
(modules with_async)
(libraries common fmt.tty logs.fmt mirage-crypto-rng.unix conduit-async
conduit-async-tls conduit-async-ssl))
conduit-async-tls))

(executable
(name test_async)
Expand All @@ -41,7 +41,7 @@

(rule
(alias runtest)
(package conduit-async)
(package conduit-async-tls)
(deps
(:test test_async.exe)
with_async.exe
Expand Down
17 changes: 0 additions & 17 deletions tests/ping-pong/test_async.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,23 +22,6 @@ let () =
res := !res && properly_exited status ;
Format.printf ">>> with_async.exe: %a.\n%!" pp_process_status status ;

let pid =
Unix.create_process_env "./with_async.exe"
[|
"./with_async.exe";
"--with-ssl";
"server.pem";
"server.key";
"client0";
"client1";
"client2";
|]
[||] Unix.stdin Unix.stdout Unix.stderr in
let _, status = Unix.waitpid [] pid in
res := !res && properly_exited status ;
Format.printf ">>> with_async.exe --with-ssl: %a.\n%!" pp_process_status
status ;

let pid =
Unix.create_process_env "./with_async.exe"
[|
Expand Down
16 changes: 0 additions & 16 deletions tests/ping-pong/test_lwt.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,22 +22,6 @@ let () =
res := !res && properly_exited status ;
Format.printf ">>> with_lwt.exe: %a.\n%!" pp_process_status status ;

let pid =
Unix.create_process_env "./with_lwt.exe"
[|
"./with_lwt.exe";
"--with-ssl";
"server.pem";
"server.key";
"client0";
"client1";
"client2";
|]
[||] Unix.stdin Unix.stdout Unix.stderr in
let _, status = Unix.waitpid [] pid in
res := !res && properly_exited status ;
Format.printf ">>> with_lwt.exe --with-ssl: %a.\n%!" pp_process_status status ;

let pid =
Unix.create_process_env "./with_lwt.exe"
[|
Expand Down
19 changes: 0 additions & 19 deletions tests/ping-pong/with_async.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
open Rresult
open Async
open Async_ssl

let () = Mirage_crypto_rng_unix.initialize ()

Expand All @@ -25,10 +24,6 @@ let tcp_protocol, tcp_service =
let open Conduit_async.TCP in
(protocol, service)

let ssl_protocol, ssl_service =
let open Conduit_async_ssl.TCP in
(protocol, service)

let tls_protocol, tls_service =
let open Conduit_async_tls.TCP in
(protocol, service)
Expand All @@ -37,20 +32,13 @@ let failwith fmt = Format.kasprintf (fun err -> raise (Failure err)) fmt

let resolve_ping_pong = Conduit_async.TCP.resolve ~port:5000

let resolve_ssl_ping_pong =
let context =
Conduit_async_ssl.context ~verify_modes:Ssl.Verify_mode.[ Verify_none ] ()
in
Conduit_async_ssl.TCP.resolve ~port:7000 ~context

let resolve_tls_ping_pong =
let null ~host:_ _ = Ok None in
let config = Tls.Config.client ~authenticator:null () in
Conduit_async_tls.TCP.resolve ~port:9000 ~config

let resolvers =
Conduit.empty
|> Conduit_async.add ~priority:10 ssl_protocol resolve_ssl_ping_pong
|> Conduit_async.add ~priority:10 tls_protocol resolve_tls_ping_pong
|> Conduit_async.add ~priority:20 tcp_protocol resolve_ping_pong

Expand Down Expand Up @@ -84,12 +72,6 @@ let run_with_tcp clients =
(Conduit_async.TCP.Listen (None, Tcp.Where_to_listen.of_port 5000))
~protocol:tcp_protocol ~service:tcp_service clients

let run_with_ssl cert key clients =
let ctx = Conduit_async_ssl.context ~crt_file:cert ~key_file:key () in
run_with
(ctx, Conduit_async.TCP.Listen (None, Tcp.Where_to_listen.of_port 7000))
~protocol:ssl_protocol ~service:ssl_service clients

let load_file filename =
let open Stdlib in
let ic = open_in filename in
Expand Down Expand Up @@ -117,7 +99,6 @@ let run_with_tls cert key clients =

let () =
match Array.to_list Stdlib.Sys.argv with
| _ :: "--with-ssl" :: cert :: key :: clients -> run_with_ssl cert key clients
| _ :: "--with-tls" :: cert :: key :: clients -> run_with_tls cert key clients
| _ :: clients -> run_with_tcp clients
| [] -> assert false
25 changes: 1 addition & 24 deletions tests/ping-pong/with_lwt.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,6 @@ open Rresult

let () = Printexc.record_backtrace true

let () = Ssl.init ()

let failwith fmt = Fmt.kstrf (fun err -> Lwt.fail (Failure err)) fmt

module Lwt = struct
Expand All @@ -25,10 +23,6 @@ let tls_protocol, tls_service =
let open Conduit_lwt_tls.TCP in
(protocol, service)

let ssl_protocol, ssl_service =
let open Conduit_lwt_ssl.TCP in
(protocol, service)

(* Resolution *)

let resolve_ping_pong = Conduit_lwt.TCP.resolve ~port:4000
Expand All @@ -38,15 +32,10 @@ let resolve_tls_ping_pong =
let config = Tls.Config.client ~authenticator:null () in
Conduit_lwt_tls.TCP.resolve ~port:8000 ~config

let resolve_ssl_ping_pong =
let context = Ssl.create_context Ssl.TLSv1_2 Ssl.Client_context in
Conduit_lwt_ssl.TCP.resolve ~port:6000 ~context ?verify:None

let resolvers =
Conduit.empty
|> Conduit_lwt.add ~priority:20 Conduit_lwt.TCP.protocol resolve_ping_pong
|> Conduit_lwt.add ~priority:10 tls_protocol resolve_tls_ping_pong
|> Conduit_lwt.add ~priority:10 ssl_protocol resolve_ssl_ping_pong

(* Run *)

Expand Down Expand Up @@ -92,17 +81,6 @@ let run_with_tcp clients =
}
~protocol:Conduit_lwt.TCP.protocol ~service:Conduit_lwt.TCP.service clients

let run_with_ssl cert key clients =
let ctx = Ssl.create_context Ssl.TLSv1_2 Ssl.Server_context in
Ssl.use_certificate ctx cert key ;
run_with
( ctx,
{
Conduit_lwt.TCP.sockaddr = Unix.ADDR_INET (Unix.inet_addr_loopback, 6000);
capacity = 40;
} )
~protocol:ssl_protocol ~service:ssl_service clients

let run_with_tls cert key clients =
let ctx = config cert key in
run_with
Expand All @@ -116,6 +94,5 @@ let run_with_tls cert key clients =
let () =
match Array.to_list Sys.argv with
| _ :: "--with-tls" :: cert :: key :: clients -> run_with_tls cert key clients
| _ :: "--with-ssl" :: cert :: key :: clients -> run_with_ssl cert key clients
| _ :: clients -> run_with_tcp clients
| _ -> Fmt.epr "%s [--with-tls|--with-ssl] filename...\n%!" Sys.argv.(0)
| _ -> Fmt.epr "%s [--with-tls] filename...\n%!" Sys.argv.(0)