Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Http_daemon;;
+open Http_types
+
(* start an http daemon that alway respond with a 200 status code and an empty
content *)
-start ~port:9999 ~addr:"localhost" (fun _ _ outchan -> respond outchan)
+let spec =
+ { Http_daemon.default_spec with
+ callback = (fun _ outchan -> Http_daemon.respond outchan);
+ port = 9999;
+ }
+
+let _ = Http_daemon.main spec
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-let callback (req: Http_types.request) outchan =
+open Http_types
+
+(* the easy way: specify authentication requirements within a daemon_spec *)
+let spec =
+ { Http_daemon.default_spec with
+ (* requires basic authentication, username "foo", password "bar" *)
+ auth = Some ("my realm", `Basic ("foo", "bar"));
+ callback = (fun _ outchan -> Http_daemon.respond ~body:"secret" outchan);
+ port = 9999;
+ }
+
+(*
+(* the hard^Wother way: manual handling of authorization *)
+let callback req outchan =
match req#authorization with
| Some (`Basic (username, password))
when username = "foo" && password = "bar" ->
- Http_daemon.respond ~code:(`Code 200) ~body:"secret page!" outchan
- | _ -> raise (Http_types.Unauthorized "my secret site")
+ Http_daemon.respond ~code:(`Code 200) ~body:"secret" outchan
+ | _ -> raise (Unauthorized "my secret site")
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = callback;
+ port = 9999;
+ }
+*)
-let _ = Http_daemon.start' ~port:9999 callback
+let _ = Http_daemon.main spec
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Http_daemon;;
-open Printf;;
-start
- ~port:9999
- ~root:"/etc"
- (fun _ _ outchan -> respond ~body:(sprintf "%s\n" (Sys.getcwd ())) outchan)
+open Printf
+open Http_types
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = (fun _ outchan ->
+ Http_daemon.respond ~body:(sprintf "%s\n" (Sys.getcwd ())) outchan);
+ port = 9999;
+ root_dir = Some "/etc";
+ }
+
+let _ = Http_daemon.main spec
+
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Printf;;
+open Printf
+open Http_types
let callback req outchan =
let body =
in
let res = new Http_response.response ~body () in
Http_daemon.respond_with res outchan
-in
-Http_daemon.start' ~port:9999 callback
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = callback;
+ port = 9999
+ }
+
+let _ = Http_daemon.main spec
+
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Http_types;;
-open Printf;;
-
-let wget addr port path =
- let rec wget' inchan buf =
- Buffer.add_string buf (input_line inchan ^ "\n");
- wget' inchan buf
- in
- prerr_endline (sprintf "DEBUG: wgetting url '%s:%d%s'" addr port path);
- let sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port) in
- let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
- Unix.connect suck sockaddr;
- let outchan = Unix.out_channel_of_descr suck in
- output_string outchan (sprintf "GET %s HTTP/1.0\r\n\r\n" path);
- flush outchan;
- let inchan = Unix.in_channel_of_descr suck in
- let buf = Buffer.create 1023 in
- try
- wget' inchan buf
- with End_of_file -> Buffer.contents buf
-in
-let callback (req: request) outchan =
+open Printf
+open Http_types
+
+let callback (req: Http_types.request) outchan =
let i = int_of_string (req#param "x") in
- prerr_endline (string_of_int i);
match i with
| 0 -> output_string outchan "1"
- | x when x>0 ->
+ | x when x > 0 ->
let data =
- wget "127.0.0.1" 9999 (sprintf "/foo?x=%d" (x-1))
-(* wget "127.0.0.1" 80 "/index.html" *)
+ Http_user_agent.get (sprintf "http://127.0.0.1/foo?x=%d" (x - 1))
in
output_string outchan (sprintf "%s %d" data x)
| _ -> assert false
-in
-let mode = `Thread in
-Http_daemon.start' ~port:9999 ~mode callback
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = callback;
+ port = 9999;
+ mode = `Thread;
+ }
+
+let _ = Http_daemon.main spec
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Printf;;
+open Printf
+open Http_types
let callback req outchan =
Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
(List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^
(sprintf "request BODY = '%s'\n" req#body)
in
- output_string outchan str;
- prerr_endline str
-in
-print_endline "Starting custom Http_daemon ...";
-flush stdout;
-Http_daemon.start' ~port:9999 callback
+ output_string outchan str
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = callback;
+ port = 9999;
+ }
+
+let _ = Http_daemon.main spec
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-(* almost the same as dump_args.ml, but used to test fast rebinding of the same
-port *)
-
-open Printf;;
-
-let callback req outchan =
- Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
- Http_daemon.send_CRLF outchan;
- let str =
- (sprintf "request path = %s\n" req#path) ^
- (sprintf "request GET params = %s\n"
- (String.concat ";"
- (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_GET))) ^
- (sprintf "request POST params = %s\n"
- (String.concat ";"
- (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_POST))) ^
- (sprintf "request ALL params = %s\n"
- (String.concat ";"
- (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^
- (sprintf "request BODY = '%s'\n" req#body)
- in
- output_string outchan str;
- prerr_endline str
-in
-print_endline "Starting custom Http_daemon ...";
-flush stdout;
-(* Sys.catch_break true; *)
-while true do
-(* try *)
- Http_daemon.start' ~mode:`Single ~port:9999 callback
-(* with Sys.Break -> prerr_endline "RESURRECTION!!!!" *)
-done
+(* test for fast rebinding of the tcp port *)
+
+open Printf
+open Http_types
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan);
+ port = 9999;
+ mode = `Single;
+ }
+
+let _ =
+ Sys.catch_break true;
+ while true do
+ try
+ Http_daemon.main spec;
+ with Sys.Break -> prerr_endline "RESURRECTION!!!!"
+ done
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Http_daemon;;
-open Http_response;;
+open Http_daemon
+open Http_response
(* the simple way *)
-let d = new daemon ~addr:"127.0.0.1" ~port:9999 () in
-while true do
- let (req, conn) = d#getRequest in (* wait for valid request *)
- conn#respond_with (new response ~body:"foo\n" ());
- conn#close
-done
+let d = new daemon ~addr:"127.0.0.1" ~port:9999 ()
+
+let _ =
+ while true do
+ let (req, conn) = d#getRequest in (* wait for valid request *)
+ conn#respond_with (new response ~body:"foo\n" ());
+ conn#close
+ done
(*
- (* the hard way *)
+ (* the hard^Wother way *)
let d = new daemon ~addr:"127.0.0.1" ~port:9999 () in
-while true do
- let conn = d#accept in (* wait for client connection *)
- (match conn#getRequest with
- | None -> () (* invalid request received *)
- | Some req -> conn#respond_with (new response ~body:"foo\n" ()));
- conn#close (* close socket *)
-done
+let _ =
+ while true do
+ let conn = d#accept in (* wait for client connection *)
+ (match conn#getRequest with
+ | None -> () (* invalid request received *)
+ | Some req -> conn#respond_with (new response ~body:"foo\n" ()));
+ conn#close (* close socket *)
+ done
*)
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-let callback _ _ outchan =
- output_string outchan "Here you are!\n";
- flush outchan
-in
-Http_daemon.start ~port:9999 ~timeout:(Some 10) callback
+open Http_types
+
+let spec =
+ { Http_daemon.default_spec with
+ callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan);
+ timeout = Some 10;
+ }
+
+let _ = Http_daemon.main spec
+
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-let def_port = 80 in
-let def_addr = "0.0.0.0" in
-let def_root = Sys.getcwd () in
+open Http_types
-let port = ref def_port in
-let addr = ref def_addr in
-let root = ref def_root in
+let def_port = 80
+let def_addr = "0.0.0.0"
+let def_root = Sys.getcwd ()
+
+let port = ref def_port
+let addr = ref def_addr
+let root = ref def_root
let argspec =
[ "-p", Arg.Int (fun p -> port := p),
"TCP port on which listen, default: " ^ string_of_int !port;
"-a", Arg.String (fun a -> addr := a),
"IP address on which listen, default: " ^ !addr;
"-r", Arg.String (fun r -> root := r),
- "DocumentRoot, default: current working directory" ]
-in
-Arg.parse argspec (fun _ -> ()) "";
-Sys.chdir !root;
-Http_daemon.Trivial.start ~addr:!addr ~port:!port ()
+ "DocumentRoot, default: current working directory";
+ ]
+
+let _ =
+ Arg.parse argspec (fun _ -> ()) "";
+ let spec =
+ { Http_daemon.default_spec with
+ address = !addr;
+ port = !port;
+ root_dir = Some !root
+ }
+ in
+ Http_daemon.Trivial.main spec
projects / helm.git / commitdiff