HTTPS support for the Lwt bindings

.travis.yml

@@ -13,5 +13,7 @@ env:
   - POST_INSTALL_HOOK="opam install --with-test httpaf-async httpaf-lwt-unix && opam exec -- make examples"
   matrix:
   - OCAML_VERSION="4.07"
-  - OCAML_VERSION="4.06"
+  - |
+    PRE_INSTALL_HOOK="sudo apt-get install -y libgmp-dev; opam install tls"
+    OCAML_VERSION="4.06"
   - OCAML_VERSION="4.05"

certificates/server.key

@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXQIBAAKBgQC2QEje5rwhlD2iq162+Ng3AH9BfA/jNJLDqi9VPk1eMUNGicJv
+K+aOANKIsOOr9v4RiEXZSYmFEvGSy+Sf1bCDHwHLLSdNs6Y49b77POgatrVZOTRE
+BE/t1soVT3a/vVJWCLtVCjm70u0S5tcfn4S6IapeIYAVAmcaqwSa+GQNoQIDAQAB
+AoGAd/CShG8g/JBMh9Nz/8KAuKHRHc2BvysIM1C62cSosgaFmdRrazJfBrEv3Nlc
+2/0uc2dVYIxuvm8bIFqi2TWOdX9jWJf6oXwEPXCD0SaDbJTaoh0b+wjyHuaGlttY
+Ztvmf8mK1BOhyl3vNMxh/8Re0dGvGgPZHpn8zanaqfGVz+ECQQDngieUpwzxA0QZ
+GZKRYhHoLEaPiQzBaXphqWcCLLN7oAKxZlUCUckxRRe0tKINf0cB3Kr9gGQjPpm0
+YoqXo8mNAkEAyYgdd+JDi9FH3Cz6ijvPU0hYkriwTii0V09+Ar5DvYQNzNEIEJu8
+Q3Yte/TPRuK8zhnp97Bsy9v/Ji/LSWbtZQJBAJe9y8u3otfmWCBLjrIUIcCYJLe4
+ENBFHp4ctxPJ0Ora+mjkthuLF+BfdSZQr1dBcX1a8giuuvQO+Bgv7r9t75ECQC7F
+omEyaA7JEW5uGe9/Fgz0G2ph5rkdBU3GKy6jzcDsJu/EC6UfH8Bgawn7tSd0c/E5
+Xm2Xyog9lKfeK8XrV2kCQQCTico5lQPjfIwjhvn45ALc/0OrkaK0hQNpXgUNFJFQ
+tuX2WMD5flMyA5PCx5XBU8gEMHYa8Kr5d6uoixnbS0cZ
+-----END RSA PRIVATE KEY-----

certificates/server.pem

@@ -0,0 +1,15 @@
+-----BEGIN CERTIFICATE-----
+MIICYzCCAcwCCQDLbE6ES1ih1DANBgkqhkiG9w0BAQUFADB2MQswCQYDVQQGEwJB
+VTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0
+cyBQdHkgTHRkMRUwEwYDVQQDDAxZT1VSIE5BTUUhISExGDAWBgkqhkiG9w0BCQEW
+CW1lQGJhci5kZTAeFw0xNDAyMTcyMjA4NDVaFw0xNTAyMTcyMjA4NDVaMHYxCzAJ
+BgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5l
+dCBXaWRnaXRzIFB0eSBMdGQxFTATBgNVBAMMDFlPVVIgTkFNRSEhITEYMBYGCSqG
+SIb3DQEJARYJbWVAYmFyLmRlMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC2
+QEje5rwhlD2iq162+Ng3AH9BfA/jNJLDqi9VPk1eMUNGicJvK+aOANKIsOOr9v4R
+iEXZSYmFEvGSy+Sf1bCDHwHLLSdNs6Y49b77POgatrVZOTREBE/t1soVT3a/vVJW
+CLtVCjm70u0S5tcfn4S6IapeIYAVAmcaqwSa+GQNoQIDAQABMA0GCSqGSIb3DQEB
+BQUAA4GBAIo4ZppIlp3JRyltRC1/AyCC0tsh5TdM3W7258wdoP3lEe08UlLwpnPc
+aJ/cX8rMG4Xf4it77yrbVrU3MumBEGN5TW4jn4+iZyFbp6TT3OUF55nsXDjNHBbu
+deDVpGuPTI6CZQVhU5qEMF3xmlokG+VV+HCDTglNQc+fdLM0LoNF
+-----END CERTIFICATE-----

examples/lwt/dune

@@ -1,7 +1,8 @@
 (executables
  (libraries httpaf httpaf-lwt-unix httpaf_examples base stdio lwt lwt.unix)
- (names lwt_get lwt_post lwt_echo_post))
+ (names lwt_get lwt_post lwt_echo_post lwt_https_get lwt_https_server))
 
 (alias
  (name examples)
- (deps (glob_files *.exe)))
+ (deps
+  (glob_files *.exe)))

