Skip to content

Instantly share code, notes, and snippets.

@ansiwen
Last active Dec 5, 2017
Embed
What would you like to do?
Reproducer for exception Unix.Unix_error(Unix.EBADF, "check_descriptor", "")
open Mirage
let stack = generic_stackv4 default_network
let cond = conduit_direct stack
let http_srv = http_server @@ cond
let res_dns = resolver_dns stack
let http_port =
let doc = Key.Arg.info ~doc:"Listening HTTP port." ["http"] in
Key.(create "http_port" Arg.(opt int 8080 doc))
let main =
let packages = [
package "uri";
] in
let keys = List.map Key.abstract [ http_port; ] in
foreign
~packages ~keys
"Dispatch.HTTP" (pclock @-> http @-> resolver @-> conduit @-> job)
let () =
register "http" [main $ default_posix_clock $ http_srv $ res_dns $ cond]
let http_src = Logs.Src.create "http" ~doc:"HTTP server"
module Http_log = (val Logs.src_log http_src : Logs.LOG)
module C = Cohttp_mirage.Client
module HTTP
(Pclock: Mirage_types.PCLOCK)
(S: Cohttp_lwt.S.Server)
(RES: Resolver_lwt.S)
(CON: Conduit_mirage.S)
=
struct
let serve ctx =
let callback (_, cid) request _body =
let uri = Cohttp.Request.uri request in
let cid = Cohttp.Connection.to_string cid in
Http_log.info (fun f -> f "[%s] serving %s." cid (Uri.to_string uri));
Lwt.catch
(fun () ->
C.call ~ctx `GET @@ Uri.of_string "http://pastebin.com/raw/r381BpBu"
)
(fun e ->
Http_log.info (fun f -> f "Uncaught exception: %s\n%s\n" (Printexc.to_string e) (Printexc.get_backtrace ()));
S.respond_not_found ()
)
in
let conn_closed (_,cid) =
let cid = Cohttp.Connection.to_string cid in
Http_log.info (fun f -> f "[%s] closing" cid);
in
S.make ~conn_closed ~callback ()
let start _clock http res_dns con =
let ctx = Cohttp_mirage.Client.ctx res_dns con in
let http_port = Key_gen.http_port () in
let tcp = `TCP http_port in
let http =
Http_log.info (fun f -> f "listening on %d/TCP" http_port);
http tcp @@ serve ctx
in
http
end
let () = Printexc.record_backtrace true
printf 'url="http://localhost:8080"\n%.0s' {1..1000} | curl -v -K -
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment