From 2f28bfb47f5fad6b3c5a705d9ede95700416dee8 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 13 Nov 2002 14:14:14 +0000 Subject: [PATCH] added ocaml-http 0.0.1 --- helm/DEVEL/ocaml-http/.depend | 16 + helm/DEVEL/ocaml-http/INSTALL | 37 ++ helm/DEVEL/ocaml-http/LICENSE | 20 + helm/DEVEL/ocaml-http/META.in | 5 + helm/DEVEL/ocaml-http/Makefile | 58 +++ helm/DEVEL/ocaml-http/Makefile.defs | 15 + helm/DEVEL/ocaml-http/README | 10 + helm/DEVEL/ocaml-http/common.ml | 193 ++++++++ helm/DEVEL/ocaml-http/common.mli | 43 ++ helm/DEVEL/ocaml-http/daemon.ml | 452 ++++++++++++++++++ helm/DEVEL/ocaml-http/daemon.mli | 114 +++++ helm/DEVEL/ocaml-http/debian/changelog | 6 + helm/DEVEL/ocaml-http/debian/control | 19 + helm/DEVEL/ocaml-http/debian/copyright | 28 ++ helm/DEVEL/ocaml-http/debian/dirs | 1 + helm/DEVEL/ocaml-http/debian/docs | 1 + helm/DEVEL/ocaml-http/debian/examples | 1 + helm/DEVEL/ocaml-http/debian/rules | 46 ++ helm/DEVEL/ocaml-http/examples/Makefile | 17 + .../ocaml-http/examples/always_ok_daemon.ml | 26 + helm/DEVEL/ocaml-http/examples/dump_args.ml | 49 ++ helm/DEVEL/ocaml-http/examples/obj_foo.ml | 25 + helm/DEVEL/ocaml-http/examples/timeout.ml | 27 ++ helm/DEVEL/ocaml-http/examples/webfsd.ml | 40 ++ helm/DEVEL/ocaml-http/misc.ml | 45 ++ helm/DEVEL/ocaml-http/misc.mli | 41 ++ helm/DEVEL/ocaml-http/request.ml | 44 ++ helm/DEVEL/ocaml-http/request.mli | 26 + helm/DEVEL/ocaml-http/response.ml | 137 ++++++ helm/DEVEL/ocaml-http/response.mli | 25 + helm/DEVEL/ocaml-http/tophttp | 5 + helm/DEVEL/ocaml-http/types.ml | 151 ++++++ helm/DEVEL/ocaml-http/types.mli | 147 ++++++ 33 files changed, 1870 insertions(+) create mode 100644 helm/DEVEL/ocaml-http/.depend create mode 100644 helm/DEVEL/ocaml-http/INSTALL create mode 100644 helm/DEVEL/ocaml-http/LICENSE create mode 100644 helm/DEVEL/ocaml-http/META.in create mode 100644 helm/DEVEL/ocaml-http/Makefile create mode 100644 helm/DEVEL/ocaml-http/Makefile.defs create mode 100644 helm/DEVEL/ocaml-http/README create mode 100644 helm/DEVEL/ocaml-http/common.ml create mode 100644 helm/DEVEL/ocaml-http/common.mli create mode 100644 helm/DEVEL/ocaml-http/daemon.ml create mode 100644 helm/DEVEL/ocaml-http/daemon.mli create mode 100644 helm/DEVEL/ocaml-http/debian/changelog create mode 100644 helm/DEVEL/ocaml-http/debian/control create mode 100644 helm/DEVEL/ocaml-http/debian/copyright create mode 100644 helm/DEVEL/ocaml-http/debian/dirs create mode 100644 helm/DEVEL/ocaml-http/debian/docs create mode 100644 helm/DEVEL/ocaml-http/debian/examples create mode 100755 helm/DEVEL/ocaml-http/debian/rules create mode 100644 helm/DEVEL/ocaml-http/examples/Makefile create mode 100644 helm/DEVEL/ocaml-http/examples/always_ok_daemon.ml create mode 100644 helm/DEVEL/ocaml-http/examples/dump_args.ml create mode 100644 helm/DEVEL/ocaml-http/examples/obj_foo.ml create mode 100644 helm/DEVEL/ocaml-http/examples/timeout.ml create mode 100644 helm/DEVEL/ocaml-http/examples/webfsd.ml create mode 100644 helm/DEVEL/ocaml-http/misc.ml create mode 100644 helm/DEVEL/ocaml-http/misc.mli create mode 100644 helm/DEVEL/ocaml-http/request.ml create mode 100644 helm/DEVEL/ocaml-http/request.mli create mode 100644 helm/DEVEL/ocaml-http/response.ml create mode 100644 helm/DEVEL/ocaml-http/response.mli create mode 100644 helm/DEVEL/ocaml-http/tophttp create mode 100644 helm/DEVEL/ocaml-http/types.ml create mode 100644 helm/DEVEL/ocaml-http/types.mli diff --git a/helm/DEVEL/ocaml-http/.depend b/helm/DEVEL/ocaml-http/.depend new file mode 100644 index 000000000..72d1e0263 --- /dev/null +++ b/helm/DEVEL/ocaml-http/.depend @@ -0,0 +1,16 @@ +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 diff --git a/helm/DEVEL/ocaml-http/INSTALL b/helm/DEVEL/ocaml-http/INSTALL new file mode 100644 index 000000000..c98cdb44a --- /dev/null +++ b/helm/DEVEL/ocaml-http/INSTALL @@ -0,0 +1,37 @@ + +In order to build ocaml-http you will need: + + - the ocaml compiler (>= 3.06) + [ http://caml.inria.fr ] + + - findlib (>= 0.8) + [ http://www.ocaml-programming.de/packages/documentation/findlib/ ] + + - ocamlnet (>= 0.94) + [ http://sourceforge.net/projects/ocamlnet ] + + - pcre-ocaml (>= 4.28.2) + [ http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html ] + +To build the bytecode library: + + $ make all + +To build the nativecode library (only if you have an ocaml native code +compiler): + + $ make opt + +To install the built stuff in the OCaml standard library directory (as root): + + # make install + +To install the built stuff in another directory: + + $ make install DESTDIR=another_directory + +To build a debian package of the library (please note that to build a debian +package you will also need some additional stuff like debhelper, fakeroot, ...): + + $ fakeroot debian/rules binary + diff --git a/helm/DEVEL/ocaml-http/LICENSE b/helm/DEVEL/ocaml-http/LICENSE new file mode 100644 index 000000000..baff777d2 --- /dev/null +++ b/helm/DEVEL/ocaml-http/LICENSE @@ -0,0 +1,20 @@ +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 +*) + diff --git a/helm/DEVEL/ocaml-http/META.in b/helm/DEVEL/ocaml-http/META.in new file mode 100644 index 000000000..5471c4f10 --- /dev/null +++ b/helm/DEVEL/ocaml-http/META.in @@ -0,0 +1,5 @@ +description = "OCaml HTTP daemon library" +version = "@DISTVERSION@" +requires = "unix,pcre,netstring" +archive(byte) = "http.cmo" +archive(native) = "http.cmx" diff --git a/helm/DEVEL/ocaml-http/Makefile b/helm/DEVEL/ocaml-http/Makefile new file mode 100644 index 000000000..473b6b8f2 --- /dev/null +++ b/helm/DEVEL/ocaml-http/Makefile @@ -0,0 +1,58 @@ +include Makefile.defs + +MODULES = common misc types request daemon response +DESTDIR = $(shell $(OCAMLFIND) printconf stdlib) + +all: http.cmo +opt: http.cmx +world: all opt + +examples: + $(MAKE) -C examples/ +examples.opt: + $(MAKE) -C examples/ opt + +include .depend + +depend: + $(OCAMLDEP) *.ml *.mli > .depend + +%.cmi: %.mli + $(OCAMLC) -c $< +%.cmo: %.ml %.cmi + $(OCAMLC) -c $< +%.cmx: %.ml %.cmi + $(OCAMLOPT) -c $< + +http.cmo: $(patsubst %,%.cmo,$(MODULES)) + ocamlc -pack -o $@ $^ +http.cmx: $(patsubst %,%.cmx,$(MODULES)) + ocamlopt -pack -o $@ $^ + +meta: META +META: META.in + cat META.in | sed -e 's/@DISTVERSION@/$(DISTVERSION)/' > META + +clean: + $(MAKE) -C examples/ clean + -rm -f *.cm[ioax] *.o test{,.opt} +distclean: clean + $(MAKE) -C examples/ distclean + -rm -f META +dist: distclean depend + mkdir $(DISTDIR) + cp -r \ + $(patsubst %,%.ml,$(MODULES)) $(patsubst %,%.mli,$(MODULES)) \ + $(EXTRA_DIST) examples/ debian/ \ + $(DISTDIR)/ + -find $(DISTDIR)/ -type d -name CVS -exec rm -rf {} \; + -find $(DISTDIR)/ -type f -name ".cvs*" -exec rm -f {} \; + tar cvzf $(DISTDIR).tar.gz $(DISTDIR)/ + rm -rf $(DISTDIR)/ +install: META + $(OCAMLFIND) install -destdir $(DESTDIR) $(PKGNAME) META *.mli http.* + +.PHONY: \ + all opt world examples examples.opt depend clean distclean dist \ + install meta + diff --git a/helm/DEVEL/ocaml-http/Makefile.defs b/helm/DEVEL/ocaml-http/Makefile.defs new file mode 100644 index 000000000..a22325292 --- /dev/null +++ b/helm/DEVEL/ocaml-http/Makefile.defs @@ -0,0 +1,15 @@ +PKGNAME = http + +DEBUG_OPTS = +COMMON_OPTS = $(DEBUG_OPTS) -pp camlp4o -package "unix,pcre,netstring" +OCAMLFIND = ocamlfind +OCAMLC = $(OCAMLFIND) ocamlc $(COMMON_OPTS) +OCAMLOPT = $(OCAMLFIND) ocamlopt $(COMMON_OPTS) +OCAMLDEP = $(OCAMLFIND) ocamldep $(COMMON_OPTS) + +DISTNAME = ocaml-http +DISTVERSION = 0.0.1 +DISTDIR = $(DISTNAME)-$(DISTVERSION) +EXTRA_DIST = INSTALL LICENSE README META.in Makefile Makefile.defs .depend tophttp + + diff --git a/helm/DEVEL/ocaml-http/README b/helm/DEVEL/ocaml-http/README new file mode 100644 index 000000000..7d2c1a5a8 --- /dev/null +++ b/helm/DEVEL/ocaml-http/README @@ -0,0 +1,10 @@ + +ocaml-http is a simple OCaml library for creating HTTP daemons, it is largely +inspired to the Perl's HTTP:: modules family. + +Currently the library contains the following modules: + +* Http.Daemon + + this module provide + diff --git a/helm/DEVEL/ocaml-http/common.ml b/helm/DEVEL/ocaml-http/common.ml new file mode 100644 index 000000000..b175d2e38 --- /dev/null +++ b/helm/DEVEL/ocaml-http/common.ml @@ -0,0 +1,193 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/common.mli b/helm/DEVEL/ocaml-http/common.mli new file mode 100644 index 000000000..1b2874837 --- /dev/null +++ b/helm/DEVEL/ocaml-http/common.mli @@ -0,0 +1,43 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/daemon.ml b/helm/DEVEL/ocaml-http/daemon.ml new file mode 100644 index 000000000..19ba359fe --- /dev/null +++ b/helm/DEVEL/ocaml-http/daemon.ml @@ -0,0 +1,452 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 where path is a string representing the + requested path and query_params is a list of pairs (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 +" + +%d %s + +

%d - %s

%s +" + 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 "\n%s\n\n" name; + let (dirs, files) = + List.partition (fun e -> Misc.is_directory (path ^ e)) (Misc.ls dir) + in + List.iter + (fun d -> fprintf outchan "%s/
\n" d d) + (List.sort compare dirs); + List.iter + (fun f -> fprintf outchan "%s
\n" f f) + (List.sort compare files); + fprintf outchan "\n"; + 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: ' '" ^ + "
\nwhile received request 1st line was:
\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 + diff --git a/helm/DEVEL/ocaml-http/daemon.mli b/helm/DEVEL/ocaml-http/daemon.mli new file mode 100644 index 000000000..c7ffee437 --- /dev/null +++ b/helm/DEVEL/ocaml-http/daemon.mli @@ -0,0 +1,114 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 *) +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 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 + diff --git a/helm/DEVEL/ocaml-http/debian/changelog b/helm/DEVEL/ocaml-http/debian/changelog new file mode 100644 index 000000000..c2f0b0e18 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/changelog @@ -0,0 +1,6 @@ +http (0.0.1) unstable; urgency=low + + * Initial Release. + + -- Stefano Zacchiroli Wed, 13 Nov 2002 13:12:02 +0100 + diff --git a/helm/DEVEL/ocaml-http/debian/control b/helm/DEVEL/ocaml-http/debian/control new file mode 100644 index 000000000..24b4bed21 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/control @@ -0,0 +1,19 @@ +Source: http +Section: devel +Priority: optional +Maintainer: Stefano Zacchiroli +Build-Depends: debhelper (>> 4.0.0), ocaml-3.06, ocaml-findlib, libpcre-ocaml-dev, libocamlnet-ocaml-dev +Standards-Version: 3.5.7 + +Package: libhttp-ocaml-dev +Architecture: any +Depends: ocaml-3.06, libpcre-ocaml-dev, libocamlnet-ocaml-dev +Description: OCaml module to build simple HTTP servers + OCaml module to build simple HTTP server, largely inspired to Perl's + HTTP::Daemon module. + . + Contains an Http.Daemon module which allow you to create simple HTTP + servers, and a set of facility functions to handle HTTP request and + responses. + . + Contains also classes that enclose HTTP request and responses. diff --git a/helm/DEVEL/ocaml-http/debian/copyright b/helm/DEVEL/ocaml-http/debian/copyright new file mode 100644 index 000000000..508ac65d4 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/copyright @@ -0,0 +1,28 @@ +This package was debianized by Stefano Zacchiroli on +Wed, 13 Nov 2002 13:12:02 +0100. + +It was downloaded from + +Upstream Author: + Stefano Zacchiroli + +Copyright: + + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/debian/dirs b/helm/DEVEL/ocaml-http/debian/dirs new file mode 100644 index 000000000..dd25148a4 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/dirs @@ -0,0 +1 @@ +/usr/lib/ocaml diff --git a/helm/DEVEL/ocaml-http/debian/docs b/helm/DEVEL/ocaml-http/debian/docs new file mode 100644 index 000000000..e845566c0 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/docs @@ -0,0 +1 @@ +README diff --git a/helm/DEVEL/ocaml-http/debian/examples b/helm/DEVEL/ocaml-http/debian/examples new file mode 100644 index 000000000..6e72ae207 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/examples @@ -0,0 +1 @@ +examples/*.ml diff --git a/helm/DEVEL/ocaml-http/debian/rules b/helm/DEVEL/ocaml-http/debian/rules new file mode 100755 index 000000000..f5dc341f7 --- /dev/null +++ b/helm/DEVEL/ocaml-http/debian/rules @@ -0,0 +1,46 @@ +#!/usr/bin/make -f + +#export DH_VERBOSE=1 +export DH_COMPAT=4 + +TARGETDIR=$(CURDIR)/debian/libhttp-ocaml-dev + +build: build-stamp +build-stamp: + dh_testdir + $(MAKE) all + if [ -x /usr/bin/ocamlopt ]; then $(MAKE) opt; else true; fi + touch build-stamp + +clean: + dh_testdir + dh_testroot + rm -f build-stamp + -$(MAKE) distclean + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + $(MAKE) install DESTDIR=$(TARGETDIR)/usr/lib/ocaml + +binary-arch: build install + dh_testdir + dh_testroot + dh_installdocs + dh_installexamples + dh_installchangelogs + dh_link + dh_strip + dh_compress + dh_fixperms + dh_installdeb + dh_shlibdeps + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-arch +.PHONY: build clean binary-arch binary install diff --git a/helm/DEVEL/ocaml-http/examples/Makefile b/helm/DEVEL/ocaml-http/examples/Makefile new file mode 100644 index 000000000..b050bddb3 --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/Makefile @@ -0,0 +1,17 @@ +include ../Makefile.defs +OBJS = ../http.cmo +OBJS_OPT = ../http.cmx +EXAMPLES_OPTS = -I .. -linkpkg + +EXAMPLES = always_ok_daemon webfsd obj_foo dump_args timeout + +all: $(EXAMPLES) +opt: $(patsubst %,%.opt,$(EXAMPLES)) +%: %.ml $(OBJS) + $(OCAMLC) $(EXAMPLES_OPTS) $(OBJS) -o $@ $< +%.opt: %.ml $(OBJS_OPT) + $(OCAMLOPT) $(EXAMPLES_OPTS) $(OBJS_OPT) -o $@ $< + +distclean: clean +clean: + -rm -f *.cm[ioax] *.o $(EXAMPLES) diff --git a/helm/DEVEL/ocaml-http/examples/always_ok_daemon.ml b/helm/DEVEL/ocaml-http/examples/always_ok_daemon.ml new file mode 100644 index 000000000..020d4f600 --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/always_ok_daemon.ml @@ -0,0 +1,26 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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.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)) diff --git a/helm/DEVEL/ocaml-http/examples/dump_args.ml b/helm/DEVEL/ocaml-http/examples/dump_args.ml new file mode 100644 index 000000000..ba8e4f5ce --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/dump_args.ml @@ -0,0 +1,49 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 dump_args path args = + Printf.sprintf + "PATH: %s\nARGS:\n%s" + path + (String.concat + "" + (List.map + (fun (name, value) -> "\tNAME: " ^ name ^ ", VALUE: " ^ value ^ "\n") + args)) +in +let callback path args outchan = + match path with + | "/gone" -> + Http.Daemon.respond_redirect + ~location:"/foo" ~body:"REDIRECT" ~code:302 outchan + | "/error" -> + Http.Daemon.respond_error ~body:"ERROR" ~code:500 outchan + | _ -> + begin + 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 ..."; +flush stdout; +Http.Daemon.start ~addr:"127.0.0.1" ~port:9999 callback + diff --git a/helm/DEVEL/ocaml-http/examples/obj_foo.ml b/helm/DEVEL/ocaml-http/examples/obj_foo.ml new file mode 100644 index 000000000..98e024045 --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/obj_foo.ml @@ -0,0 +1,25 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 callback req outchan = + Http.Daemon.respond_error ~body:(req#param "foo") outchan +in +Http.Daemon.start' ~addr:"127.0.0.1" ~port:9999 callback diff --git a/helm/DEVEL/ocaml-http/examples/timeout.ml b/helm/DEVEL/ocaml-http/examples/timeout.ml new file mode 100644 index 000000000..56522f52d --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/timeout.ml @@ -0,0 +1,27 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 callback _ _ outchan = + output_string outchan "Here you are!\n"; + flush outchan +in +Http.Daemon.start ~addr:"127.0.0.1" ~port:9999 ~timeout:(Some 10) callback + diff --git a/helm/DEVEL/ocaml-http/examples/webfsd.ml b/helm/DEVEL/ocaml-http/examples/webfsd.ml new file mode 100644 index 000000000..ef5c1cb07 --- /dev/null +++ b/helm/DEVEL/ocaml-http/examples/webfsd.ml @@ -0,0 +1,40 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 def_port = 80 in +let def_addr = "0.0.0.0" in +let def_root = Sys.getcwd () in + +let port = ref def_port in +let addr = ref def_addr in +let root = ref def_root in +let argspec = + [ "-p", Arg.Int (fun p -> port := p), + "TCP port on which listen, default: " ^ string_of_int !port; + "-a", Arg.String (fun a -> addr := a), + "IP address on which listen, default: " ^ !addr; + "-r", Arg.String (fun r -> root := r), + "DocumentRoot, default: current working directory" ] +in +Arg.parse argspec (fun _ -> ()) ""; +Sys.chdir !root; +Http.Daemon.Trivial.start ~addr:!addr ~port:!port () + diff --git a/helm/DEVEL/ocaml-http/misc.ml b/helm/DEVEL/ocaml-http/misc.ml new file mode 100644 index 000000000..a1ea266a4 --- /dev/null +++ b/helm/DEVEL/ocaml-http/misc.ml @@ -0,0 +1,45 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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' [] + diff --git a/helm/DEVEL/ocaml-http/misc.mli b/helm/DEVEL/ocaml-http/misc.mli new file mode 100644 index 000000000..5a74fe4ff --- /dev/null +++ b/helm/DEVEL/ocaml-http/misc.mli @@ -0,0 +1,41 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/request.ml b/helm/DEVEL/ocaml-http/request.ml new file mode 100644 index 000000000..0f5681f7f --- /dev/null +++ b/helm/DEVEL/ocaml-http/request.ml @@ -0,0 +1,44 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/request.mli b/helm/DEVEL/ocaml-http/request.mli new file mode 100644 index 000000000..9f2e93656 --- /dev/null +++ b/helm/DEVEL/ocaml-http/request.mli @@ -0,0 +1,26 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/response.ml b/helm/DEVEL/ocaml-http/response.ml new file mode 100644 index 000000000..caad5ab56 --- /dev/null +++ b/helm/DEVEL/ocaml-http/response.ml @@ -0,0 +1,137 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 *) + 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 + diff --git a/helm/DEVEL/ocaml-http/response.mli b/helm/DEVEL/ocaml-http/response.mli new file mode 100644 index 000000000..84011aaba --- /dev/null +++ b/helm/DEVEL/ocaml-http/response.mli @@ -0,0 +1,25 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + diff --git a/helm/DEVEL/ocaml-http/tophttp b/helm/DEVEL/ocaml-http/tophttp new file mode 100644 index 000000000..c93a47e83 --- /dev/null +++ b/helm/DEVEL/ocaml-http/tophttp @@ -0,0 +1,5 @@ +#use "topfind";; +#require "unix";; +#require "pcre";; +#require "netstring";; +#load "http.cmo";; diff --git a/helm/DEVEL/ocaml-http/types.ml b/helm/DEVEL/ocaml-http/types.ml new file mode 100644 index 000000000..37621ef07 --- /dev/null +++ b/helm/DEVEL/ocaml-http/types.ml @@ -0,0 +1,151 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 diff --git a/helm/DEVEL/ocaml-http/types.mli b/helm/DEVEL/ocaml-http/types.mli new file mode 100644 index 000000000..aac630960 --- /dev/null +++ b/helm/DEVEL/ocaml-http/types.mli @@ -0,0 +1,147 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + 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 + -- 2.39.2