diff --git a/_oasis b/_oasis index 5b2dac60cb..3047cd62c4 100644 --- a/_oasis +++ b/_oasis @@ -201,7 +201,7 @@ Executable test_net_async_server Install: false BuildDepends: cohttp, cohttp.async, oUnit (>= 1.0.2) -Executable "cohttp-server" +Executable "cohttp-server-async" Path: bin MainIs: cohttp_server_async.ml Build$: flag(async) @@ -210,6 +210,15 @@ Executable "cohttp-server" Install: true BuildDepends: cohttp, cohttp.async +Executable "cohttp-server-lwt" + Path: bin + MainIs: cohttp_server_lwt.ml + Build$: flag(lwt) + Custom: true + CompiledObject: best + Install: true + BuildDepends: cohttp, cohttp.lwt + Executable "async-hello-world" Path: examples/async MainIs: hello_world.ml diff --git a/_tags b/_tags index 49030586e4..4eb7194516 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: b06facdaaf27136c8f4b5c20b9bfe79f) +# DO NOT EDIT (digest: 1b2b864273887ce54377364050d2ef95) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -62,10 +62,6 @@ : use_cohttp_lwt # Library cohttp_async "async/cohttp_async.cmxs": use_cohttp_async -: oasis_library_cohttp_async_byte -: oasis_library_cohttp_async_byte -: oasis_library_cohttp_async_native -: oasis_library_cohttp_async_native : pkg_async : pkg_async_ssl : pkg_fieldslib @@ -315,7 +311,7 @@ : use_cohttp : use_cohttp_async : custom -# Executable cohttp-server +# Executable cohttp-server-async : pkg_async : pkg_async_ssl : pkg_fieldslib @@ -331,18 +327,43 @@ : use_cohttp_async : pkg_async : pkg_async_ssl +: pkg_threads +: use_cohttp_async +: custom +# Executable cohttp-server-lwt +: pkg_fieldslib +: pkg_fieldslib.syntax +: pkg_lwt +: pkg_lwt.ssl +: pkg_lwt.syntax +: pkg_lwt.unix +: pkg_re.emacs +: pkg_sexplib +: pkg_sexplib.syntax +: pkg_stringext +: pkg_unix +: pkg_uri +: pkg_uri.services +: use_cohttp +: use_cohttp_lwt +: use_cohttp_lwt_unix : pkg_fieldslib : pkg_fieldslib.syntax +: pkg_lwt +: pkg_lwt.ssl +: pkg_lwt.syntax +: pkg_lwt.unix : pkg_re.emacs : pkg_sexplib : pkg_sexplib.syntax : pkg_stringext -: pkg_threads +: pkg_unix : pkg_uri : pkg_uri.services : use_cohttp -: use_cohttp_async -: custom +: use_cohttp_lwt +: use_cohttp_lwt_unix +: custom # Executable async-hello-world : pkg_async : pkg_async_ssl diff --git a/bin/cohttp_server_lwt.ml b/bin/cohttp_server_lwt.ml new file mode 100644 index 0000000000..fee8b1c395 --- /dev/null +++ b/bin/cohttp_server_lwt.ml @@ -0,0 +1,100 @@ +open Lwt +open Cohttp +open Cohttp_lwt_unix + +let serve_file ~docroot ~uri = + Server.resolve_local_file ~docroot ~uri + |> (fun x -> Server.respond_file ~fname:x ()) + +let ls_dir dir = + Lwt_unix.files_of_directory dir + |> Lwt_stream.to_list + +let rec handler ~info ~docroot ~verbose ~index sock req body = + let uri = Cohttp.Request.uri req in + let path = Uri.path uri in + (* Get a canonical filename from the URL and docroot *) + let file_name = Server.resolve_local_file ~docroot ~uri in + Lwt_unix.stat file_name + >>= fun stat -> + (* Log the request to the console *) + Printf.printf "%s %s %s" + (Cohttp.(Code.string_of_method (Request.meth req))) + path + (match verbose with + | true -> "" + | false -> "" + ); + match stat.Unix.st_kind with + | Unix.S_DIR -> begin + match Sys.file_exists (Filename.concat file_name index) with + | true -> let uri = Uri.with_path uri (Filename.concat path index) in + Server.respond_redirect uri () + | false -> + ls_dir file_name + >>= Lwt_list.map_s (fun f -> + let file_name = Filename.concat file_name f in + Lwt.try_bind + (fun () -> Lwt_unix.stat file_name) + (fun stat -> + let li l = Printf.sprintf "
  • %s/
    • " (Uri.to_string l) in + let link = Uri.with_path uri (Filename.concat path f) in + match stat.Unix.st_kind with + | Unix.S_DIR -> Lwt.return (li link (Printf.sprintf "%s/" f)) + | Unix.S_REG -> Lwt.return (li link f) + | _ -> Lwt.return (Printf.sprintf "%s" f)) + (fun exn -> + Lwt.return (Printf.sprintf "
  • Error with file: %s
    • " file_name))) + >>= fun html -> + String.concat "\n" html + |> fun contents -> + Printf.sprintf " + + +

    Directory Listing for %s

    +
      %s
    +
    %s + + " + file_name contents info + |> (fun x -> Server.respond_string ~status:`OK ~body:x ()) + end + | Unix.S_REG -> serve_file ~docroot ~uri + | _ -> + Server.respond_string ~status:`Forbidden + ~body:"

    Forbidden

    +

    This is not a normal file or directory

    /html>" + () + +let start_server docroot port host index verbose () = + Printf.printf "Listening for HTTP request on: %s %d\n" host port; + let info = Printf.sprintf "Served by Cohttp/Lwt listening on %s:%d" host port in + let conn_closed id () = Printf.printf "connection %s closed\n%!" + (Connection.to_string id) in + let callback = handler ~info ~docroot ~verbose ~index in + let config = { Server.callback; conn_closed } in + Server.create ~address:host ~port:port config + +let host = ref "0.0.0.0" +let port = ref 8080 +let index = ref "index.html" +let verbose = ref false +let rest = ref [] + +let usage = "usage " ^ Sys.argv.(0) ^ " input [-o output]" + +let arglist = [ + ("-p", Arg.Int (fun i -> port := i), ": TCP port to listen on"); + ("-s", Arg.String (fun s -> host := s), ": IP address to listen on"); + ("-i", Arg.String (fun s -> index := s), ": Name of index file in directory"); + ("-v", Arg.Bool (fun b -> verbose := b), ": logging output to console"); +] + +let _ = + try Arg.parse arglist (fun x -> rest := x :: !rest) usage; + if List.length !rest = 0 + then Lwt_unix.run (start_server "." !port !host !index !verbose ()) + else Lwt_unix.run (start_server (List.hd !rest) !port !host !index !verbose ()) + with + | Failure s -> print_endline s + | Sys_error s -> print_endline s diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index abb8061e3a..50b336de72 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -220,6 +220,8 @@ module type Server = sig Cohttp.Connection.t -> unit -> unit; } + val resolve_local_file : docroot:string -> uri:Uri.t -> string + val respond : ?headers:Cohttp.Header.t -> ?flush:bool -> @@ -270,6 +272,10 @@ module Make_server(IO:Cohttp.IO.S with type 'a t = 'a Lwt.t) module Transfer_IO = Transfer_io.Make(IO) + let resolve_local_file ~docroot ~uri = + Uri.path (Uri.resolve "" (Uri.of_string "") uri) + |> Filename.concat docroot + let respond ?headers ?(flush=false) ~status ~body () = let encoding = Cohttp_lwt_body.transfer_encoding body in let res = Response.make ~status ~flush ~encoding ?headers () in diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index 495bcc7e53..193b5827fc 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -150,6 +150,9 @@ module type Server = sig Cohttp.Connection.t -> unit -> unit; } + (** Resolve a URI and a docroot into a concrete local filename. *) + val resolve_local_file : docroot:string -> uri:Uri.t -> string + val respond : ?headers:Cohttp.Header.t -> ?flush:bool -> diff --git a/myocamlbuild.ml b/myocamlbuild.ml index e4b00c0e79..59d2e7e1b4 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 72cf2d13942cacfc33091904e4c642cf) *) +(* DO NOT EDIT (digest: 52c11beeb42a0bfb5136fda0433f4835) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -603,51 +603,13 @@ let package_default = ("cohttp_async", ["async"], []) ]; lib_c = []; - flags = - [ - (["oasis_library_cohttp_async_byte"; "ocaml"; "link"; "byte"], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]); - (["oasis_library_cohttp_async_native"; "ocaml"; "link"; "native"], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]); - (["oasis_library_cohttp_async_byte"; "ocaml"; "ocamldep"; "byte"], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]); - ([ - "oasis_library_cohttp_async_native"; - "ocaml"; - "ocamldep"; - "native" - ], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]); - (["oasis_library_cohttp_async_byte"; "ocaml"; "compile"; "byte"], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]); - (["oasis_library_cohttp_async_native"; "ocaml"; "compile"; "native" - ], - [ - (OASISExpr.EBool true, - S [A "-ppopt"; A "-let"; A "-ppopt"; A "ssl=true"]) - ]) - ]; + flags = []; includes = [ ("lwt", ["cohttp"]); ("lib_test", ["async"; "cohttp"; "lwt"]); ("examples/async", ["async"; "cohttp"]); - ("bin", ["async"; "cohttp"]); + ("bin", ["async"; "cohttp"; "lwt"]); ("async", ["cohttp"]) ] } @@ -655,6 +617,6 @@ let package_default = let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; -# 659 "myocamlbuild.ml" +# 621 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index 1444c86fe1..7daf9b0a0f 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.3 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 6352a578cd8fd2b9c517c56a37f79cb2) *) +(* DO NOT EDIT (digest: 3a8ffd579916cc8052bd8e4e1bf03d04) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6963,13 +6963,7 @@ let setup_t = conf_custom = { pre_command = [(OASISExpr.EBool true, None)]; - post_command = - [ - (OASISExpr.EBool true, - Some - (("./scripts/detect_async_ssl.sh", - ["$async_ssl"; ">"; "async/cohttp_async_incl.ml"]))) - ] + post_command = [(OASISExpr.EBool true, None)] }; build_type = (`Build, "ocamlbuild", Some "0.4"); build_custom = @@ -7093,16 +7087,6 @@ let setup_t = flag_description = Some "build the Core/Async library"; flag_default = [(OASISExpr.EBool true, false)] }); - Flag - ({ - cs_name = "async_ssl"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - flag_description = Some "build with Async SSL support"; - flag_default = [(OASISExpr.EBool true, false)] - }); Flag ({ cs_name = "nettests"; @@ -7240,16 +7224,8 @@ let setup_t = bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; - bs_byteopt = - [ - (OASISExpr.EBool true, - ["-ppopt"; "-let"; "-ppopt"; "ssl=true"]) - ]; - bs_nativeopt = - [ - (OASISExpr.EBool true, - ["-ppopt"; "-let"; "-ppopt"; "ssl=true"]) - ] + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] }, { lib_modules = ["Cohttp_async"]; @@ -7827,7 +7803,7 @@ let setup_t = }); Executable ({ - cs_name = "cohttp-server"; + cs_name = "cohttp-server-async"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, @@ -7859,6 +7835,38 @@ let setup_t = exec_custom = true; exec_main_is = "cohttp_server_async.ml" }); + Executable + ({ + cs_name = "cohttp-server-lwt"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "lwt", true) + ]; + bs_install = [(OASISExpr.EBool true, true)]; + bs_path = "bin"; + bs_compiled_object = Best; + bs_build_depends = + [ + InternalLibrary "cohttp"; + InternalLibrary "cohttp_lwt_unix" + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = true; exec_main_is = "cohttp_server_lwt.ml" + }); Executable ({ cs_name = "async-hello-world"; @@ -8039,7 +8047,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.4"; - oasis_digest = Some "\024\021\029½ËÉ\004ÆW½i·/\005àE"; + oasis_digest = Some "+\233\027P\146\129j\224<\220\136G\127\158\248\129"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8047,6 +8055,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8051 "setup.ml" +# 8059 "setup.ml" (* OASIS_STOP *) let () = setup ();;