unikernel/duniverse/httpun/examples/async/async_echo_post.ml

@@ -0,0 +1,36 @@
+open Core
+open Async
+
+open Httpun_async
+
+let request_handler (_ : [< Socket.Address.t]) = Httpun_examples.Server.echo_post
+let error_handler (_ : [< Socket.Address.t]) = Httpun_examples.Server.error_handler
+
+let main port max_accepts_per_batch () =
+  let where_to_listen = Tcp.Where_to_listen.of_port port in
+  Tcp.(Server.create_sock ~on_handler_error:`Raise
+      ~backlog:10_000 ~max_connections:10_000 ~max_accepts_per_batch where_to_listen)
+  (Server.create_connection_handler ~request_handler ~error_handler)
+
+  >>= fun _server ->
+    Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+    Stdio.printf "To send a POST request, try one of the following\n\n";
+    Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+    Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+    Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:%d\n\n%!" port;
+    Deferred.never ()
+;;
+
+let () =
+  Command.async
+    ~summary:"Echo POST requests"
+    Command.Param.(
+      map (both
+          (flag "-p" (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"))
+        ~f:(fun (port, accepts) ->
+              (fun () -> main port accepts ())))
+  |> Command_unix.run
+;;

unikernel/duniverse/httpun/examples/async/async_get.ml

@@ -0,0 +1,38 @@
+open! Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished) in
+    let headers = Headers.of_list [ "host", host ] in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~error_handler:Httpun_examples.Client.error_handler
+        ~response_handler
+        (Request.create ~headers `GET "/")
+    in
+    Body.Writer.close request_body;
+    Ivar.read finished
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

unikernel/duniverse/httpun/examples/async/async_get_pipelined.ml

