unikernel/duniverse/paf-le-chien/test/test.ml

@@ -0,0 +1,109 @@
+let null = Unix.openfile "/dev/null" Unix.[ O_CLOEXEC ] 0o644
+let () = at_exit (fun () -> try Unix.close null with _exn -> ())
+
+let create_lock filename =
+  let fd = Unix.openfile filename Unix.[ O_CREAT; O_RDWR ] 0o644 in
+  ignore (Unix.lseek fd 0 Unix.SEEK_SET) ;
+  fd
+
+let lock fd = Unix.lockf fd Unix.F_LOCK 0
+let unlock fd = Unix.lockf fd Unix.F_ULOCK 0
+
+(* XXX(dinosaure): this test wants to check with **true** parallelism
+ * that our server and our client works together (at least). The true
+ * parallelism is done by the clone()/fork() syscall - by this way,
+ * we are not constrained by the global GC lock.
+ *
+ * locks ([lock.8080]/[lock.4343]) permit to launch safely clients
+ * when, at least, servers are initialised. Then, we launch clients
+ * [N] times on some specific endpoints:
+ * - [/]
+ * - [/large]
+ * with TLS and without TLS. We see then (with a monotonic clock)
+ * the time spent by such request and generate an histogram. If
+ * one request fails, the test fails. Otherwise, we have a performance
+ * report about our implementation.
+ *
+ * The test does not want to provide metrics about performance. It
+ * gives this information but it's not real /benchmark/! *)
+
+let launch_server () =
+  let lock0 = create_lock "lock.4343" in
+  let lock1 = create_lock "lock.8080" in
+  let pid0 =
+    Unix.create_process_env "./simple_server.exe"
+      [|
+        "./simple_server.exe";
+        "--with-tls";
+        "server.pem";
+        "server.key";
+        "file.txt";
+      |]
+      [||] null Unix.stdout null in
+  let pid1 =
+    Unix.create_process_env "./simple_server.exe"
+      [| "./simple_server.exe"; "file.txt" |]
+      [||] null Unix.stdout null in
+  at_exit (fun () ->
+      try
+        Unix.close lock0 ;
+        Unix.unlink "lock.4343"
+      with _exn -> ()) ;
+  at_exit (fun () ->
+      try
+        Unix.close lock1 ;
+        Unix.unlink "lock.8080"
+      with _exn -> ()) ;
+  lock lock0 ;
+  lock lock1 ;
+  (lock0, lock1, pid0, pid1)
+
+let launch_clients c n uri =
+  Format.printf "===== -c %d -n %d %a =====\n%!" c n Uri.pp uri ;
+  let pid =
+    Unix.create_process_env "./clients.exe"
+      [|
+        "./clients.exe";
+        "-c";
+        string_of_int c;
+        "-n";
+        string_of_int n;
+        Uri.to_string uri;
+      |]
+      [||] Unix.stdin Unix.stdout Unix.stderr in
+  let _, _ = Unix.waitpid [] pid in
+  Format.printf "\n%!"
+
+let concurrency = ref 50
+let number = ref 200
+let anonymous_argument _ = ()
+
+let spec =
+  [
+    ( "-c",
+      Arg.Set_int concurrency,
+      "Number of workers to run concurrently. Total number of requests cannot \
+       be smaller than the concurrency level. Default is 50." );
+    ("-n", Arg.Set_int number, "Number of requests to run. Default is 200.");
+  ]
+
+let usage = Format.asprintf "%s [-c <number>] [-n <number>]" Sys.argv.(0)
+
+let () =
+  Arg.parse spec anonymous_argument usage ;
+  let lock0, lock1, pid0, pid1 = launch_server () in
+  lock lock0 ;
+  lock lock1 ;
+  Unix.sleep 2 ;
+  (* XXX(dinosaure): needed because [Paf.init/Stack.listen] does not ensure that
+   * we listen **after**. Lwt can schedule it in an other way... see mirage/mirage-tcpip#438 *)
+  launch_clients !concurrency !number (Uri.of_string "https://localhost:4343/") ;
+  launch_clients !concurrency !number
+    (Uri.of_string "https://localhost:4343/large") ;
+  launch_clients !concurrency !number (Uri.of_string "http://localhost:8080/") ;
+  launch_clients !concurrency !number
+    (Uri.of_string "http://localhost:8080/large") ;
+  Unix.kill pid0 Sys.sigint ;
+  Unix.kill pid1 Sys.sigint ;
+  unlock lock0 ;
+  unlock lock1