unikernel/duniverse/ocaml-h2/examples/async/async_ssl_https_echo_server_post.ml

@@ -0,0 +1,76 @@
+open Core
+open Async
+open H2
+open H2_async
+
+let error_handler _ ?request:_ error start_response =
+  let response_body = start_response Headers.empty in
+  (match error with
+  | `Exn exn ->
+    Body.Writer.write_string response_body (Exn.to_string exn);
+    Body.Writer.write_string response_body "\n"
+  | #Status.standard as error ->
+    Body.Writer.write_string response_body (Status.default_reason_phrase error));
+  Body.Writer.close response_body
+
+let request_handler sock reqd =
+  eprintf "Received request from %s\n%!" (Socket.Address.Inet.to_string sock);
+  match Reqd.request reqd with
+  | { Request.meth = `POST; headers; _ } ->
+    let response =
+      let content_type =
+        match Headers.get headers "content-type" with
+        | None -> "application/octet-stream"
+        | Some x -> x
+      in
+      Response.create
+        ~headers:(Headers.of_list [ "content-type", content_type ])
+        `OK
+    in
+    let request_body = Reqd.request_body reqd in
+    let response_body = Reqd.respond_with_streaming reqd response in
+    let rec on_read buffer ~off ~len =
+      Body.Writer.write_bigstring response_body buffer ~off ~len;
+      Body.Reader.schedule_read request_body ~on_eof ~on_read
+    and on_eof () =
+      print_endline "eof";
+      Body.Writer.close response_body
+    in
+    Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read
+  | _ -> Reqd.respond_with_string reqd (Response.create `Method_not_allowed) ""
+
+let main port max_accepts_per_batch () =
+  let where_to_listen =
+    Tcp.Where_to_listen.bind_to
+      Tcp.Bind_to_address.Localhost
+      (Tcp.Bind_to_port.On_port port)
+  in
+  Tcp.(
+    Server.create_sock
+      ~on_handler_error:`Ignore
+      ~backlog:10_000
+      ~max_connections:10_000
+      ~max_accepts_per_batch
+      where_to_listen)
+    (Server.SSL.create_connection_handler_with_default
+       ~certfile:"./certificates/server.pem"
+       ~keyfile:"./certificates/server.key"
+       ~request_handler
+       ~error_handler)
+  >>= fun _server -> Deferred.never ()
+
+let () =
+  Command.async_spec
+    ~summary:"Start a hello world async_ssl server"
+    Command.Spec.(
+      empty
+      +> flag
+           "-port"
+           (optional_with_default 8080 int)
+           ~doc:"int Source port to listen on"
+      +> flag
+           "-a"
+           (optional_with_default 1 int)
+           ~doc:"int Maximum accepts per batch")
+    main
+  |> Command_unix.run

unikernel/duniverse/ocaml-h2/examples/async/async_tls_https_echo_client_post.ml

@@ -0,0 +1,85 @@
+open Core
+open Async
+open H2
+open H2_async
+
+let error_handler = function
+  | `Invalid_response_body_length _resp ->
+    printf "invalid response body length\n%!"
+  | `Exn _exn -> printf "exception!\n%!"
+  | `Malformed_response s -> printf "malformed response: %s\n%!" s
+  | `Protocol_error (code, s) ->
+    printf "protocol error: %s, %s\n%!" (H2.Error_code.to_string code) s
+
+let response_handler response_received_ivar response response_body =
+  match Response.(response.status) with
+  | `OK ->
+    let rec read_response () =
+      Body.Reader.schedule_read
+        response_body
+        ~on_eof:(fun () ->
+          (Ivar.fill [@ocaml.alert "-deprecated"]) response_received_ivar ())
+        ~on_read:(fun response_fragment ~off ~len ->
+          printf
+            "Server response: %s\n%!"
+            (Bigstringaf.substring ~off ~len response_fragment);
+          read_response ())
+    in
+    read_response ()
+  | _ ->
+    Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
+    Shutdown.shutdown 1
+
+let main port host () =
+  printf "Type in your text to send, then hit EOF:\n%!";
+  Reader.contents (Lazy.force Reader.stdin) >>= fun text_to_send ->
+  let socket = Unix.Socket.create Unix.Socket.Type.tcp in
+  let where_to_connect =
+    let hnp = Host_and_port.create ~host ~port in
+    Tcp.Where_to_connect.of_host_and_port hnp
+  in
+  Client.TLS.create_connection_with_default
+    ~error_handler
+    socket
+    where_to_connect
+  >>= fun tls_conn ->
+  let request_headers =
+    Request.create
+      `POST
+      "/"
+      ~scheme:"http"
+      ~headers:
+        Headers.(
+          of_list
+            [ ":authority", host
+            ; "content-length", string_of_int (String.length text_to_send)
+            ])
+  in
+  let response_received_ivar = Ivar.create () in
+  let response_handler = response_handler response_received_ivar in
+  let request_body =
+    H2_async.Client.TLS.request
+      tls_conn
+      request_headers
+      ~error_handler
+      ~response_handler
+  in
+  Body.Writer.write_string request_body text_to_send;
+  Body.Writer.close request_body;
+  Ivar.read response_received_ivar
+
+let () =
+  Command.async_spec
+    ~summary:"Start a hello world tls-async client"
+    Command.Spec.(
+      empty
+      +> flag
+           "-port"
+           (optional_with_default 8080 int)
+           ~doc:"int Source port to listen on"
+      +> flag
+           "-host"
+           (optional_with_default "localhost" string)
+           ~doc:"HOST to connect to")
+    main
+  |> Command_unix.run

unikernel/duniverse/ocaml-h2/examples/async/dune

@@ -0,0 +1,8 @@
+(executables
+ (libraries h2 h2-async async core core_unix.command_unix)
+ (names async_ssl_https_echo_server_post async_tls_https_echo_client_post))
+
+(alias
+ (name examples)
+ (deps
+  (glob_files *.exe)))