@@ -0,0 +1,55 @@
+open! Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let error_handler _ = assert false
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished) in
+    let request_headers =
+      Request.create ~headers:(Headers.of_list [ "host", host ]) `GET "/"
+    in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~response_handler
+        ~error_handler
+        request_headers
+    in
+    let finished' = Ivar.create () in
+    let response_handler' =
+      Httpun_examples.Client.print ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished')
+    in
+    let request_body' =
+      Client.request
+        connection
+        ~response_handler:response_handler'
+        ~error_handler
+        request_headers
+    in
+    Body.Writer.close request_body';
+    Body.Writer.close request_body;
+    Async.Deferred.all_unit [Ivar.read finished; Ivar.read finished'] >>= fun () ->
+      Client.shutdown connection
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

unikernel/duniverse/httpun/examples/async/async_https_echo_post.ml

@@ -0,0 +1,68 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+
+let error_handler _ ?request:_ error start_response =
+  let response_body = start_response Headers.empty in
+  begin 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)
+  end;
+  Body.Writer.close response_body
+;;
+
+let request_handler _ { Gluten.reqd; _ } =
+  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; "connection", "close"]) `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 server"
+    Command.Spec.(empty +>
+      flag "-p" (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/httpun/examples/async/async_https_get.ml

@@ -0,0 +1,50 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let response_handler finished response response_body =
+  match response with
+  | { Response.status = `OK; _ } ->
+    let rec on_read bs ~off ~len =
+      Bigstring.to_string ~pos:off ~len bs |> print_endline;
+      Body.Reader.schedule_read response_body ~on_read ~on_eof
+    and on_eof () = (Ivar.fill [@ocaml.alert "-deprecated"]) finished () in
+    Body.Reader.schedule_read response_body ~on_read ~on_eof;
+  | response ->
+    Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+    Core.exit 1
+;;
+
+let error_handler _ = assert false
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  let finished = Ivar.create () in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    Client.SSL.create_connection_with_default socket >>= fun conn ->
+    let headers = Headers.of_list [ "host", host ] in
+    let request_body =
+      Client.SSL.request
+        ~error_handler
+        ~response_handler:(response_handler finished)
+        conn
+        (Request.create ~headers `GET "/")
+    in
+    Body.Writer.close request_body;
+    Ivar.read finished
+;;
+
+let () =
+  Command.async_spec
+    ~summary:"Start a hello world Async server"
+    Command.Spec.(empty +>
+      flag "-p" (optional_with_default 443 int)
+        ~doc:"int destination port"
+      +>
+      flag "-h" (required string)
+        ~doc:"string destination host"
+    ) main
+  |> Command_unix.run

unikernel/duniverse/httpun/examples/async/async_post.ml

@@ -0,0 +1,54 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@alert "-deprecated"]) finished) in
+    let headers =
+      Headers.of_list
+      [ "transfer-encoding", "chunked"
+      ; "connection"       , "close"
+      ; "host"             , host
+      ]
+    in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~error_handler:Httpun_examples.Client.error_handler
+        ~response_handler
+        (Request.create ~headers `POST "/")
+    in
+    let stdin = Lazy.force Reader.stdin in
+    don't_wait_for (
+      Reader.read_one_chunk_at_a_time stdin ~handle_chunk:(fun bs ~pos:off ~len ->
+        Body.Writer.write_bigstring request_body bs ~off ~len;
+        Body.Writer.flush request_body (fun _reason -> ());
+        return (`Consumed(len, `Need_unknown)))
+      >>| function
+        | `Eof_with_unconsumed_data s -> Body.Writer.write_string request_body s;
+                                         Body.Writer.close request_body
+        | `Eof                        -> Body.Writer.close request_body
+        | `Stopped ()                 -> assert false);
+    Ivar.read finished
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

unikernel/duniverse/httpun/examples/async/dune

@@ -0,0 +1,22 @@
+(executables
+ (libraries
+  httpun
+  httpun-async
+  httpun_examples
+  async
+  core
+  core_unix.command_unix)
+ (names
+  async_echo_post
+  async_get
+  async_get_pipelined
+  async_post
+  async_https_get
+  async_https_echo_post)
+ (flags
+  (:standard -w -9)))
+
+(alias
+ (name examples)
+ (deps
+  (glob_files *.exe)))

unikernel/duniverse/httpun/examples/eio/dune

@@ -0,0 +1,9 @@
+(executables
+ (libraries httpun httpun-eio httpun_examples base stdio eio_main eio-ssl)
+ (names eio_echo_post eio_get eio_ssl_get)
+ (flags :standard -warn-error -A))
+
+(alias
+ (name examples)
+ (deps
+  (glob_files *.exe)))

unikernel/duniverse/httpun/examples/eio/eio_echo_post.ml

@@ -0,0 +1,87 @@
+open Base
+module Arg = Stdlib.Arg
+
+open Httpun_eio
+open Httpun
+
+let error_handler (_ : Eio.Net.Sockaddr.stream) = Httpun_examples.Server.error_handler
+
+let request_handler ~u (_ : Eio.Net.Sockaddr.stream) { Gluten.reqd; _ } =
+    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;
+            "transfer-encoding", "chunked"
+            (* ; "connection", "close" *)
+            ]) `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 () =
+        Stdlib.Format.eprintf "EOF@.";
+        Body.Writer.close response_body;
+        Eio.Promise.resolve_ok u ()
+      in
+      Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read
+    | _ ->
+      let headers = Headers.of_list [ "connection", "close" ] in
+      Reqd.respond_with_string reqd (Response.create ~headers `Method_not_allowed) ""
+;;
+
+
+let log_connection_error ex =
+  Eio.traceln "Uncaught exception handling client: %a" Fmt.exn ex
+
+let main port =
+  Eio_main.run (fun env ->
+  let listen_address = (`Tcp (Eio.Net.Ipaddr.V4.loopback, port)) in
+  let network = Eio.Stdenv.net env in
+  let handler ~u =
+    Server.create_connection_handler ~request_handler:(request_handler ~u) ~error_handler in
+  Eio.Switch.run (fun sw ->
+    let socket =
+      Eio.Net.listen ~reuse_addr:true  ~reuse_port:true ~backlog:5 ~sw
+      network
+      listen_address
+    in
+  Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+  Stdio.printf "To send a POST request, try one of the following\n\n";
+  Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+  Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+  Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:%d\n\n%!" port;
+  let domain_mgr = Eio.Stdenv.domain_mgr env in
+  let p, _ = Eio.Promise.create () in
+  for _i = 1 to Stdlib.Domain.recommended_domain_count () do
+    Eio.Fiber.fork_daemon ~sw (fun () ->
+      Eio.Domain_manager.run domain_mgr (fun () ->
+        Eio.Switch.run (fun sw ->
+          while true do
+            Eio.Net.accept_fork socket ~sw ~on_error:log_connection_error (fun client_sock client_addr ->
+                let p, u = Eio.Promise.create () in
+                handler ~sw ~u client_addr client_sock;
+                Eio.Promise.await_exn p)
+          done;
+        `Stop_daemon)))
+  done;
+  Eio.Promise.await p));
+
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;

