-common.cmo: types.cmi common.cmi
-common.cmx: types.cmx common.cmi
-daemon.cmo: common.cmi misc.cmi request.cmi types.cmi daemon.cmi
-daemon.cmx: common.cmx misc.cmx request.cmx types.cmx daemon.cmi
-misc.cmo: misc.cmi
-misc.cmx: misc.cmi
-request.cmo: common.cmi request.cmi
-request.cmx: common.cmx request.cmi
-response.cmo: common.cmi daemon.cmi types.cmi response.cmi
-response.cmx: common.cmx daemon.cmx types.cmx response.cmi
-types.cmo: types.cmi
-types.cmx: types.cmi
-common.cmi: types.cmi
-daemon.cmi: types.cmi
-request.cmi: types.cmi
-response.cmi: types.cmi
+http_common.cmo: http_types.cmi http_common.cmi
+http_common.cmx: http_types.cmx http_common.cmi
+http_daemon.cmo: http_common.cmi http_misc.cmi http_request.cmi \
+ http_types.cmi http_daemon.cmi
+http_daemon.cmx: http_common.cmx http_misc.cmx http_request.cmx \
+ http_types.cmx http_daemon.cmi
+http_misc.cmo: http_misc.cmi
+http_misc.cmx: http_misc.cmi
+http_request.cmo: http_common.cmi http_request.cmi
+http_request.cmx: http_common.cmx http_request.cmi
+http_response.cmo: http_common.cmi http_daemon.cmi http_response.cmi
+http_response.cmx: http_common.cmx http_daemon.cmx http_response.cmi
+http_types.cmo: http_types.cmi
+http_types.cmx: http_types.cmi
+http_common.cmi: http_types.cmi
include Makefile.defs
-MODULES = common misc types request daemon response
+MODULES = http_common http_misc http_types http_request http_daemon http_response
+PUBLIC_MODULES = http_common http_types http_request http_daemon http_response
DESTDIR = $(shell $(OCAMLFIND) printconf stdlib)
all: http.cma
%.cmx: %.ml %.cmi
$(OCAMLOPT) -c $<
-http.cmo: $(patsubst %,%.cmo,$(MODULES))
- ocamlc -pack -o $@ $^
-http.cmx: $(patsubst %,%.cmx,$(MODULES))
- ocamlopt -pack -o $@ $^
-http.cma: http.cmo
- $(OCAMLC) -a -o $@ $<
-http.cmxa: http.cmx
- $(OCAMLOPT) -a -o $@ $<
+http.cma: $(patsubst %,%.cmo,$(MODULES))
+ $(OCAMLC) -a -o $@ $^
+http.cmxa: $(patsubst %,%.cmx,$(MODULES))
+ $(OCAMLOPT) -a -o $@ $^
meta: META
META: META.in
rm -rf $(DISTDIR)/
install: META
$(OCAMLFIND) install -destdir $(DESTDIR) $(PKGNAME) \
- META common.mli types.mli request.mli daemon.mli response.mli http.*
+ META $(patsubst %,%.mli,$(PUBLIC_MODULES)) \
+ $(patsubst %,%.cmi,$(PUBLIC_MODULES)) http.cm{,x}a http.a
.PHONY: \
all opt world examples examples.opt depend clean distclean dist \
OCAMLDEP = $(OCAMLFIND) ocamldep $(COMMON_OPTS)
DISTNAME = ocaml-http
-DISTVERSION = 0.0.1
+DISTVERSION = 0.0.2
DISTDIR = $(DISTNAME)-$(DISTVERSION)
EXTRA_DIST = INSTALL LICENSE README META.in Makefile Makefile.defs .depend tophttp
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-exception Invalid_HTTP_version of string
-exception Invalid_code of int
-exception Invalid_status of Types.status
-
-let http_version = `HTTP_1_1
-
-let string_of_version = function
- | `HTTP_1_0 -> "HTTP/1.0"
- | `HTTP_1_1 -> "HTTP/1.1"
-
-let version_of_string = function
- | "HTTP/1.0" -> `HTTP_1_0
- | "HTTP/1.1" -> `HTTP_1_1
- | invalid_version -> raise (Invalid_HTTP_version invalid_version)
-
-let status_of_code = function
- | 100 -> `Informational `Continue
- | 101 -> `Informational `Switching_protocols
- | 200 -> `Success `OK
- | 201 -> `Success `Created
- | 202 -> `Success `Accepted
- | 203 -> `Success `Non_authoritative_information
- | 204 -> `Success `No_content
- | 205 -> `Success `Reset_content
- | 206 -> `Success `Partial_content
- | 300 -> `Redirection `Multiple_choices
- | 301 -> `Redirection `Moved_permanently
- | 302 -> `Redirection `Found
- | 303 -> `Redirection `See_other
- | 304 -> `Redirection `Not_modified
- | 305 -> `Redirection `Use_proxy
- | 307 -> `Redirection `Temporary_redirect
- | 400 -> `Client_error `Bad_request
- | 401 -> `Client_error `Unauthorized
- | 402 -> `Client_error `Payment_required
- | 403 -> `Client_error `Forbidden
- | 404 -> `Client_error `Not_found
- | 405 -> `Client_error `Method_not_allowed
- | 406 -> `Client_error `Not_acceptable
- | 407 -> `Client_error `Proxy_authentication_required
- | 408 -> `Client_error `Request_time_out
- | 409 -> `Client_error `Conflict
- | 410 -> `Client_error `Gone
- | 411 -> `Client_error `Length_required
- | 412 -> `Client_error `Precondition_failed
- | 413 -> `Client_error `Request_entity_too_large
- | 414 -> `Client_error `Request_URI_too_large
- | 415 -> `Client_error `Unsupported_media_type
- | 416 -> `Client_error `Requested_range_not_satisfiable
- | 417 -> `Client_error `Expectation_failed
- | 500 -> `Server_error `Internal_server_error
- | 501 -> `Server_error `Not_implemented
- | 502 -> `Server_error `Bad_gateway
- | 503 -> `Server_error `Service_unavailable
- | 504 -> `Server_error `Gateway_time_out
- | 505 -> `Server_error `HTTP_version_not_supported
- | invalid_code -> raise (Invalid_code invalid_code)
-
-let code_of_status = function
- | `Informational `Continue -> 100
- | `Informational `Switching_protocols -> 101
- | `Success `OK -> 200
- | `Success `Created -> 201
- | `Success `Accepted -> 202
- | `Success `Non_authoritative_information -> 203
- | `Success `No_content -> 204
- | `Success `Reset_content -> 205
- | `Success `Partial_content -> 206
- | `Redirection `Multiple_choices -> 300
- | `Redirection `Moved_permanently -> 301
- | `Redirection `Found -> 302
- | `Redirection `See_other -> 303
- | `Redirection `Not_modified -> 304
- | `Redirection `Use_proxy -> 305
- | `Redirection `Temporary_redirect -> 307
- | `Client_error `Bad_request -> 400
- | `Client_error `Unauthorized -> 401
- | `Client_error `Payment_required -> 402
- | `Client_error `Forbidden -> 403
- | `Client_error `Not_found -> 404
- | `Client_error `Method_not_allowed -> 405
- | `Client_error `Not_acceptable -> 406
- | `Client_error `Proxy_authentication_required -> 407
- | `Client_error `Request_time_out -> 408
- | `Client_error `Conflict -> 409
- | `Client_error `Gone -> 410
- | `Client_error `Length_required -> 411
- | `Client_error `Precondition_failed -> 412
- | `Client_error `Request_entity_too_large -> 413
- | `Client_error `Request_URI_too_large -> 414
- | `Client_error `Unsupported_media_type -> 415
- | `Client_error `Requested_range_not_satisfiable -> 416
- | `Client_error `Expectation_failed -> 417
- | `Server_error `Internal_server_error -> 500
- | `Server_error `Not_implemented -> 501
- | `Server_error `Bad_gateway -> 502
- | `Server_error `Service_unavailable -> 503
- | `Server_error `Gateway_time_out -> 504
- | `Server_error `HTTP_version_not_supported -> 505
-
-let reason_phrase_of_code = function
- | 100 -> "Continue"
- | 101 -> "Switching protocols"
- | 200 -> "OK"
- | 201 -> "Created"
- | 202 -> "Accepted"
- | 203 -> "Non authoritative information"
- | 204 -> "No content"
- | 205 -> "Reset content"
- | 206 -> "Partial content"
- | 300 -> "Multiple choices"
- | 301 -> "Moved permanently"
- | 302 -> "Found"
- | 303 -> "See other"
- | 304 -> "Not modified"
- | 305 -> "Use proxy"
- | 307 -> "Temporary redirect"
- | 400 -> "Bad request"
- | 401 -> "Unauthorized"
- | 402 -> "Payment required"
- | 403 -> "Forbidden"
- | 404 -> "Not found"
- | 405 -> "Method not allowed"
- | 406 -> "Not acceptable"
- | 407 -> "Proxy authentication required"
- | 408 -> "Request time out"
- | 409 -> "Conflict"
- | 410 -> "Gone"
- | 411 -> "Length required"
- | 412 -> "Precondition failed"
- | 413 -> "Request entity too large"
- | 414 -> "Request URI too large"
- | 415 -> "Unsupported media type"
- | 416 -> "Requested range not satisfiable"
- | 417 -> "Expectation failed"
- | 500 -> "Internal server error"
- | 501 -> "Not implemented"
- | 502 -> "Bad gateway"
- | 503 -> "Service unavailable"
- | 504 -> "Gateway time out"
- | 505 -> "HTTP version not supported"
- | invalid_code -> raise (Invalid_code invalid_code)
-
-let reason_phrase_of_status s = reason_phrase_of_code (code_of_status s)
-
-let is_informational code =
- match status_of_code code with
- | `Informational _ -> true
- | _ -> false
-
-let is_success code =
- match status_of_code code with
- | `Success _ -> true
- | _ -> false
-
-let is_redirection code =
- match status_of_code code with
- | `Redirection _ -> true
- | _ -> false
-
-let is_client_error code =
- match status_of_code code with
- | `Client_error _ -> true
- | _ -> false
-
-let is_server_error code =
- match status_of_code code with
- | `Server_error _ -> true
- | _ -> false
-
-let is_error code = is_client_error code || is_server_error code
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-exception Invalid_HTTP_version of string
-exception Invalid_code of int
-exception Invalid_status of Types.status
-
-val http_version: Types.version
-
-val string_of_version: Types.version -> string
-val version_of_string: string -> Types.version
-
-val status_of_code: int -> Types.status
-val code_of_status: [< Types.status] -> int
-
-val reason_phrase_of_code: int -> string
-val reason_phrase_of_status: [< Types.status] -> string
-
-val is_informational: int -> bool
-val is_success: int -> bool
-val is_redirection: int -> bool
-val is_client_error: int -> bool
-val is_server_error: int -> bool
-val is_error: int -> bool
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Neturl;;
-open Printf;;
-
-let debug = false
-let debug_print str =
- prerr_endline ("DEBUG: " ^ str);
- flush stderr
-
-let default_addr = "0.0.0.0"
-let default_port = 80
-let default_timeout = 300
-
-(*
-type url_syntax_option =
- Url_part_not_recognized
- | Url_part_allowed
- | Url_part_required
-
-* (1) scheme://user:password@host:port/path;params?query#fragment
-*)
-
-let request_uri_syntax = {
- url_enable_scheme = Url_part_not_recognized;
- url_enable_user = Url_part_not_recognized;
- url_enable_password = Url_part_not_recognized;
- url_enable_host = Url_part_not_recognized;
- url_enable_port = Url_part_not_recognized;
- url_enable_path = Url_part_required;
- url_enable_param = Url_part_not_recognized;
- url_enable_query = Url_part_allowed;
- url_enable_fragment = Url_part_not_recognized;
- url_enable_other = Url_part_not_recognized;
- url_accepts_8bits = false;
- url_is_valid = (fun _ -> true);
-}
-
-let crlf = "\r\n"
-
-exception Malformed_request of string
-exception Unsupported_method of string
-exception Malformed_request_URI of string
-exception Unsupported_HTTP_version of string
-exception Malformed_query of string
-exception Malformed_query_binding of string * string
-
- (** given a list of length 2
- @return a pair formed by the elements of the list
- @raise Assert_failure if the list length isn't 2
- *)
-let pair_of_2_sized_list = function
- | [a;b] -> (a,b)
- | _ -> assert false
-
- (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...")
- @return a list of pairs [("name1", "value1"); ("name2", "value2")]
- @raise Malformed_query if the string isn't a valid query string
- @raise Malformed_query_binding if some piece of the query isn't valid
- *)
-let split_query_params =
- let (bindings_sep, binding_sep) = (Pcre.regexp "&", Pcre.regexp "=") in
- fun ~query ->
- let bindings = Pcre.split ~rex:bindings_sep query in
- if List.length bindings < 1 then
- raise (Malformed_query query);
- List.map
- (fun binding ->
- let pieces = Pcre.split ~rex:binding_sep binding in
- if List.length pieces <> 2 then
- raise (Malformed_query_binding (binding, query));
- pair_of_2_sized_list pieces)
- bindings
-
- (** given an input channel and a separator
- @return a line read from it (like Pervasives.input_line)
- line is returned only after reading a separator string; separator string isn't
- included in the returned value
- FIXME what about efficiency?, input is performed char-by-char
- *)
-let generic_input_line ~sep ~ic =
- let sep_len = String.length sep in
- if sep_len < 1 then
- failwith ("Separator '" ^ sep ^ "' is too short!")
- else (* valid separator *)
- let line = ref "" in
- let sep_pointer = ref 0 in
- try
- while true do
- if !sep_pointer >= String.length sep then (* line completed *)
- raise End_of_file
- else begin (* incomplete line: need to read more *)
- let ch = input_char ic in
- if ch = String.get sep !sep_pointer then (* next piece of sep *)
- incr sep_pointer
- else begin (* useful char *)
- for i = 0 to !sep_pointer - 1 do
- line := !line ^ (String.make 1 (String.get sep i))
- done;
- sep_pointer := 0;
- line := !line ^ (String.make 1 ch)
- end
- end
- done;
- assert false (* unreacheable statement *)
- with End_of_file ->
- if !line = "" then
- raise End_of_file
- else
- !line
-
- (** given an input channel, reads from it a GET HTTP request and
- @return a pair <path, query_params> where path is a string representing the
- requested path and query_params is a list of pairs <name, value> (the GET
- parameters)
- *)
-let parse_http_request =
- let patch_empty_path s = (if s = "" then "/" else s) in
- let pieces_sep = Pcre.regexp " " in
- fun ~ic ->
- let request_line = generic_input_line ~sep:crlf ~ic in
- if debug then
- debug_print ("request_line: '" ^ request_line ^ "'");
- match Pcre.split ~rex:pieces_sep request_line with
- | [meth; request_uri_raw; http_version] ->
- if meth <> "GET" then
- raise (Unsupported_method meth);
- (match http_version with
- | "HTTP/1.0" | "HTTP/1.1" -> ()
- | _ -> raise (Unsupported_HTTP_version http_version));
- let request_uri =
- try
- url_of_string request_uri_syntax request_uri_raw
- with Malformed_URL ->
- raise (Malformed_request_URI request_uri_raw)
- in
- let path =
- patch_empty_path (String.concat "/" (url_path request_uri))
- in
- let query_params =
- try split_query_params (url_query request_uri) with Not_found -> []
- in
- (path, query_params)
- | _ -> raise (Malformed_request request_line)
-
- (** send raw data on outchan, flushing it afterwards *)
-let send_raw ~data outchan =
- output_string outchan data;
- flush outchan
-
-let send_CRLF = send_raw ~data:crlf
-
- (** TODO perform some sanity test on header and value *)
-let send_header ~header ~value = send_raw ~data:(header ^ ": " ^ value ^ crlf)
-
-let send_headers ~headers outchan =
- List.iter (fun (header, value) -> send_header ~header ~value outchan) headers
-
- (** internal: parse a code argument from a function which have two optional
- arguments "code" and "status" *)
-let get_code_argument func_name =
- fun ~code ~status ->
- (match code, status with
- | Some c, None -> c
- | None, Some s -> Common.code_of_status s
- | Some _, Some _ ->
- failwith (func_name ^ " you must give 'code' or 'status', not both")
- | None, None ->
- failwith (func_name ^ " you must give 'code' or 'status', not none"))
-
- (** internal: low level for send_status_line *)
-let send_status_line' ~version ~code =
- let status_line =
- String.concat
- " "
- [ Common.string_of_version version;
- string_of_int code;
- Common.reason_phrase_of_code code ]
- in
- send_raw ~data:(status_line ^ crlf)
-
-let send_status_line ?(version = Common.http_version) ?code ?status outchan =
- send_status_line'
- ~version
- ~code:(get_code_argument "Daemon.send_status_line" ~code ~status)
- outchan
-
-let send_basic_headers ?(version = Common.http_version) ?code ?status outchan =
- send_status_line'
- ~version ~code:(get_code_argument "Daemon.send_basic_headers" ~code ~status)
- outchan;
- send_headers
- ~headers:["Date", Misc.date_822 (); "Server", "OCaml HTTP Daemon"]
- outchan
-
- (** internal: send a fooish body explaining in HTML form the 'reason phrase'
- of an HTTP response; body, if given, will be appended to the body *)
-let send_foo_body ~code ~body =
- let reason_phrase = Common.reason_phrase_of_code code in
- let body =
- sprintf
-"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
-<HTML><HEAD>
-<TITLE>%d %s</TITLE>
-</HEAD><BODY>
-<H1>%d - %s</H1>%s
-</BODY></HTML>"
- code reason_phrase code reason_phrase
- (match body with None -> "" | Some text -> "\n" ^ text)
- in
- send_raw ~data:body
-
- (** internal: low level for respond_redirect, respond_error, ...
- This function send a status line corresponding to a given code, some basic
- headers, the additional headers (if given) and an HTML page containing the
- reason phrase; if body is given it will be included in the body of the HTML
- page *)
-let send_empty_response
- f_name ?(is_valid_status = fun _ -> true) ?(headers = []) ~body () =
- fun ?(version = Common.http_version) ?code ?status outchan ->
- let code = get_code_argument f_name ~code ~status in
- if not (is_valid_status code) then
- failwith (sprintf "'%d' isn't a valid status code for %s" code f_name)
- else begin (* status code suitable for answering *)
- send_basic_headers ~version ~code outchan;
- send_header ~header:"Connection" ~value:"close" outchan;
- send_header
- ~header:"Content-Type"
- ~value:"text/html; charset=iso-8859-1"
- outchan;
- send_headers ~headers outchan;
- send_CRLF outchan;
- send_foo_body ~code ~body outchan
- end
-
- (* TODO sanity tests on location *)
-let respond_redirect
- ~location ?body
- ?(version = Common.http_version) ?(code = 301) ?status outchan =
- let code =
- match status with
- | None -> code
- | Some (s: Types.redirection_status) -> Common.code_of_status s
- in
- send_empty_response
- "Daemon.respond_redirect" ~is_valid_status:Common.is_redirection
- ~headers:["Location", location] ~body ()
- ~version ~code outchan
-
-let respond_error
- ?body
- ?(version = Common.http_version) ?(code = 400) ?status outchan =
- let code =
- match status with
- | None -> code
- | Some s -> Common.code_of_status s
- in
- send_empty_response
- "Daemon.respond_error" ~is_valid_status:Common.is_error ~body ()
- ~version ~code outchan
-
-let respond_not_found ~url ?(version = Common.http_version) outchan =
- send_empty_response
- "Daemon.respond_not_found" ~body:None ()
- ~version ~code:404 outchan
-
-let respond_forbidden ~url ?(version = Common.http_version) outchan =
- send_empty_response
- "Daemon.respond_permission_denied" ~body:None ()
- ~version ~code:403 outchan
-
-let send_file ?name ?file outchan =
- let buflen = 1024 in
- let buf = String.make buflen ' ' in
- let (file, cleanup) =
- (match (name, file) with
- | Some n, None -> (* if we open the file, we close it before returning *)
- let f = open_in n in
- f, (fun () -> close_in f)
- | None, Some f -> (f, (fun () -> ()))
- | _ -> failwith "Daemon.send_file: either name or file must be given")
- in
- try
- while true do
- let bytes = input file buf 0 buflen in
- if bytes = 0 then
- raise End_of_file
- else
- output outchan buf 0 bytes
- done;
- assert false
- with End_of_file ->
- begin
- flush outchan;
- cleanup ()
- end
-
- (* TODO interface is too ugly to advertise this function in .mli *)
- (** create a minimal HTML directory listing of a given directory and send it
- over an out_channel, directory is passed as a dir_handle; name is the
- directory name, used for pretty printing purposes; path is the opened dir
- path, used to test its contents with stat *)
-let send_dir_listing ~dir ~name ~path outchan =
- fprintf outchan "<html>\n<head><title>%s</title></head>\n<body>\n" name;
- let (dirs, files) =
- List.partition (fun e -> Misc.is_directory (path ^ e)) (Misc.ls dir)
- in
- List.iter
- (fun d -> fprintf outchan "<a href=\"%s/\">%s/</a><br />\n" d d)
- (List.sort compare dirs);
- List.iter
- (fun f -> fprintf outchan "<a href=\"%s\">%s</a><br />\n" f f)
- (List.sort compare files);
- fprintf outchan "</body>\n</html>";
- flush outchan
-
-let respond_file ~fname ?(version = Common.http_version) outchan =
- (** ASSUMPTION: 'fname' doesn't begin with a "/"; it's relative to the current
- document root (usually the daemon's cwd) *)
- let droot = Sys.getcwd () in (* document root *)
- let path = droot ^ "/" ^ fname in (* full path to the desired file *)
- if not (Sys.file_exists path) then (* file not found *)
- respond_not_found ~url:fname outchan
- else begin
- try
- if Misc.is_directory path then begin (* file found, is a dir *)
- let dir = Unix.opendir path in
- send_basic_headers ~version ~code:200 outchan;
- send_header "Content-Type" "text/html" outchan;
- send_CRLF outchan;
- send_dir_listing ~dir ~name:fname ~path outchan;
- Unix.closedir dir
- end else begin (* file found, is something else *)
- let file = open_in fname in
- send_basic_headers ~version ~code:200 outchan;
- send_header
- ~header:"Content-Length"
- ~value:(string_of_int (Misc.filesize fname))
- outchan;
- send_CRLF outchan;
- send_file ~file outchan;
- close_in file
- end
- with
- | Unix.Unix_error (Unix.EACCES, s, _) when (s = fname) ->
- respond_forbidden ~url:fname ~version outchan
- | Sys_error s when
- (Pcre.pmatch ~rex:(Pcre.regexp (fname ^ ": Permission denied")) s) ->
- respond_forbidden ~url:fname ~version outchan
- end
-
-let respond_with (res: Types.response) outchan =
- res#serialize outchan;
- flush outchan
-
-let start
- ?(addr = default_addr) ?(port = default_port)
- ?(timeout = Some default_timeout)
- callback
- =
- let sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port) in
- let timeout_callback signo =
- if signo = Sys.sigalrm then begin
- debug_print "TIMEOUT, exiting ...";
- exit 2
- end
- in
- let daemon_callback inchan outchan =
- (match timeout with
- | Some timeout ->
- ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback));
- ignore (Unix.alarm timeout)
- | None -> ());
- try
- let (path, parameters) = parse_http_request inchan in
- callback path parameters outchan;
- flush outchan
- with
- | End_of_file ->
- respond_error ~code:400 ~body:"Unexpected End Of File" outchan
- | Malformed_request req ->
- respond_error
- ~code:400
- ~body:(
- "request 1st line format should be: '<method> <url> <version>'" ^
- "<br />\nwhile received request 1st line was:<br />\n" ^ req)
- outchan
- | Unsupported_method meth ->
- respond_error
- ~code:501
- ~body:("Method '" ^ meth ^ "' isn't supported (yet)")
- outchan
- | Malformed_request_URI uri ->
- respond_error ~code:400 ~body:("Malformed URL: '" ^ uri ^ "'") outchan
- | Unsupported_HTTP_version version ->
- respond_error
- ~code:505
- ~body:("HTTP version '" ^ version ^ "' isn't supported (yet)")
- outchan
- | Malformed_query query ->
- respond_error
- ~code:400 ~body:("Malformed query string '" ^ query ^ "'") outchan
- | Malformed_query_binding (binding, query) ->
- respond_error
- ~code:400
- ~body:(
- sprintf "Malformed query element '%s' in query '%s'" binding query)
- outchan
- in
- Unix.establish_server daemon_callback sockaddr
-
-let start'
- ?(addr = default_addr) ?(port = default_port)
- ?(timeout = Some default_timeout)
- (callback: (Types.request -> out_channel -> unit))
- =
- let wrapper path params outchan =
- let req = new Request.request ~path ~params in
- callback req outchan
- in
- start ~addr ~port ~timeout wrapper
-
-module Trivial =
- struct
- let callback path _ outchan =
- if not (Pcre.pmatch ~rex:(Pcre.regexp "^/") path) then
- respond_error ~code:400 outchan
- else
- respond_file ~fname:(Misc.strip_heading_slash path) outchan
- let start ?(addr = default_addr) ?(port = default_port) () =
- start ~addr ~port callback
- end
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
- (** send a CRLF sequence on the given output channel, this is mandatory after
- the last header was sent and before start sending the response body *)
-val send_CRLF: out_channel -> unit
-
- (** send response status line, version is the http version used in response,
- either code or status must be given (not both, not none) which represent the
- HTTP response code, outchan is the output channel to which send status line *)
-val send_status_line:
- ?version: Types.version -> ?code: int -> ?status: Types.status ->
- out_channel ->
- unit
-
- (** like send_status_line but additionally will also send "Date" and "Server"
- standard headers *)
-val send_basic_headers:
- ?version: Types.version -> ?code: int -> ?status: Types.status ->
- out_channel ->
- unit
-
- (** send an HTTP header on outchan *)
-val send_header: header: string -> value: string -> out_channel -> unit
-
- (** as send_header, but for a list of pairs <header, value> *)
-val send_headers: headers:(string * string) list -> out_channel -> unit
-
- (** send a file through an out_channel, file can be passed as an in_channel
- (if 'file' is given) or as a file name (if 'name' is given) *)
-val send_file: ?name:string -> ?file:in_channel -> out_channel -> unit
-
- (** send a 404 (not found) HTTP response *)
-val respond_not_found:
- url:string -> ?version: Types.version -> out_channel -> unit
-
- (** send a 403 (forbidden) HTTP response *)
-val respond_forbidden:
- url:string -> ?version: Types.version -> out_channel -> unit
-
- (** send a "redirection" class response, optional body argument contains data
- that will be displayed in the body of the response, default response status is
- 302 (moved permanently), only redirection status are accepted by this
- function, other values will @raise Failure *)
-val respond_redirect:
- location:string -> ?body:string ->
- ?version: Types.version -> ?code: int -> ?status: Types.redirection_status ->
- out_channel ->
- unit
-
- (** send an "error" response (i.e. 400 <= status < 600), optional body
- argument as per send_redirect, default response status is 400 (bad request),
- only error status are accepted by this function, other values will
- @raise Failure *)
-val respond_error:
- ?body:string ->
- ?version: Types.version -> ?code: int -> ?status: Types.error_status ->
- out_channel ->
- unit
-
- (** tipical static pages http daemon behaviour, if requested url is a file,
- return it, it it is a directory return a directory listing of it *)
-val respond_file: fname:string -> ?version: Types.version -> out_channel -> unit
-
- (** respond using a prebuilt Types.response object *)
-val respond_with: Types.response -> out_channel -> unit
-
- (** create an HTTP daemon listening on 'addr':'port' (defaults are
- addr:"0.0.0.0" and port:80), callback is the user supplied function which
- receive as a first parameter the path required by the the HTTP client as a
- string, and a list of pair <parameter, value> representing parameters passed
- via GET. The last argument of the callback is an output_channel connected to
- the HTTP client to which the user can write directly. 'timeout' parameter
- sets a timeout for each request processed by the daemon, if it's set to None,
- daemon waits forever for completed requests (use with care!), default is 5
- minute *)
-val start:
- ?addr: string -> ?port: int -> ?timeout: int option ->
- (string -> (string * string) list -> out_channel -> unit) ->
- unit
-
- (** identical to 'start' above but callback receive two arguments, the second
- one is an out_channel as per 'start', but the secondo one is a Request.request
- object *)
-val start':
- ?addr: string -> ?port: int -> ?timeout: int option ->
- (Types.request -> out_channel -> unit) ->
- unit
-
- (** Trivial static pages HTTP daemon *)
-module Trivial :
- sig
- val callback : string -> 'a -> out_channel -> unit
- val start : ?addr:string -> ?port:int -> unit -> unit
- end
-
+ocaml-http (0.0.2) unstable; urgency=low
+
+ * Doesn't use anymore -pack, library is now accessible as Http_daemon,
+ Http_response, ... in place of Http.Daemon, Http.Response, ...
+
+ -- Stefano Zacchiroli <zack@debian.org> Thu, 14 Nov 2002 12:51:07 +0100
+
ocaml-http (0.0.1) unstable; urgency=low
* Initial Release.
distclean: clean
clean:
- -rm -f *.cm[ioax] *.o $(EXAMPLES)
+ -rm -f *.cm[ioax] *.o $(EXAMPLES) $(patsubst %,%.opt,$(EXAMPLES))
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Http.Daemon;;
-open Http.Response;;
+open Http_daemon;;
+open Http_response;;
(* start an http daemon that alway respond with a 200 status code and an empty
content *)
-start (fun _ _ -> respond_with (new Http.Response.response))
+start (fun _ _ -> respond_with (new Http_response.response))
let callback path args outchan =
match path with
| "/gone" ->
- Http.Daemon.respond_redirect
+ Http_daemon.respond_redirect
~location:"/foo" ~body:"REDIRECT" ~code:302 outchan
| "/error" ->
- Http.Daemon.respond_error ~body:"ERROR" ~code:500 outchan
+ Http_daemon.respond_error ~body:"ERROR" ~code:500 outchan
| _ ->
begin
- Http.Daemon.send_basic_headers ~code:200 outchan;
- Http.Daemon.send_CRLF outchan;
+ Http_daemon.send_basic_headers ~code:200 outchan;
+ Http_daemon.send_CRLF outchan;
output_string outchan (dump_args path args)
end
in
-print_endline "Starting custom Http.Daemon ...";
+print_endline "Starting custom Http_daemon ...";
flush stdout;
-Http.Daemon.start ~addr:"127.0.0.1" ~port:9999 callback
+Http_daemon.start ~addr:"127.0.0.1" ~port:9999 callback
*)
let callback req outchan =
- Http.Daemon.respond_error ~body:(req#param "foo") outchan
+ Http_daemon.respond_error ~body:(req#param "foo") outchan
in
-Http.Daemon.start' ~addr:"127.0.0.1" ~port:9999 callback
+Http_daemon.start' ~addr:"127.0.0.1" ~port:9999 callback
output_string outchan "Here you are!\n";
flush outchan
in
-Http.Daemon.start ~addr:"127.0.0.1" ~port:9999 ~timeout:(Some 10) callback
+Http_daemon.start ~addr:"127.0.0.1" ~port:9999 ~timeout:(Some 10) callback
in
Arg.parse argspec (fun _ -> ()) "";
Sys.chdir !root;
-Http.Daemon.Trivial.start ~addr:!addr ~port:!port ()
+Http_daemon.Trivial.start ~addr:!addr ~port:!port ()
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+exception Invalid_HTTP_version of string
+exception Invalid_code of int
+exception Invalid_status of Http_types.status
+
+let http_version = `HTTP_1_1
+
+let string_of_version = function
+ | `HTTP_1_0 -> "HTTP/1.0"
+ | `HTTP_1_1 -> "HTTP/1.1"
+
+let version_of_string = function
+ | "HTTP/1.0" -> `HTTP_1_0
+ | "HTTP/1.1" -> `HTTP_1_1
+ | invalid_version -> raise (Invalid_HTTP_version invalid_version)
+
+let status_of_code = function
+ | 100 -> `Informational `Continue
+ | 101 -> `Informational `Switching_protocols
+ | 200 -> `Success `OK
+ | 201 -> `Success `Created
+ | 202 -> `Success `Accepted
+ | 203 -> `Success `Non_authoritative_information
+ | 204 -> `Success `No_content
+ | 205 -> `Success `Reset_content
+ | 206 -> `Success `Partial_content
+ | 300 -> `Redirection `Multiple_choices
+ | 301 -> `Redirection `Moved_permanently
+ | 302 -> `Redirection `Found
+ | 303 -> `Redirection `See_other
+ | 304 -> `Redirection `Not_modified
+ | 305 -> `Redirection `Use_proxy
+ | 307 -> `Redirection `Temporary_redirect
+ | 400 -> `Client_error `Bad_request
+ | 401 -> `Client_error `Unauthorized
+ | 402 -> `Client_error `Payment_required
+ | 403 -> `Client_error `Forbidden
+ | 404 -> `Client_error `Not_found
+ | 405 -> `Client_error `Method_not_allowed
+ | 406 -> `Client_error `Not_acceptable
+ | 407 -> `Client_error `Proxy_authentication_required
+ | 408 -> `Client_error `Request_time_out
+ | 409 -> `Client_error `Conflict
+ | 410 -> `Client_error `Gone
+ | 411 -> `Client_error `Length_required
+ | 412 -> `Client_error `Precondition_failed
+ | 413 -> `Client_error `Request_entity_too_large
+ | 414 -> `Client_error `Request_URI_too_large
+ | 415 -> `Client_error `Unsupported_media_type
+ | 416 -> `Client_error `Requested_range_not_satisfiable
+ | 417 -> `Client_error `Expectation_failed
+ | 500 -> `Server_error `Internal_server_error
+ | 501 -> `Server_error `Not_implemented
+ | 502 -> `Server_error `Bad_gateway
+ | 503 -> `Server_error `Service_unavailable
+ | 504 -> `Server_error `Gateway_time_out
+ | 505 -> `Server_error `HTTP_version_not_supported
+ | invalid_code -> raise (Invalid_code invalid_code)
+
+let code_of_status = function
+ | `Informational `Continue -> 100
+ | `Informational `Switching_protocols -> 101
+ | `Success `OK -> 200
+ | `Success `Created -> 201
+ | `Success `Accepted -> 202
+ | `Success `Non_authoritative_information -> 203
+ | `Success `No_content -> 204
+ | `Success `Reset_content -> 205
+ | `Success `Partial_content -> 206
+ | `Redirection `Multiple_choices -> 300
+ | `Redirection `Moved_permanently -> 301
+ | `Redirection `Found -> 302
+ | `Redirection `See_other -> 303
+ | `Redirection `Not_modified -> 304
+ | `Redirection `Use_proxy -> 305
+ | `Redirection `Temporary_redirect -> 307
+ | `Client_error `Bad_request -> 400
+ | `Client_error `Unauthorized -> 401
+ | `Client_error `Payment_required -> 402
+ | `Client_error `Forbidden -> 403
+ | `Client_error `Not_found -> 404
+ | `Client_error `Method_not_allowed -> 405
+ | `Client_error `Not_acceptable -> 406
+ | `Client_error `Proxy_authentication_required -> 407
+ | `Client_error `Request_time_out -> 408
+ | `Client_error `Conflict -> 409
+ | `Client_error `Gone -> 410
+ | `Client_error `Length_required -> 411
+ | `Client_error `Precondition_failed -> 412
+ | `Client_error `Request_entity_too_large -> 413
+ | `Client_error `Request_URI_too_large -> 414
+ | `Client_error `Unsupported_media_type -> 415
+ | `Client_error `Requested_range_not_satisfiable -> 416
+ | `Client_error `Expectation_failed -> 417
+ | `Server_error `Internal_server_error -> 500
+ | `Server_error `Not_implemented -> 501
+ | `Server_error `Bad_gateway -> 502
+ | `Server_error `Service_unavailable -> 503
+ | `Server_error `Gateway_time_out -> 504
+ | `Server_error `HTTP_version_not_supported -> 505
+
+let reason_phrase_of_code = function
+ | 100 -> "Continue"
+ | 101 -> "Switching protocols"
+ | 200 -> "OK"
+ | 201 -> "Created"
+ | 202 -> "Accepted"
+ | 203 -> "Non authoritative information"
+ | 204 -> "No content"
+ | 205 -> "Reset content"
+ | 206 -> "Partial content"
+ | 300 -> "Multiple choices"
+ | 301 -> "Moved permanently"
+ | 302 -> "Found"
+ | 303 -> "See other"
+ | 304 -> "Not modified"
+ | 305 -> "Use proxy"
+ | 307 -> "Temporary redirect"
+ | 400 -> "Bad request"
+ | 401 -> "Unauthorized"
+ | 402 -> "Payment required"
+ | 403 -> "Forbidden"
+ | 404 -> "Not found"
+ | 405 -> "Method not allowed"
+ | 406 -> "Not acceptable"
+ | 407 -> "Proxy authentication required"
+ | 408 -> "Request time out"
+ | 409 -> "Conflict"
+ | 410 -> "Gone"
+ | 411 -> "Length required"
+ | 412 -> "Precondition failed"
+ | 413 -> "Request entity too large"
+ | 414 -> "Request URI too large"
+ | 415 -> "Unsupported media type"
+ | 416 -> "Requested range not satisfiable"
+ | 417 -> "Expectation failed"
+ | 500 -> "Internal server error"
+ | 501 -> "Not implemented"
+ | 502 -> "Bad gateway"
+ | 503 -> "Service unavailable"
+ | 504 -> "Gateway time out"
+ | 505 -> "HTTP version not supported"
+ | invalid_code -> raise (Invalid_code invalid_code)
+
+let reason_phrase_of_status s = reason_phrase_of_code (code_of_status s)
+
+let is_informational code =
+ match status_of_code code with
+ | `Informational _ -> true
+ | _ -> false
+
+let is_success code =
+ match status_of_code code with
+ | `Success _ -> true
+ | _ -> false
+
+let is_redirection code =
+ match status_of_code code with
+ | `Redirection _ -> true
+ | _ -> false
+
+let is_client_error code =
+ match status_of_code code with
+ | `Client_error _ -> true
+ | _ -> false
+
+let is_server_error code =
+ match status_of_code code with
+ | `Server_error _ -> true
+ | _ -> false
+
+let is_error code = is_client_error code || is_server_error code
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+exception Invalid_HTTP_version of string
+exception Invalid_code of int
+exception Invalid_status of Http_types.status
+
+val http_version: Http_types.version
+
+val string_of_version: Http_types.version -> string
+val version_of_string: string -> Http_types.version
+
+val status_of_code: int -> Http_types.status
+val code_of_status: [< Http_types.status] -> int
+
+val reason_phrase_of_code: int -> string
+val reason_phrase_of_status: [< Http_types.status] -> string
+
+val is_informational: int -> bool
+val is_success: int -> bool
+val is_redirection: int -> bool
+val is_client_error: int -> bool
+val is_server_error: int -> bool
+val is_error: int -> bool
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+open Neturl;;
+open Printf;;
+
+let debug = false
+let debug_print str =
+ prerr_endline ("DEBUG: " ^ str);
+ flush stderr
+
+let default_addr = "0.0.0.0"
+let default_port = 80
+let default_timeout = 300
+
+(*
+type url_syntax_option =
+ Url_part_not_recognized
+ | Url_part_allowed
+ | Url_part_required
+
+* (1) scheme://user:password@host:port/path;params?query#fragment
+*)
+
+let request_uri_syntax = {
+ url_enable_scheme = Url_part_not_recognized;
+ url_enable_user = Url_part_not_recognized;
+ url_enable_password = Url_part_not_recognized;
+ url_enable_host = Url_part_not_recognized;
+ url_enable_port = Url_part_not_recognized;
+ url_enable_path = Url_part_required;
+ url_enable_param = Url_part_not_recognized;
+ url_enable_query = Url_part_allowed;
+ url_enable_fragment = Url_part_not_recognized;
+ url_enable_other = Url_part_not_recognized;
+ url_accepts_8bits = false;
+ url_is_valid = (fun _ -> true);
+}
+
+let crlf = "\r\n"
+
+exception Malformed_request of string
+exception Unsupported_method of string
+exception Malformed_request_URI of string
+exception Unsupported_HTTP_version of string
+exception Malformed_query of string
+exception Malformed_query_binding of string * string
+
+ (** given a list of length 2
+ @return a pair formed by the elements of the list
+ @raise Assert_failure if the list length isn't 2
+ *)
+let pair_of_2_sized_list = function
+ | [a;b] -> (a,b)
+ | _ -> assert false
+
+ (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...")
+ @return a list of pairs [("name1", "value1"); ("name2", "value2")]
+ @raise Malformed_query if the string isn't a valid query string
+ @raise Malformed_query_binding if some piece of the query isn't valid
+ *)
+let split_query_params =
+ let (bindings_sep, binding_sep) = (Pcre.regexp "&", Pcre.regexp "=") in
+ fun ~query ->
+ let bindings = Pcre.split ~rex:bindings_sep query in
+ if List.length bindings < 1 then
+ raise (Malformed_query query);
+ List.map
+ (fun binding ->
+ let pieces = Pcre.split ~rex:binding_sep binding in
+ if List.length pieces <> 2 then
+ raise (Malformed_query_binding (binding, query));
+ pair_of_2_sized_list pieces)
+ bindings
+
+ (** given an input channel and a separator
+ @return a line read from it (like Pervasives.input_line)
+ line is returned only after reading a separator string; separator string isn't
+ included in the returned value
+ FIXME what about efficiency?, input is performed char-by-char
+ *)
+let generic_input_line ~sep ~ic =
+ let sep_len = String.length sep in
+ if sep_len < 1 then
+ failwith ("Separator '" ^ sep ^ "' is too short!")
+ else (* valid separator *)
+ let line = ref "" in
+ let sep_pointer = ref 0 in
+ try
+ while true do
+ if !sep_pointer >= String.length sep then (* line completed *)
+ raise End_of_file
+ else begin (* incomplete line: need to read more *)
+ let ch = input_char ic in
+ if ch = String.get sep !sep_pointer then (* next piece of sep *)
+ incr sep_pointer
+ else begin (* useful char *)
+ for i = 0 to !sep_pointer - 1 do
+ line := !line ^ (String.make 1 (String.get sep i))
+ done;
+ sep_pointer := 0;
+ line := !line ^ (String.make 1 ch)
+ end
+ end
+ done;
+ assert false (* unreacheable statement *)
+ with End_of_file ->
+ if !line = "" then
+ raise End_of_file
+ else
+ !line
+
+ (** given an input channel, reads from it a GET HTTP request and
+ @return a pair <path, query_params> where path is a string representing the
+ requested path and query_params is a list of pairs <name, value> (the GET
+ parameters)
+ *)
+let parse_http_request =
+ let patch_empty_path s = (if s = "" then "/" else s) in
+ let pieces_sep = Pcre.regexp " " in
+ fun ~ic ->
+ let request_line = generic_input_line ~sep:crlf ~ic in
+ if debug then
+ debug_print ("request_line: '" ^ request_line ^ "'");
+ match Pcre.split ~rex:pieces_sep request_line with
+ | [meth; request_uri_raw; http_version] ->
+ if meth <> "GET" then
+ raise (Unsupported_method meth);
+ (match http_version with
+ | "HTTP/1.0" | "HTTP/1.1" -> ()
+ | _ -> raise (Unsupported_HTTP_version http_version));
+ let request_uri =
+ try
+ url_of_string request_uri_syntax request_uri_raw
+ with Malformed_URL ->
+ raise (Malformed_request_URI request_uri_raw)
+ in
+ let path =
+ patch_empty_path (String.concat "/" (url_path request_uri))
+ in
+ let query_params =
+ try split_query_params (url_query request_uri) with Not_found -> []
+ in
+ (path, query_params)
+ | _ -> raise (Malformed_request request_line)
+
+ (** send raw data on outchan, flushing it afterwards *)
+let send_raw ~data outchan =
+ output_string outchan data;
+ flush outchan
+
+let send_CRLF = send_raw ~data:crlf
+
+ (** TODO perform some sanity test on header and value *)
+let send_header ~header ~value = send_raw ~data:(header ^ ": " ^ value ^ crlf)
+
+let send_headers ~headers outchan =
+ List.iter (fun (header, value) -> send_header ~header ~value outchan) headers
+
+ (** internal: parse a code argument from a function which have two optional
+ arguments "code" and "status" *)
+let get_code_argument func_name =
+ fun ~code ~status ->
+ (match code, status with
+ | Some c, None -> c
+ | None, Some s -> Http_common.code_of_status s
+ | Some _, Some _ ->
+ failwith (func_name ^ " you must give 'code' or 'status', not both")
+ | None, None ->
+ failwith (func_name ^ " you must give 'code' or 'status', not none"))
+
+ (** internal: low level for send_status_line *)
+let send_status_line' ~version ~code =
+ let status_line =
+ String.concat
+ " "
+ [ Http_common.string_of_version version;
+ string_of_int code;
+ Http_common.reason_phrase_of_code code ]
+ in
+ send_raw ~data:(status_line ^ crlf)
+
+let send_status_line
+ ?(version = Http_common.http_version) ?code ?status outchan
+ =
+ send_status_line'
+ ~version
+ ~code:(get_code_argument "Daemon.send_status_line" ~code ~status)
+ outchan
+
+let send_basic_headers
+ ?(version = Http_common.http_version) ?code ?status outchan
+ =
+ send_status_line'
+ ~version ~code:(get_code_argument "Daemon.send_basic_headers" ~code ~status)
+ outchan;
+ send_headers
+ ~headers:["Date", Http_misc.date_822 (); "Server", "OCaml HTTP Daemon"]
+ outchan
+
+ (** internal: send a fooish body explaining in HTML form the 'reason phrase'
+ of an HTTP response; body, if given, will be appended to the body *)
+let send_foo_body ~code ~body =
+ let reason_phrase = Http_common.reason_phrase_of_code code in
+ let body =
+ sprintf
+"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<HTML><HEAD>
+<TITLE>%d %s</TITLE>
+</HEAD><BODY>
+<H1>%d - %s</H1>%s
+</BODY></HTML>"
+ code reason_phrase code reason_phrase
+ (match body with None -> "" | Some text -> "\n" ^ text)
+ in
+ send_raw ~data:body
+
+ (** internal: low level for respond_redirect, respond_error, ...
+ This function send a status line corresponding to a given code, some basic
+ headers, the additional headers (if given) and an HTML page containing the
+ reason phrase; if body is given it will be included in the body of the HTML
+ page *)
+let send_empty_response
+ f_name ?(is_valid_status = fun _ -> true) ?(headers = []) ~body () =
+ fun ?(version = Http_common.http_version) ?code ?status outchan ->
+ let code = get_code_argument f_name ~code ~status in
+ if not (is_valid_status code) then
+ failwith (sprintf "'%d' isn't a valid status code for %s" code f_name)
+ else begin (* status code suitable for answering *)
+ send_basic_headers ~version ~code outchan;
+ send_header ~header:"Connection" ~value:"close" outchan;
+ send_header
+ ~header:"Content-Type"
+ ~value:"text/html; charset=iso-8859-1"
+ outchan;
+ send_headers ~headers outchan;
+ send_CRLF outchan;
+ send_foo_body ~code ~body outchan
+ end
+
+ (* TODO sanity tests on location *)
+let respond_redirect
+ ~location ?body
+ ?(version = Http_common.http_version) ?(code = 301) ?status outchan =
+ let code =
+ match status with
+ | None -> code
+ | Some (s: Http_types.redirection_status) -> Http_common.code_of_status s
+ in
+ send_empty_response
+ "Daemon.respond_redirect" ~is_valid_status:Http_common.is_redirection
+ ~headers:["Location", location] ~body ()
+ ~version ~code outchan
+
+let respond_error
+ ?body
+ ?(version = Http_common.http_version) ?(code = 400) ?status outchan =
+ let code =
+ match status with
+ | None -> code
+ | Some s -> Http_common.code_of_status s
+ in
+ send_empty_response
+ "Daemon.respond_error" ~is_valid_status:Http_common.is_error ~body ()
+ ~version ~code outchan
+
+let respond_not_found ~url ?(version = Http_common.http_version) outchan =
+ send_empty_response
+ "Daemon.respond_not_found" ~body:None ()
+ ~version ~code:404 outchan
+
+let respond_forbidden ~url ?(version = Http_common.http_version) outchan =
+ send_empty_response
+ "Daemon.respond_permission_denied" ~body:None ()
+ ~version ~code:403 outchan
+
+let send_file ?name ?file outchan =
+ let buflen = 1024 in
+ let buf = String.make buflen ' ' in
+ let (file, cleanup) =
+ (match (name, file) with
+ | Some n, None -> (* if we open the file, we close it before returning *)
+ let f = open_in n in
+ f, (fun () -> close_in f)
+ | None, Some f -> (f, (fun () -> ()))
+ | _ -> failwith "Daemon.send_file: either name or file must be given")
+ in
+ try
+ while true do
+ let bytes = input file buf 0 buflen in
+ if bytes = 0 then
+ raise End_of_file
+ else
+ output outchan buf 0 bytes
+ done;
+ assert false
+ with End_of_file ->
+ begin
+ flush outchan;
+ cleanup ()
+ end
+
+ (* TODO interface is too ugly to advertise this function in .mli *)
+ (** create a minimal HTML directory listing of a given directory and send it
+ over an out_channel, directory is passed as a dir_handle; name is the
+ directory name, used for pretty printing purposes; path is the opened dir
+ path, used to test its contents with stat *)
+let send_dir_listing ~dir ~name ~path outchan =
+ fprintf outchan "<html>\n<head><title>%s</title></head>\n<body>\n" name;
+ let (dirs, files) =
+ List.partition (fun e -> Http_misc.is_directory (path ^ e)) (Http_misc.ls dir)
+ in
+ List.iter
+ (fun d -> fprintf outchan "<a href=\"%s/\">%s/</a><br />\n" d d)
+ (List.sort compare dirs);
+ List.iter
+ (fun f -> fprintf outchan "<a href=\"%s\">%s</a><br />\n" f f)
+ (List.sort compare files);
+ fprintf outchan "</body>\n</html>";
+ flush outchan
+
+let respond_file ~fname ?(version = Http_common.http_version) outchan =
+ (** ASSUMPTION: 'fname' doesn't begin with a "/"; it's relative to the current
+ document root (usually the daemon's cwd) *)
+ let droot = Sys.getcwd () in (* document root *)
+ let path = droot ^ "/" ^ fname in (* full path to the desired file *)
+ if not (Sys.file_exists path) then (* file not found *)
+ respond_not_found ~url:fname outchan
+ else begin
+ try
+ if Http_misc.is_directory path then begin (* file found, is a dir *)
+ let dir = Unix.opendir path in
+ send_basic_headers ~version ~code:200 outchan;
+ send_header "Content-Type" "text/html" outchan;
+ send_CRLF outchan;
+ send_dir_listing ~dir ~name:fname ~path outchan;
+ Unix.closedir dir
+ end else begin (* file found, is something else *)
+ let file = open_in fname in
+ send_basic_headers ~version ~code:200 outchan;
+ send_header
+ ~header:"Content-Length"
+ ~value:(string_of_int (Http_misc.filesize fname))
+ outchan;
+ send_CRLF outchan;
+ send_file ~file outchan;
+ close_in file
+ end
+ with
+ | Unix.Unix_error (Unix.EACCES, s, _) when (s = fname) ->
+ respond_forbidden ~url:fname ~version outchan
+ | Sys_error s when
+ (Pcre.pmatch ~rex:(Pcre.regexp (fname ^ ": Permission denied")) s) ->
+ respond_forbidden ~url:fname ~version outchan
+ end
+
+let respond_with (res: Http_types.response) outchan =
+ res#serialize outchan;
+ flush outchan
+
+let start
+ ?(addr = default_addr) ?(port = default_port)
+ ?(timeout = Some default_timeout)
+ callback
+ =
+ let sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port) in
+ let timeout_callback signo =
+ if signo = Sys.sigalrm then begin
+ debug_print "TIMEOUT, exiting ...";
+ exit 2
+ end
+ in
+ let daemon_callback inchan outchan =
+ (match timeout with
+ | Some timeout ->
+ ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback));
+ ignore (Unix.alarm timeout)
+ | None -> ());
+ try
+ let (path, parameters) = parse_http_request inchan in
+ callback path parameters outchan;
+ flush outchan
+ with
+ | End_of_file ->
+ respond_error ~code:400 ~body:"Unexpected End Of File" outchan
+ | Malformed_request req ->
+ respond_error
+ ~code:400
+ ~body:(
+ "request 1st line format should be: '<method> <url> <version>'" ^
+ "<br />\nwhile received request 1st line was:<br />\n" ^ req)
+ outchan
+ | Unsupported_method meth ->
+ respond_error
+ ~code:501
+ ~body:("Method '" ^ meth ^ "' isn't supported (yet)")
+ outchan
+ | Malformed_request_URI uri ->
+ respond_error ~code:400 ~body:("Malformed URL: '" ^ uri ^ "'") outchan
+ | Unsupported_HTTP_version version ->
+ respond_error
+ ~code:505
+ ~body:("HTTP version '" ^ version ^ "' isn't supported (yet)")
+ outchan
+ | Malformed_query query ->
+ respond_error
+ ~code:400 ~body:("Malformed query string '" ^ query ^ "'") outchan
+ | Malformed_query_binding (binding, query) ->
+ respond_error
+ ~code:400
+ ~body:(
+ sprintf "Malformed query element '%s' in query '%s'" binding query)
+ outchan
+ in
+ Unix.establish_server daemon_callback sockaddr
+
+let start'
+ ?(addr = default_addr) ?(port = default_port)
+ ?(timeout = Some default_timeout)
+ (callback: (Http_types.request -> out_channel -> unit))
+ =
+ let wrapper path params outchan =
+ let req = new Http_request.request ~path ~params in
+ callback req outchan
+ in
+ start ~addr ~port ~timeout wrapper
+
+module Trivial =
+ struct
+ let callback path _ outchan =
+ if not (Pcre.pmatch ~rex:(Pcre.regexp "^/") path) then
+ respond_error ~code:400 outchan
+ else
+ respond_file ~fname:(Http_misc.strip_heading_slash path) outchan
+ let start ?(addr = default_addr) ?(port = default_port) () =
+ start ~addr ~port callback
+ end
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+ (** send a CRLF sequence on the given output channel, this is mandatory after
+ the last header was sent and before start sending the response body *)
+val send_CRLF: out_channel -> unit
+
+ (** send response status line, version is the http version used in response,
+ either code or status must be given (not both, not none) which represent the
+ HTTP response code, outchan is the output channel to which send status line *)
+val send_status_line:
+ ?version: Http_types.version -> ?code: int -> ?status: Http_types.status ->
+ out_channel ->
+ unit
+
+ (** like send_status_line but additionally will also send "Date" and "Server"
+ standard headers *)
+val send_basic_headers:
+ ?version: Http_types.version -> ?code: int -> ?status: Http_types.status ->
+ out_channel ->
+ unit
+
+ (** send an HTTP header on outchan *)
+val send_header: header: string -> value: string -> out_channel -> unit
+
+ (** as send_header, but for a list of pairs <header, value> *)
+val send_headers: headers:(string * string) list -> out_channel -> unit
+
+ (** send a file through an out_channel, file can be passed as an in_channel
+ (if 'file' is given) or as a file name (if 'name' is given) *)
+val send_file: ?name:string -> ?file:in_channel -> out_channel -> unit
+
+ (** send a 404 (not found) HTTP response *)
+val respond_not_found:
+ url:string -> ?version: Http_types.version -> out_channel -> unit
+
+ (** send a 403 (forbidden) HTTP response *)
+val respond_forbidden:
+ url:string -> ?version: Http_types.version -> out_channel -> unit
+
+ (** send a "redirection" class response, optional body argument contains data
+ that will be displayed in the body of the response, default response status is
+ 302 (moved permanently), only redirection status are accepted by this
+ function, other values will @raise Failure *)
+val respond_redirect:
+ location:string -> ?body:string ->
+ ?version: Http_types.version ->
+ ?code: int -> ?status: Http_types.redirection_status ->
+ out_channel ->
+ unit
+
+ (** send an "error" response (i.e. 400 <= status < 600), optional body
+ argument as per send_redirect, default response status is 400 (bad request),
+ only error status are accepted by this function, other values will
+ @raise Failure *)
+val respond_error:
+ ?body:string ->
+ ?version: Http_types.version ->
+ ?code: int -> ?status: Http_types.error_status ->
+ out_channel ->
+ unit
+
+ (** tipical static pages http daemon behaviour, if requested url is a file,
+ return it, it it is a directory return a directory listing of it *)
+val respond_file:
+ fname:string -> ?version: Http_types.version -> out_channel -> unit
+
+ (** respond using a prebuilt Http_types.response object *)
+val respond_with: Http_types.response -> out_channel -> unit
+
+ (** create an HTTP daemon listening on 'addr':'port' (defaults are
+ addr:"0.0.0.0" and port:80), callback is the user supplied function which
+ receive as a first parameter the path required by the the HTTP client as a
+ string, and a list of pair <parameter, value> representing parameters passed
+ via GET. The last argument of the callback is an output_channel connected to
+ the HTTP client to which the user can write directly. 'timeout' parameter
+ sets a timeout for each request processed by the daemon, if it's set to None,
+ daemon waits forever for completed requests (use with care!), default is 5
+ minute *)
+val start:
+ ?addr: string -> ?port: int -> ?timeout: int option ->
+ (string -> (string * string) list -> out_channel -> unit) ->
+ unit
+
+ (** identical to 'start' above but callback receive two arguments, the second
+ one is an out_channel as per 'start', but the secondo one is a Request.request
+ object *)
+val start':
+ ?addr: string -> ?port: int -> ?timeout: int option ->
+ (Http_types.request -> out_channel -> unit) ->
+ unit
+
+ (** Trivial static pages HTTP daemon *)
+module Trivial :
+ sig
+ val callback : string -> 'a -> out_channel -> unit
+ val start : ?addr:string -> ?port:int -> unit -> unit
+ end
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+let date_822 () =
+ Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ())
+
+let is_directory name =
+ match Unix.lstat name with
+ | { Unix.st_kind = Unix.S_DIR } -> true
+ | _ -> false
+
+let filesize fname = (Unix.stat fname).Unix.st_size
+
+let strip_trailing_slash =
+ let rex = Pcre.regexp "/$" in
+ fun s -> Pcre.replace ~rex ~templ:"" s
+
+let strip_heading_slash =
+ let rex = Pcre.regexp "^/" in
+ fun s -> Pcre.replace ~rex ~templ:"" s
+
+let ls dir =
+ let rec ls' entries =
+ try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries
+ in
+ ls' []
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+ (** @return the current date compliant to RFC 1123, which updates RFC 822
+ zone info are retrieved from UTC *)
+val date_822: unit -> string
+
+ (** @return true if 'name' is a directory on the file system, false otherwise
+ *)
+val is_directory: string -> bool
+
+ (** @return the filesize of fname *)
+val filesize: string -> int
+
+ (** strip trailing '/', if any, from a string and @return the new string *)
+val strip_trailing_slash: string -> string
+
+ (** strip heading '/', if any, from a string and @return the new string *)
+val strip_heading_slash: string -> string
+
+ (** given a dir handle @return a list of entries contained *)
+val ls: Unix.dir_handle -> string list
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+open Http_common;;
+
+exception Param_not_found of string
+
+class request ~path ~params =
+ object (self)
+ val params_tbl =
+ let tbl = Hashtbl.create (List.length params) in
+ List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
+ tbl
+ val uri =
+ path ^ "?" ^
+ (String.concat "&" (List.map (fun (n, v) -> n ^ "=" ^ v) params))
+ method uri = uri
+ method path = path
+ method param name =
+ try
+ Hashtbl.find params_tbl name
+ with Not_found ->
+ raise (Param_not_found name)
+ method params = params
+ end
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+exception Param_not_found of string
+
+ (** fooish class to enclose callback's arguments *)
+class request:
+ path: string -> params: (string * string) list -> Http_types.request
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+open Http_common;;
+open Http_daemon;;
+
+exception Invalid_status_line of string
+exception Header_not_found of string
+
+ (* TODO sanity checks on set* methods' arguments (e.g. dates 822 compliant,
+ code values < 600, ...) *)
+class response =
+ let default_code = 200 in
+ (* remove all bindings of 'name' from hashtbl 'tbl' *)
+ let rec hashtbl_remove_all tbl name =
+ if not (Hashtbl.mem tbl name) then
+ raise (Header_not_found name);
+ Hashtbl.remove tbl name;
+ if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
+ in
+ (* "version code reason_phrase" *)
+ let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
+ object (self)
+ val mutable version = Http_common.http_version
+ val mutable code = default_code val mutable reason: string option = None
+ val contentsBuf = Buffer.create 1024
+ val headers = Hashtbl.create 11
+
+ method version = version
+ method setVersion v = version <- v
+
+ method code = code
+ method setCode c = code <- c
+ method status = status_of_code code
+ method setStatus (s: Http_types.status) = code <- code_of_status s
+ method reason =
+ match reason with
+ | None -> reason_phrase_of_code code
+ | Some r -> r
+ method setReason r = reason <- Some r
+ method statusLine =
+ String.concat
+ " "
+ [string_of_version self#version; string_of_int self#code; self#reason]
+ method setStatusLine s =
+ try
+ let subs = Pcre.extract ~rex:status_line_re s in
+ self#setVersion (Http_common.version_of_string subs.(1));
+ self#setCode (int_of_string subs.(2));
+ self#setReason subs.(3)
+ with Not_found ->
+ raise (Invalid_status_line s)
+
+ method isInformational = is_informational code
+ method isSuccess = is_success code
+ method isRedirection = is_redirection code
+ method isClientError = is_client_error code
+ method isServerError = is_server_error code
+ method isError = is_error code
+
+ method contents = Buffer.contents contentsBuf
+ method setContents c =
+ Buffer.clear contentsBuf;
+ Buffer.add_string contentsBuf c
+ method contentsBuf = contentsBuf
+ method setContentsBuf b =
+ Buffer.clear contentsBuf;
+ Buffer.add_buffer contentsBuf b
+ method addContents s = Buffer.add_string contentsBuf s
+ method addContentsBuf b = Buffer.add_buffer contentsBuf b
+
+ (** adds an header named 'name' with value 'value', if an header with the
+ same name exists, the new value is considered an addition to the header as
+ specified in RFC 2616, thus getting value for this header will return a
+ comma separated list of values provided via 'addHeader' *)
+ method addHeader ~name ~value = Hashtbl.add headers name value
+ (** set the value of header 'name' to 'value', removing all previous
+ values if any *)
+ method replaceHeader ~name ~value = Hashtbl.replace headers name value
+ (** remove the header named 'name', please note that this remove all
+ values provided for this header *)
+ method removeHeader ~name = hashtbl_remove_all headers name
+ method hasHeader ~name = Hashtbl.mem headers name
+ (** @return value of header 'name', if multiple values were provided for
+ header 'name', the return value will be a comma separated list of
+ provided values as stated in RFC 2616 *)
+ method header ~name =
+ if not (self#hasHeader name) then
+ raise (Header_not_found name);
+ String.concat ", " (List.rev (Hashtbl.find_all headers name))
+ (** @return all headers as a list of pairs <name, value> *)
+ method headers =
+ List.rev
+ (Hashtbl.fold
+ (fun name _ headers -> (name, self#header ~name)::headers)
+ headers
+ [])
+
+ method contentType = self#header "Content-Type"
+ method setContentType t = self#replaceHeader "Content-Type" t
+ method contentEncoding = self#header "Content-Encoding"
+ method setContentEncoding e = self#replaceHeader "Content-Encoding" e
+ method date = self#header "Date"
+ method setDate d = self#replaceHeader "Date" d
+ method expires = self#header "Expires"
+ method setExpires t = self#replaceHeader "Expires" t
+ method server = self#header "Server"
+ method setServer s = self#replaceHeader "Server" s
+
+ method serialize outchan =
+ output_string outchan self#statusLine;
+ send_CRLF outchan;
+ send_headers self#headers outchan;
+ send_CRLF outchan;
+ Buffer.output_buffer outchan contentsBuf;
+ flush outchan
+
+ end
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+exception Invalid_status_line of string
+
+class response: Http_types.response
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+type version =
+ [ `HTTP_1_0
+ | `HTTP_1_1
+ ]
+
+type meth = [ `GET ]
+
+type informational_substatus =
+ [ `Continue
+ | `Switching_protocols
+ ]
+
+type success_substatus =
+ [ `OK
+ | `Created
+ | `Accepted
+ | `Non_authoritative_information
+ | `No_content
+ | `Reset_content
+ | `Partial_content
+ ]
+
+type redirection_substatus =
+ [ `Multiple_choices
+ | `Moved_permanently
+ | `Found
+ | `See_other
+ | `Not_modified
+ | `Use_proxy
+ | `Temporary_redirect
+ ]
+
+type client_error_substatus =
+ [ `Bad_request
+ | `Unauthorized
+ | `Payment_required
+ | `Forbidden
+ | `Not_found
+ | `Method_not_allowed
+ | `Not_acceptable
+ | `Proxy_authentication_required
+ | `Request_time_out
+ | `Conflict
+ | `Gone
+ | `Length_required
+ | `Precondition_failed
+ | `Request_entity_too_large
+ | `Request_URI_too_large
+ | `Unsupported_media_type
+ | `Requested_range_not_satisfiable
+ | `Expectation_failed
+ ]
+
+type server_error_substatus =
+ [ `Internal_server_error
+ | `Not_implemented
+ | `Bad_gateway
+ | `Service_unavailable
+ | `Gateway_time_out
+ | `HTTP_version_not_supported
+ ]
+
+type informational_status = [ `Informational of informational_substatus ]
+type success_status = [ `Success of success_substatus ]
+type redirection_status = [ `Redirection of redirection_substatus ]
+type client_error_status = [ `Client_error of client_error_substatus ]
+type server_error_status = [ `Server_error of server_error_substatus ]
+
+type error_status =
+ [ client_error_status
+ | server_error_status
+ ]
+
+type status =
+ [ informational_status
+ | success_status
+ | redirection_status
+ | client_error_status
+ | server_error_status
+ ]
+
+class type response =
+ object
+ method version: version
+ method setVersion: version -> unit
+ method code: int
+ method setCode: int -> unit
+ method status: status
+ method setStatus: status -> unit
+ method reason: string
+ method setReason: string -> unit
+ method statusLine: string
+ method setStatusLine: string -> unit
+ method isInformational: bool
+ method isSuccess: bool
+ method isRedirection: bool
+ method isClientError: bool
+ method isServerError: bool
+ method isError: bool
+ method contents: string
+ method setContents: string -> unit
+ method contentsBuf: Buffer.t
+ method setContentsBuf: Buffer.t -> unit
+ method addContents: string -> unit
+ method addContentsBuf: Buffer.t -> unit
+ method addHeader: name:string -> value:string -> unit
+ method replaceHeader: name:string -> value:string -> unit
+ method removeHeader: name:string -> unit
+ method hasHeader: name:string -> bool
+ method header: name:string -> string
+ method headers: (string * string) list
+ method contentType: string
+ method setContentType: string -> unit
+ method contentEncoding: string
+ method setContentEncoding: string -> unit
+ method date: string
+ method setDate: string -> unit
+ method expires: string
+ method setExpires: string -> unit
+ method server: string
+ method setServer: string -> unit
+ method serialize: out_channel -> unit
+ end
+class type request =
+ object
+ method uri: string
+ method path: string
+ method param: string -> string
+ method params: (string * string) list
+ end
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-let date_822 () =
- Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ())
-
-let is_directory name =
- match Unix.lstat name with
- | { Unix.st_kind = Unix.S_DIR } -> true
- | _ -> false
-
-let filesize fname = (Unix.stat fname).Unix.st_size
-
-let strip_trailing_slash =
- let rex = Pcre.regexp "/$" in
- fun s -> Pcre.replace ~rex ~templ:"" s
-
-let strip_heading_slash =
- let rex = Pcre.regexp "^/" in
- fun s -> Pcre.replace ~rex ~templ:"" s
-
-let ls dir =
- let rec ls' entries =
- try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries
- in
- ls' []
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
- (** @return the current date compliant to RFC 1123, which updates RFC 822
- zone info are retrieved from UTC *)
-val date_822: unit -> string
-
- (** @return true if 'name' is a directory on the file system, false otherwise
- *)
-val is_directory: string -> bool
-
- (** @return the filesize of fname *)
-val filesize: string -> int
-
- (** strip trailing '/', if any, from a string and @return the new string *)
-val strip_trailing_slash: string -> string
-
- (** strip heading '/', if any, from a string and @return the new string *)
-val strip_heading_slash: string -> string
-
- (** given a dir handle @return a list of entries contained *)
-val ls: Unix.dir_handle -> string list
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Common;;
-
-exception Param_not_found of string
-
-class request ~path ~params =
- object (self)
- val params_tbl =
- let tbl = Hashtbl.create (List.length params) in
- List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
- tbl
- val uri =
- path ^ "?" ^
- (String.concat "&" (List.map (fun (n, v) -> n ^ "=" ^ v) params))
- method uri = uri
- method path = path
- method param name =
- try
- Hashtbl.find params_tbl name
- with Not_found ->
- raise (Param_not_found name)
- method params = params
- end
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-exception Param_not_found of string
-
- (** fooish class to enclose callback's arguments *)
-class request: path: string -> params: (string * string) list -> Types.request
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-open Common;;
-open Daemon;;
-
-exception Invalid_status_line of string
-exception Header_not_found of string
-
- (* TODO sanity checks on set* methods' arguments (e.g. dates 822 compliant,
- code values < 600, ...) *)
-class response =
- let default_code = 200 in
- (* remove all bindings of 'name' from hashtbl 'tbl' *)
- let rec hashtbl_remove_all tbl name =
- if not (Hashtbl.mem tbl name) then
- raise (Header_not_found name);
- Hashtbl.remove tbl name;
- if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
- in
- (* "version code reason_phrase" *)
- let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
- object (self)
- val mutable version = Common.http_version
- val mutable code = default_code val mutable reason: string option = None
- val contentsBuf = Buffer.create 1024
- val headers = Hashtbl.create 11
-
- method version = version
- method setVersion v = version <- v
-
- method code = code
- method setCode c = code <- c
- method status = status_of_code code
- method setStatus (s: Types.status) = code <- code_of_status s
- method reason =
- match reason with
- | None -> reason_phrase_of_code code
- | Some r -> r
- method setReason r = reason <- Some r
- method statusLine =
- String.concat
- " "
- [string_of_version self#version; string_of_int self#code; self#reason]
- method setStatusLine s =
- try
- let subs = Pcre.extract ~rex:status_line_re s in
- self#setVersion (Common.version_of_string subs.(1));
- self#setCode (int_of_string subs.(2));
- self#setReason subs.(3)
- with Not_found ->
- raise (Invalid_status_line s)
-
- method isInformational = is_informational code
- method isSuccess = is_success code
- method isRedirection = is_redirection code
- method isClientError = is_client_error code
- method isServerError = is_server_error code
- method isError = is_error code
-
- method contents = Buffer.contents contentsBuf
- method setContents c =
- Buffer.clear contentsBuf;
- Buffer.add_string contentsBuf c
- method contentsBuf = contentsBuf
- method setContentsBuf b =
- Buffer.clear contentsBuf;
- Buffer.add_buffer contentsBuf b
- method addContents s = Buffer.add_string contentsBuf s
- method addContentsBuf b = Buffer.add_buffer contentsBuf b
-
- (** adds an header named 'name' with value 'value', if an header with the
- same name exists, the new value is considered an addition to the header as
- specified in RFC 2616, thus getting value for this header will return a
- comma separated list of values provided via 'addHeader' *)
- method addHeader ~name ~value = Hashtbl.add headers name value
- (** set the value of header 'name' to 'value', removing all previous
- values if any *)
- method replaceHeader ~name ~value = Hashtbl.replace headers name value
- (** remove the header named 'name', please note that this remove all
- values provided for this header *)
- method removeHeader ~name = hashtbl_remove_all headers name
- method hasHeader ~name = Hashtbl.mem headers name
- (** @return value of header 'name', if multiple values were provided for
- header 'name', the return value will be a comma separated list of
- provided values as stated in RFC 2616 *)
- method header ~name =
- if not (self#hasHeader name) then
- raise (Header_not_found name);
- String.concat ", " (List.rev (Hashtbl.find_all headers name))
- (** @return all headers as a list of pairs <name, value> *)
- method headers =
- List.rev
- (Hashtbl.fold
- (fun name _ headers -> (name, self#header ~name)::headers)
- headers
- [])
-
- method contentType = self#header "Content-Type"
- method setContentType t = self#replaceHeader "Content-Type" t
- method contentEncoding = self#header "Content-Encoding"
- method setContentEncoding e = self#replaceHeader "Content-Encoding" e
- method date = self#header "Date"
- method setDate d = self#replaceHeader "Date" d
- method expires = self#header "Expires"
- method setExpires t = self#replaceHeader "Expires" t
- method server = self#header "Server"
- method setServer s = self#replaceHeader "Server" s
-
- method serialize outchan =
- output_string outchan self#statusLine;
- send_CRLF outchan;
- send_headers self#headers outchan;
- send_CRLF outchan;
- Buffer.output_buffer outchan contentsBuf;
- flush outchan
-
- end
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-exception Invalid_status_line of string
-
-class response: Types.response
-
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-type version =
- [ `HTTP_1_0
- | `HTTP_1_1
- ]
-
-type meth = [ `GET ]
-
-type informational_substatus =
- [ `Continue
- | `Switching_protocols
- ]
-
-type success_substatus =
- [ `OK
- | `Created
- | `Accepted
- | `Non_authoritative_information
- | `No_content
- | `Reset_content
- | `Partial_content
- ]
-
-type redirection_substatus =
- [ `Multiple_choices
- | `Moved_permanently
- | `Found
- | `See_other
- | `Not_modified
- | `Use_proxy
- | `Temporary_redirect
- ]
-
-type client_error_substatus =
- [ `Bad_request
- | `Unauthorized
- | `Payment_required
- | `Forbidden
- | `Not_found
- | `Method_not_allowed
- | `Not_acceptable
- | `Proxy_authentication_required
- | `Request_time_out
- | `Conflict
- | `Gone
- | `Length_required
- | `Precondition_failed
- | `Request_entity_too_large
- | `Request_URI_too_large
- | `Unsupported_media_type
- | `Requested_range_not_satisfiable
- | `Expectation_failed
- ]
-
-type server_error_substatus =
- [ `Internal_server_error
- | `Not_implemented
- | `Bad_gateway
- | `Service_unavailable
- | `Gateway_time_out
- | `HTTP_version_not_supported
- ]
-
-type informational_status = [ `Informational of informational_substatus ]
-type success_status = [ `Success of success_substatus ]
-type redirection_status = [ `Redirection of redirection_substatus ]
-type client_error_status = [ `Client_error of client_error_substatus ]
-type server_error_status = [ `Server_error of server_error_substatus ]
-
-type error_status =
- [ client_error_status
- | server_error_status
- ]
-
-type status =
- [ informational_status
- | success_status
- | redirection_status
- | client_error_status
- | server_error_status
- ]
-
-class type response =
- object
- method version: version
- method setVersion: version -> unit
- method code: int
- method setCode: int -> unit
- method status: status
- method setStatus: status -> unit
- method reason: string
- method setReason: string -> unit
- method statusLine: string
- method setStatusLine: string -> unit
- method isInformational: bool
- method isSuccess: bool
- method isRedirection: bool
- method isClientError: bool
- method isServerError: bool
- method isError: bool
- method contents: string
- method setContents: string -> unit
- method contentsBuf: Buffer.t
- method setContentsBuf: Buffer.t -> unit
- method addContents: string -> unit
- method addContentsBuf: Buffer.t -> unit
- method addHeader: name:string -> value:string -> unit
- method replaceHeader: name:string -> value:string -> unit
- method removeHeader: name:string -> unit
- method hasHeader: name:string -> bool
- method header: name:string -> string
- method headers: (string * string) list
- method contentType: string
- method setContentType: string -> unit
- method contentEncoding: string
- method setContentEncoding: string -> unit
- method date: string
- method setDate: string -> unit
- method expires: string
- method setExpires: string -> unit
- method server: string
- method setServer: string -> unit
- method serialize: out_channel -> unit
- end
-class type request =
- object
- method uri: string
- method path: string
- method param: string -> string
- method params: (string * string) list
- end
+++ /dev/null
-
-(*
- OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
-
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-*)
-
-type version = [ `HTTP_1_0 | `HTTP_1_1 ]
-
-and meth = [ `GET ]
-
-and informational_substatus = [ `Continue | `Switching_protocols ]
-
-and success_substatus =
- [ `Accepted
- | `Created
- | `No_content
- | `Non_authoritative_information
- | `OK
- | `Partial_content
- | `Reset_content
- ]
-
-and redirection_substatus =
- [ `Found
- | `Moved_permanently
- | `Multiple_choices
- | `Not_modified
- | `See_other
- | `Temporary_redirect
- | `Use_proxy
- ]
-
-and client_error_substatus =
- [ `Bad_request
- | `Conflict
- | `Expectation_failed
- | `Forbidden
- | `Gone
- | `Length_required
- | `Method_not_allowed
- | `Not_acceptable
- | `Not_found
- | `Payment_required
- | `Precondition_failed
- | `Proxy_authentication_required
- | `Request_URI_too_large
- | `Request_entity_too_large
- | `Request_time_out
- | `Requested_range_not_satisfiable
- | `Unauthorized
- | `Unsupported_media_type
- ]
-
-and server_error_substatus =
- [ `Bad_gateway
- | `Gateway_time_out
- | `HTTP_version_not_supported
- | `Internal_server_error
- | `Not_implemented
- | `Service_unavailable
- ]
-
-and informational_status = [ `Informational of informational_substatus ]
-and success_status = [ `Success of success_substatus ]
-and redirection_status = [ `Redirection of redirection_substatus ]
-and client_error_status = [ `Client_error of client_error_substatus ]
-and server_error_status = [ `Server_error of server_error_substatus ]
-
-and error_status =
- [ `Client_error of client_error_substatus
- | `Server_error of server_error_substatus
- ]
-
-and status =
- [ `Client_error of client_error_substatus
- | `Informational of informational_substatus
- | `Redirection of redirection_substatus
- | `Server_error of server_error_substatus
- | `Success of success_substatus
- ]
-
-class type response =
- object
- method addContents : string -> unit
- method addContentsBuf : Buffer.t -> unit
- method addHeader : name:string -> value:string -> unit
- method code : int
- method contentEncoding : string
- method contentType : string
- method contents : string
- method contentsBuf : Buffer.t
- method date : string
- method expires : string
- method hasHeader : name:string -> bool
- method header : name:string -> string
- method headers : (string * string) list
- method isClientError : bool
- method isError : bool
- method isInformational : bool
- method isRedirection : bool
- method isServerError : bool
- method isSuccess : bool
- method reason : string
- method removeHeader : name:string -> unit
- method replaceHeader : name:string -> value:string -> unit
- method serialize : out_channel -> unit
- method server : string
- method setCode : int -> unit
- method setContentEncoding : string -> unit
- method setContentType : string -> unit
- method setContents : string -> unit
- method setContentsBuf : Buffer.t -> unit
- method setDate : string -> unit
- method setExpires : string -> unit
- method setReason : string -> unit
- method setServer : string -> unit
- method setStatus : status -> unit
- method setStatusLine : string -> unit
- method setVersion : version -> unit
- method status : status
- method statusLine : string
- method version : version
- end
-
-class type request =
- object
- method uri: string
- method path: string
- method param: string -> string
- method params: (string * string) list
- end
-
projects / helm.git / commitdiff