Skip to content

Commit

Permalink
fix examples after rebase, tweak tls_io
Browse files Browse the repository at this point in the history
  • Loading branch information
Antonio Nuno Monteiro committed Apr 6, 2019
1 parent 8616d45 commit d4671b5
Show file tree
Hide file tree
Showing 11 changed files with 302 additions and 283 deletions.
101 changes: 0 additions & 101 deletions examples/lwt/lwt_echo_server.ml
View file

This file was deleted.

99 changes: 28 additions & 71 deletions examples/lwt/lwt_https_get.ml
View file
Original file line number Diff line number Diff line change
@@ -1,73 +1,30 @@
module Body = Httpaf.Body

let response_handler notify_response_received response response_body =
let module Response = Httpaf.Response in
match Response.(response.status) with
| `OK ->
let rec read_response () =
Body.schedule_read
response_body
~on_eof:(fun () -> Lwt.wakeup_later notify_response_received ())
~on_read:(fun response_fragment ~off ~len ->
let response_fragment_string = Bytes.create len in
Lwt_bytes.blit_to_bytes
response_fragment off
response_fragment_string 0
len;
print_string (Bytes.unsafe_to_string response_fragment_string);

read_response ())
in
read_response ()

| _ ->
Format.fprintf Format.err_formatter "%a\n%!" Response.pp_hum response;
exit 1

let error_handler _ =
assert false

open Base
open Lwt.Infix

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
module Arg = Caml.Arg

open Httpaf
open Httpaf_lwt

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

Lwt_main.run begin
Lwt_unix.getaddrinfo host (string_of_int !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 addresses).Unix.ai_addr
>>= fun () ->

let request_headers =
Httpaf.Request.create
`GET "/" ~headers:(Httpaf.Headers.of_list ["Host", host])
in

let response_received, notify_response_received = Lwt.wait () in
let response_handler = response_handler notify_response_received in

let request_body =
Httpaf_lwt.Client.TLS.request
socket
request_headers
~error_handler
~response_handler
in
Body.close_writer request_body;

response_received
end
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
;;
123 changes: 29 additions & 94 deletions examples/lwt/lwt_https_server.ml
View file
Original file line number Diff line number Diff line change
@@ -1,106 +1,41 @@
let connection_handler : Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t =
let module Body = Httpaf.Body in
let module Headers = Httpaf.Headers in
let module Reqd = Httpaf.Reqd in
let module Response = Httpaf.Response in
let module Status = Httpaf.Status in
open Base
open Lwt.Infix
module Arg = Caml.Arg

let request_handler : Unix.sockaddr -> Reqd.t -> unit =
fun _client_address request_descriptor ->
open Httpaf_lwt

let request = Reqd.request request_descriptor in
match request.meth with
| `POST ->
let request_body = Reqd.request_body request_descriptor in

let response_content_type =
match Headers.get request.headers "Content-Type" with
| Some request_content_type -> request_content_type
| None -> "application/octet-stream"
in

let response =
Response.create
~headers:(Headers.of_list [
"Content-Type", response_content_type;
"Connection", "close";
])
`OK
in

let response_body =
Reqd.respond_with_streaming request_descriptor response in

let rec respond () =
Body.schedule_read
request_body
~on_eof:(fun () -> Body.close_writer response_body)
~on_read:(fun request_data ~off ~len ->
Body.write_bigstring response_body request_data ~off ~len;
respond ())
in
respond ()

| _ ->
Reqd.respond_with_string
request_descriptor (Response.create `Method_not_allowed) ""
in

let error_handler :
Unix.sockaddr ->
?request:Httpaf.Request.t ->
_ ->
(Headers.t -> [`write] Body.t) ->
unit =
fun _client_address ?request:_ error start_response ->

let response_body = start_response Headers.empty in

begin match error with
| `Exn exn ->
Body.write_string response_body (Printexc.to_string exn);
Body.write_string response_body "\n";

| #Status.standard as error ->
Body.write_string response_body (Status.default_reason_phrase error)
end;

Body.close_writer response_body
in
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
Httpaf_lwt.Server.TLS.create_connection_handler
?server:None
~certfile
~keyfile
?config:None
~request_handler
~error_handler


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 open Lwt.Infix in

let port = ref 8080 in
Arg.parse
["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
ignore
"Echoes POST requests. Runs forever.";

let listen_address = Unix.(ADDR_INET (inet_addr_loopback, !port)) in

Lwt.async begin fun () ->
Lwt_io.establish_server_with_client_socket
listen_address connection_handler
>>= fun _server ->
Printf.printf "Listening on port %i and echoing POST requests.\n" !port;
print_string "To send a POST request, try\n\n";
print_string " curl https://localhost:8080 -k -X POST -d foo\n\n";
flush stdout;
Lwt.return_unit
end;

let forever, _ = Lwt.wait () in
Lwt_main.run forever
main !port
;;
4 changes: 4 additions & 0 deletions examples/mirage/.mirage.config
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
mirage
configure
-t
unix
22 changes: 22 additions & 0 deletions examples/mirage/Makefile
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
# Generated by mirage configure -t unix (2019-03-11 12:42:42-00:00).

-include Makefile.user

OPAM = opam
DEPEXT ?= $(OPAM) pin add -k path --no-action --yes mirage-unikernel-httpaf_unikernel-unix . &&\
$(OPAM) depext --yes --update mirage-unikernel-httpaf_unikernel-unix ;\
$(OPAM) pin remove --no-action mirage-unikernel-httpaf_unikernel-unix

.PHONY: all depend depends clean build
all:: build

depend depends::
$(DEPEXT)
$(OPAM) install -y --deps-only .

build::
mirage build

clean::
mirage clean

1 change: 1 addition & 0 deletions examples/mirage/httpaf_unikernel
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
_build/main.native
Loading

0 comments on commit d4671b5

Please sign in to comment.