unikernel/duniverse/httpun/examples/eio/eio_get.ml

@@ -0,0 +1,70 @@
+module Arg = Stdlib.Arg
+
+open Httpun
+
+let handler ~on_eof response response_body =
+  match response with
+  | { Response.status = `OK; _ } as response ->
+    Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+    let rec on_read bs ~off ~len =
+      Bigstringaf.substring ~off ~len bs |> print_string;
+      flush stdout;
+      Body.Reader.schedule_read response_body ~on_read ~on_eof
+    in
+    Body.Reader.schedule_read response_body ~on_read ~on_eof;
+  | response ->
+    Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
+    Stdlib.exit 124
+;;
+
+let main port host =
+  Eio_main.run (fun _env ->
+    Eio.Switch.run (fun sw ->
+    let fd = Unix.socket ~cloexec:true Unix.PF_INET Unix.SOCK_STREAM 0 in
+    let addrs =
+      Eio_unix.run_in_systhread (fun () ->
+          Unix.getaddrinfo
+            host
+            (Int.to_string port)
+            [ Unix.(AI_FAMILY PF_INET) ])
+    in
+    Eio_unix.run_in_systhread (fun () ->
+      Unix.connect fd (List.hd addrs).ai_addr);
+    let socket = Eio_unix.Net.import_socket_stream ~sw ~close_unix:true fd in
+    let headers = Headers.of_list [ "host", host ] in
+    let connection =
+      Httpun_eio.Client.create_connection ~sw socket
+    in
+
+    let exit_cond = Eio.Condition.create () in
+    let response_handler =
+      handler ~on_eof:(fun () ->
+        Stdlib.Format.eprintf "eof@.";
+        Eio.Condition.broadcast exit_cond)
+    in
+    let request_body =
+      Httpun_eio.Client.request
+        (* ~flush_headers_immediately:true *)
+        ~error_handler:Httpun_examples.Client.error_handler
+        ~response_handler
+        connection
+        (Request.create ~headers `GET "/")
+    in
+    Body.Writer.close request_body;
+    Eio.Condition.await_no_mutex exit_cond;
+    Httpun_eio.Client.shutdown connection |> Eio.Promise.await))
+
+let () =
+  let host = ref None in
+  let port = ref 80 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  main !port host
+;;

unikernel/duniverse/httpun/examples/eio/eio_ssl_get.ml