examples/lwt/lwt_https_get.ml

@@ -0,0 +1,30 @@
+open Base
+open Lwt.Infix
+module Arg = Caml.Arg
+
+open Httpaf
+open Httpaf_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 =
+    Httpaf_examples.Client.print ~on_eof:(Lwt.wakeup_later notify_finished)
+  in
+  let headers = Headers.of_list [ "host", host ] in
+  let request_body =
+      Client.TLS.request
+      ~error_handler
+      ~response_handler
+      socket
+      (Request.create ~headers `GET "/")
+  in
+  Body.close_writer request_body;
+  finished
+;;

examples/lwt/lwt_https_server.ml

@@ -0,0 +1,41 @@
+open Base
+open Lwt.Infix
+module Arg = Caml.Arg
+
+open Httpaf_lwt_unix
+
+let request_handler (_ : Unix.sockaddr) = Httpaf_examples.Server.echo_post
+let error_handler (_ : Unix.sockaddr) = Httpaf_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
+        ?server:None
+        ~certfile
+        ~keyfile
+        ?config:None
+        ~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
+;;

httpaf-lwt-unix.opam

@@ -1,5 +1,5 @@
 opam-version: "2.0"
-name: "httpaf-lwt"
+name: "httpaf-lwt-unix"
 maintainer: "Spiros Eliopoulos <[email protected]>"
 authors: [
   "Anton Bachin <[email protected]>"
@@ -18,6 +18,8 @@ depends: [
   "faraday-lwt-unix"
   "httpaf"
   "dune" {build}
+  "ocamlfind" {build}
   "lwt"
 ]
+depopts: ["tls" "lwt_ssl"]
 synopsis: "Lwt support for http/af"

lwt-unix/buffer.ml

@@ -0,0 +1,37 @@
+open Lwt.Infix
+
+(* Based on the Buffer module in httpaf_async.ml. *)
+type t =
+  { buffer      : Lwt_bytes.t
+  ; mutable off : int
+  ; mutable len : int }
+
+let create size =
+  let buffer = Lwt_bytes.create size in
+  { buffer; off = 0; len = 0 }
+
+let compress t =
+  if t.len = 0
+  then begin
+    t.off <- 0;
+    t.len <- 0;
+  end else if t.off > 0
+  then begin
+    Lwt_bytes.blit t.buffer t.off t.buffer 0 t.len;
+    t.off <- 0;
+  end
+
+let get t ~f =
+  let n = f t.buffer ~off:t.off ~len:t.len in
+  t.off <- t.off + n;
+  t.len <- t.len - n;
+  if t.len = 0
+  then t.off <- 0;
+  n
+
+let put t ~f =
+  compress t;
+  f t.buffer ~off:(t.off + t.len) ~len:(Lwt_bytes.length t.buffer - t.len)
+  >>= fun n ->
+  t.len <- t.len + n;
+  Lwt.return n

lwt-unix/buffer.mli

@@ -0,0 +1,6 @@
+type t
+
+val create : int -> t
+
+val get : t -> f:(Lwt_bytes.t -> off:int -> len:int -> int) -> int
+val put : t -> f:(Lwt_bytes.t -> off:int -> len:int -> int Lwt.t) -> int Lwt.t

lwt-unix/dune

@@ -1,5 +1,36 @@
+(* -*- tuareg -*- *)
+(* This was inspired by `conduit-lwt-unix`'s dune file *)
+
+let v ~ssl ~tls () =
+  let ssl, ssl_d =
+    if ssl then "ssl_io_real", "lwt_ssl "
+    else "ssl_io_dummy", ""
+  in
+  let tls, tls_d =
+    if tls then "tls_io_real", "tls.lwt "
+    else "tls_io_dummy", ""
+  in
+  Printf.sprintf {|
+(rule (copy %s.ml ssl_io.ml))
+(rule (copy %s.ml tls_io.ml))
+
 (library
  (name httpaf_lwt_unix)
  (public_name httpaf-lwt-unix)
- (libraries faraday-lwt-unix httpaf lwt.unix)
+ (libraries faraday-lwt-unix httpaf lwt.unix %s%s)
+ (modules buffer httpaf_lwt_unix tls_io ssl_io)
  (flags (:standard -safe-string)))
+|} ssl tls ssl_d tls_d
+
+let main () =
+  let is_installed s = Printf.kprintf Sys.command "ocamlfind query %s" s = 0 in
+  let ssl = is_installed "lwt_ssl" in
+  let tls = Sys.unix && is_installed "tls.lwt" in
+  Printf.printf
+    "Configuration\n\
+    \  ssl    : %b\n\
+    \  tls    : %b\n%!"
+    ssl tls;
+  v ~ssl ~tls ()
+
+let () = Jbuild_plugin.V1.send @@ main ()