@@ -0,0 +1,89 @@
+module Arg = Stdlib.Arg
+
+open Httpun
+
+module Client = Httpun_eio.Client
+
+let () =
+  Ssl.init ~thread_safe:true ()
+
+let handler ~on_eof response response_body =
+  match response with
+  | { Response.status = `OK; _ } as response ->
+    Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+    let rec on_read _bs ~off:_ ~len:_ =
+      (* Bigstringaf.substring ~off ~len bs |> print_string; *)
+      Body.Reader.schedule_read response_body ~on_read ~on_eof
+    in
+    Body.Reader.schedule_read response_body ~on_read ~on_eof;
+  | response ->
+    Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
+    Stdlib.exit 124
+;;
+
+let main port host =
+  Eio_main.run (fun env ->
+    Eio.Switch.run (fun sw ->
+      let addrs =
+        let addrs =
+          Eio_unix.run_in_systhread (fun () ->
+              Unix.getaddrinfo
+                host
+                (string_of_int port)
+                [ Unix.(AI_FAMILY PF_INET) ])
+        in
+        List.filter_map
+          (fun (addr : Unix.addr_info) ->
+            match addr.ai_addr with
+            | Unix.ADDR_UNIX _ -> None
+            | ADDR_INET (addr, port) -> Some (addr, port))
+          addrs
+      in
+      let addr =
+        let inet, port = List.hd addrs in
+        `Tcp (Eio_unix.Net.Ipaddr.of_unix inet, port)
+      in
+      let socket = Eio.Net.connect ~sw (Eio.Stdenv.net env) addr in
+      let ctx = Ssl.create_context (Ssl.SSLv23 [@ocaml.warning "-3"]) Ssl.Client_context in
+      Ssl.disable_protocols ctx [ (Ssl.SSLv23 [@ocaml.warning "-3"]) ];
+      Ssl.honor_cipher_order ctx;
+      Ssl.set_context_alpn_protos ctx [ "h2" ];
+      let ssl_ctx = Eio_ssl.Context.create ~ctx socket in
+      let ssl_sock = Eio_ssl.Context.ssl_socket ssl_ctx in
+      Ssl.set_client_SNI_hostname ssl_sock host;
+      Ssl.set_hostflags ssl_sock [ No_partial_wildcards ];
+      Ssl.set_host ssl_sock host;
+      let ssl_sock = Eio_ssl.connect ssl_ctx in
+
+      let headers = Headers.of_list [ "host", host ] in
+      let connection = Client.create_connection ~sw ssl_sock in
+      let response_handler =
+        handler ~on_eof:(fun () ->
+          Stdlib.Format.eprintf "eof@.";
+          Client.shutdown connection |> Eio.Promise.await)
+      in
+      let request_body =
+        Client.request
+          connection
+          ~flush_headers_immediately:true
+          ~error_handler:Httpun_examples.Client.error_handler
+          ~response_handler
+          (Request.create ~headers `GET "/")
+      in
+      Body.Writer.close request_body));
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 443 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  main !port host
+;;

unikernel/duniverse/httpun/examples/lib/dune

@@ -0,0 +1,3 @@
+(library
+ (name httpun_examples)
+ (libraries httpun base stdio gluten))

unikernel/duniverse/httpun/examples/lib/httpun_examples.ml

@@ -0,0 +1,89 @@
+open Base
+open Httpun
+module Format = Stdlib.Format
+
+let print_string = Stdio.(Out_channel.output_string stdout)
+
+let text = "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, <and what is the use of a book,> thought Alice <without pictures or conversations?> So she was considering in her own mind (as well as she could, for the hot day made her feel very sleepy and stupid), whether the pleasure of making a daisy-chain would be worth the trouble of getting up and picking the daisies, when suddenly a White Rabbit with pink eyes ran close by her. There was nothing so very remarkable in that; nor did Alice think it so very much out of the way to hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when she thought it over afterwards, it occurred to her that she ought to have wondered at this, but at the time it all seemed quite natural); but when the Rabbit actually took a watch out of its waistcoat-pocket, and looked at it, and then hurried on, Alice started to her feet, for it flashed across her mind that she had never before seen a rabbit with either a waistcoat-pocket, or a watch to take out of it, and burning with curiosity, she ran across the field after it, and fortunately was just in time to see it pop down a large rabbit-hole under the hedge. In another moment down went Alice after it, never once considering how in the world she was to get out again. The rabbit-hole went straight on like a tunnel for some way, and then dipped suddenly down, so suddenly that Alice had not a moment to think about stopping herself before she found herself falling down a very deep well. Either the well was very deep, or she fell very slowly, for she had plenty of time as she went down to look about her and to wonder what was going to happen next. First, she tried to look down and make out what she was coming to, but it was too dark to see anything; then she looked at the sides of the well, and noticed that they were filled with cupboards......"
+
+let text = Bigstringaf.of_string ~off:0 ~len:(String.length text) text
+
+module Client = struct
+ exception Response_error
+
+  let error_handler error =
+    let error =
+      match error with
+      | `Malformed_response err -> Format.sprintf "Malformed response: %s" err
+      | `Invalid_response_body_length _ -> "Invalid body length"
+      | `Exn exn -> Format.sprintf "Exn raised: %s" (Exn.to_string exn)
+    in
+    Format.eprintf "Error handling response: %s\n%!" error;
+  ;;
+
+  let print ~on_eof response response_body =
+    match response with
+    | { Response.status = `OK; _ } as response ->
+      Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+      let rec on_read bs ~off ~len =
+        Bigstringaf.substring ~off ~len bs |> print_string;
+        Body.Reader.schedule_read response_body ~on_read ~on_eof
+      in
+      Body.Reader.schedule_read response_body ~on_read ~on_eof;
+    | response ->
+      Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
+      Stdlib.exit 1
+  ;;
+end
+
+module Server = struct
+  let echo_post { Gluten.reqd; _ } =
+    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; "connection", "close"]) `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 () =
+        Body.Writer.close response_body
+      in
+      Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read
+    | _ ->
+      let headers = Headers.of_list [ "connection", "close" ] in
+      Reqd.respond_with_string reqd (Response.create ~headers `Method_not_allowed) ""
+  ;;
+
+  let benchmark =
+    let headers = Headers.of_list ["content-length", Int.to_string (Bigstringaf.length text)] in
+    let handler { Gluten.reqd; _ } =
+      let { Request.target; _ } = Reqd.request reqd in
+      let request_body          = Reqd.request_body reqd in
+      Body.Reader.close request_body;
+      match target with
+      | "/" -> Reqd.respond_with_bigstring reqd (Response.create ~headers `OK) text;
+      | _   -> Reqd.respond_with_string    reqd (Response.create `Not_found) "Route not found"
+    in
+    handler
+  ;;
+
+  let error_handler ?request:_ error start_response =
+    let response_body = start_response Headers.empty in
+    begin 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)
+    end;
+    Body.Writer.close response_body
+  ;;
+end

unikernel/duniverse/httpun/examples/lwt/dune

@@ -0,0 +1,9 @@
+(executables
+ (libraries httpun httpun-lwt-unix httpun_examples base stdio lwt lwt.unix)
+ (names lwt_get lwt_get_pipelined lwt_post lwt_echo_post lwt_https_get
+   lwt_https_server))
+
+(alias
+ (name examples)
+ (deps
+  (glob_files *.exe)))

unikernel/duniverse/httpun/examples/lwt/lwt_echo_post.ml

@@ -0,0 +1,34 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun_lwt_unix
+
+let error_handler (_ : Unix.sockaddr) = Httpun_examples.Server.error_handler
+let request_handler (_ : Unix.sockaddr)  =
+  Httpun_examples.Server.echo_post
+
+let main port =
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  Lwt.async (fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address
+      (Server.create_connection_handler ~request_handler ~error_handler)
+    >|= fun _server ->
+      Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+      Stdio.printf "To send a POST request, try one of the following\n\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:%d\n\n%!" port);
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;

unikernel/duniverse/httpun/examples/lwt/lwt_get.ml

@@ -0,0 +1,45 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun
+open Httpun_lwt_unix
+
+let main port host =
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    Httpun_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers = Headers.of_list [ "host", host ] in
+  Client.create_connection socket >>= fun connection ->
+  let request_body =
+    Client.request
+      connection
+      ~error_handler:Httpun_examples.Client.error_handler
+      ~response_handler
+      (Request.create ~headers `GET "/")
+  in
+  Body.Writer.close request_body;
+  finished >>= fun () ->
+    Client.shutdown connection
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 80 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/httpun/examples/lwt/lwt_get_pipelined.ml

@@ -0,0 +1,61 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun
+open Httpun_lwt_unix
+
+let error_handler _ = assert false
+
+let main port host =
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    Httpun_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let request_headers =
+    Request.create ~headers:(Headers.of_list [ "host", host ]) `GET "/"
+  in
+  Client.create_connection socket >>= fun connection ->
+  let request_body =
+    Client.request
+      connection
+      ~response_handler
+      ~error_handler
+      request_headers
+  in
+  let finished', notify_finished' = Lwt.wait () in
+  let response_handler' =
+    Httpun_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished')
+  in
+  let request_body' =
+    Client.request
+      connection
+      ~response_handler:response_handler'
+      ~error_handler
+      request_headers
+  in
+  Body.Writer.close request_body';
+  Body.Writer.close request_body;
+  Lwt.join [finished; finished'] >>= fun () ->
+    Client.shutdown connection
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 80 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/httpun/examples/lwt/lwt_https_get.ml

@@ -0,0 +1,45 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun
+open Httpun_lwt_unix
+
+let error_handler _ = assert false
+
+let main port host =
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    Httpun_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers = Headers.of_list [ "host", host ] in
+  Client.TLS.create_connection_with_default socket >>= fun connection ->
+  let request_body = Client.TLS.request
+    connection
+    ~error_handler
+    ~response_handler
+    (Request.create ~headers `GET "/")
+  in
+  Body.Writer.close request_body;
+  finished
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 443 in
+  Arg.parse
+    ["-p", Set_int port, " Port number (443 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_https_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/httpun/examples/lwt/lwt_https_server.ml

@@ -0,0 +1,39 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun_lwt_unix
+
+let request_handler (_ : Unix.sockaddr)  = Httpun_examples.Server.echo_post
+let error_handler (_ : Unix.sockaddr) = Httpun_examples.Server.error_handler
+
+let main port =
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+  let certfile = "./certificates/server.pem" in
+  let keyfile = "./certificates/server.key" in
+  Lwt.async (fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address
+      (Server.TLS.create_connection_handler_with_default
+        ~certfile
+        ~keyfile
+        ~request_handler
+        ~error_handler)
+    >|= fun _server ->
+      Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+      Stdio.printf "To send a POST request, try one of the following\n\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+      Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:8080\n\n%!");
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
+;;
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes POST requests. Runs forever.";
+  main !port
+;;

unikernel/duniverse/httpun/examples/lwt/lwt_post.ml

@@ -0,0 +1,54 @@
+open Base
+open Lwt.Infix
+module Arg = Stdlib.Arg
+
+open Httpun
+open Httpun_lwt_unix
+
+let main port host =
+  Lwt_io.(read stdin)
+  >>= fun body ->
+  Lwt_unix.getaddrinfo host (Int.to_string port) [Unix.(AI_FAMILY PF_INET)]
+  >>= fun addresses ->
+  let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Lwt_unix.connect socket (List.hd_exn addresses).Unix.ai_addr
+  >>= fun () ->
+  let finished, notify_finished = Lwt.wait () in
+  let response_handler =
+    Httpun_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers =
+    Headers.of_list
+    [ "content-length"   , (Int.to_string (String.length body))
+    ; "connection"       , "close"
+    ; "host"             , host
+    ]
+  in
+  Client.create_connection socket >>= fun connection ->
+  let request_body =
+    Client.request
+      connection
+      ~error_handler:Httpun_examples.Client.error_handler
+      ~response_handler
+      (Request.create ~headers `POST "/")
+  in
+  Body.Writer.write_string request_body body;
+  Body.Writer.close request_body;
+  finished
+;;
+
+let () =
+  let host = ref None in
+  let port = ref 8080 in
+
+  Arg.parse
+    ["-p", Set_int port, " Port number (8080 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "lwt_get.exe [-p N] HOST";
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+  Lwt_main.run (main !port host)
+;;

unikernel/duniverse/httpun/examples/mirage/config.ml

@@ -0,0 +1,24 @@
+open Mirage
+
+(* Network configuration *)
+
+let stack = generic_stackv4 default_network
+
+(* Dependencies *)
+
+let server =
+ let packages =
+   [ package ~pin:"file://../../" "httpun-lwt"
+   ; package ~pin:"file://../../" "httpun-mirage"
+   ]
+  in
+  foreign "Unikernel.Make"
+    ~packages
+    (console @-> pclock @-> http @-> job)
+
+let app =
+  httpun_server @@ conduit_direct stack
+
+let () =
+  register "httpun_unikernel"
+    [ server $ default_console $ default_posix_clock $ app ]

unikernel/duniverse/httpun/examples/mirage/unikernel.ml

@@ -0,0 +1,52 @@
+open Lwt.Infix
+open Httpun
+
+module type HTTP = httpun_mirage.Server
+
+module Dispatch (C: Mirage_console.S) (Http: HTTP) = struct
+
+  let log c fmt = Printf.ksprintf (C.log c) fmt
+
+  let get_content c path =
+    log c "Replying: %s" path >|= fun () ->
+    "Hello from the httpun unikernel"
+
+  let dispatcher c { Gluten.reqd; _ } =
+    let {Request.target; _} = Reqd.request reqd in
+    Lwt.catch
+      (fun () ->
+         get_content c target >|= fun body ->
+         let response = Response.create
+          ~headers:(Headers.of_list ["Content-Length", body
+            |> String.length
+            |> string_of_int])
+          `OK
+         in
+         Reqd.respond_with_string reqd response body)
+      (fun exn ->
+         let response = Response.create `Internal_server_error in
+         Lwt.return (Reqd.respond_with_string reqd response (Printexc.to_string exn)))
+    |> ignore
+
+  let serve c dispatch =
+    let error_handler ?request:_ _error mk_response =
+      let response_body = mk_response Headers.empty in
+      Body.write_string response_body "Error handled";
+      Body.flush response_body (fun () -> Body.close_writer response_body)
+    in
+    Http.create_connection_handler
+      ?config:None
+      ~request_handler:(dispatch c)
+      ~error_handler
+end
+
+(** Server boilerplate *)
+module Make (C : Mirage_console.S) (Clock : Mirage_clock.PCLOCK) (Http: HTTP) = struct
+
+  module D  = Dispatch (C) (Http)
+
+  let log c fmt = Printf.ksprintf (C.log c) fmt
+  let start c _clock http =
+    log c "started unikernel listen on port 8001" >>= fun () ->
+    http (`TCP 8001) @@ D.serve c D.dispatcher
+end