From: Stefano Zacchiroli Date: Fri, 10 Jan 2003 09:39:20 +0000 (+0000) Subject: added support for "ancient" HTTP requests like "GET /foo" X-Git-Tag: v0_3_99~41 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=3e666920212c55ad4960ee2b30335acf8eb40560;p=helm.git added support for "ancient" HTTP requests like "GET /foo" --- diff --git a/helm/DEVEL/ocaml-http/debian/changelog b/helm/DEVEL/ocaml-http/debian/changelog index e8fddf21e..cdf4c48f0 100644 --- a/helm/DEVEL/ocaml-http/debian/changelog +++ b/helm/DEVEL/ocaml-http/debian/changelog @@ -1,3 +1,11 @@ +ocaml-http (0.0.8) unstable; urgency=low + + * Added support for "ancient" HTTP requests which specify no HTTP + version + - 'version' method on message now has type 'version option' + + -- Stefano Zacchiroli Fri, 10 Jan 2003 10:36:53 +0100 + ocaml-http (0.0.7) unstable; urgency=low * Added support for POST requests diff --git a/helm/DEVEL/ocaml-http/http_message.ml b/helm/DEVEL/ocaml-http/http_message.ml index 2de1e1cbe..ad3f38b50 100644 --- a/helm/DEVEL/ocaml-http/http_message.ml +++ b/helm/DEVEL/ocaml-http/http_message.ml @@ -43,14 +43,14 @@ class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = val _contentsBuf = Buffer.create 1024 val _headers = Hashtbl.create 11 - val mutable _version: version = version + val mutable _version: version option = version initializer self#setBody body; self#addHeaders headers method version = _version - method setVersion v = _version <- v + method setVersion v = _version <- Some v method body = Buffer.contents _contentsBuf method setBody c = diff --git a/helm/DEVEL/ocaml-http/http_message.mli b/helm/DEVEL/ocaml-http/http_message.mli index e3f06f03f..9f730939b 100644 --- a/helm/DEVEL/ocaml-http/http_message.mli +++ b/helm/DEVEL/ocaml-http/http_message.mli @@ -25,11 +25,11 @@ open Http_types;; @param entity body included in the message @param headers message headers shipped with the message *) class virtual message: - body: string -> headers: (string * string) list -> version: version -> + body: string -> headers: (string * string) list -> version: version option -> clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr -> object - method version: version + method version: version option method setVersion: version -> unit method body: string diff --git a/helm/DEVEL/ocaml-http/http_parser.ml b/helm/DEVEL/ocaml-http/http_parser.ml index 52c84570c..c8870ab18 100644 --- a/helm/DEVEL/ocaml-http/http_parser.ml +++ b/helm/DEVEL/ocaml-http/http_parser.ml @@ -98,14 +98,18 @@ let debug_dump_request path params = let parse_request_fst_line ic = let request_line = generic_input_line ~sep:crlf ~ic in debug_print (sprintf "HTTP request line (not yet parsed): %s" request_line); - match Pcre.split ~rex:pieces_sep request_line with - | [ meth_raw; uri_raw; http_version_raw ] -> - (try + try + (match Pcre.split ~rex:pieces_sep request_line with + | [ meth_raw; uri_raw ] -> (* ancient HTTP request line *) (method_of_string meth_raw, (* method *) Http_parser_sanity.url_of_string uri_raw, (* uri *) - version_of_string http_version_raw) (* version *) - with Neturl.Malformed_URL -> raise (Malformed_request_URI uri_raw)) - | _ -> raise (Malformed_request request_line) + None) (* no version given *) + | [ meth_raw; uri_raw; http_version_raw ] -> (* HTTP 1.{0,1} *) + (method_of_string meth_raw, (* method *) + Http_parser_sanity.url_of_string uri_raw, (* uri *) + Some (version_of_string http_version_raw)) (* version *) + | _ -> raise (Malformed_request request_line)) + with Malformed_URL url -> raise (Malformed_request_URI url) let parse_path uri = patch_empty_path (String.concat "/" (Neturl.url_path uri)) let parse_query_get_params uri = diff --git a/helm/DEVEL/ocaml-http/http_parser.mli b/helm/DEVEL/ocaml-http/http_parser.mli index cd42c79e5..c2c5a7113 100644 --- a/helm/DEVEL/ocaml-http/http_parser.mli +++ b/helm/DEVEL/ocaml-http/http_parser.mli @@ -23,7 +23,7 @@ open Http_types;; val split_query_params: string -> (string * string) list -val parse_request_fst_line: in_channel -> meth * Neturl.url * version +val parse_request_fst_line: in_channel -> meth * Neturl.url * version option val parse_query_get_params: Neturl.url -> (string * string) list val parse_path: Neturl.url -> string val parse_headers: in_channel -> (string * string) list diff --git a/helm/DEVEL/ocaml-http/http_parser_sanity.ml b/helm/DEVEL/ocaml-http/http_parser_sanity.ml index 19204e870..be9293469 100644 --- a/helm/DEVEL/ocaml-http/http_parser_sanity.ml +++ b/helm/DEVEL/ocaml-http/http_parser_sanity.ml @@ -84,6 +84,9 @@ let heal_header (name, value) = heal_header_name name; heal_header_value name -let url_of_string = url_of_string request_uri_syntax +let url_of_string s = + try + url_of_string request_uri_syntax s + with Neturl.Malformed_URL -> raise (Malformed_URL s) let string_of_url = Neturl.string_of_url diff --git a/helm/DEVEL/ocaml-http/http_parser_sanity.mli b/helm/DEVEL/ocaml-http/http_parser_sanity.mli index 3076a42a6..f421c76c7 100644 --- a/helm/DEVEL/ocaml-http/http_parser_sanity.mli +++ b/helm/DEVEL/ocaml-http/http_parser_sanity.mli @@ -26,6 +26,8 @@ val heal_header: string * string -> unit (** remove heading and/or trailing LWS sequences as per RFC2616 *) val normalize_header_value: string -> string + (** parse an URL from a string. + @raise Malformed_URL if an invalid URL is encountered *) val url_of_string: string -> Neturl.url val string_of_url: Neturl.url -> string diff --git a/helm/DEVEL/ocaml-http/http_request.ml b/helm/DEVEL/ocaml-http/http_request.ml index cf8601850..65cba9710 100644 --- a/helm/DEVEL/ocaml-http/http_request.ml +++ b/helm/DEVEL/ocaml-http/http_request.ml @@ -38,31 +38,39 @@ class request ic = let uri_str = Neturl.string_of_url uri in let path = Http_parser.parse_path uri in let query_get_params = Http_parser.parse_query_get_params uri in - let headers = - List.map (* lowercase header names to ease lookups before having a request - object *) - (fun (h,v) -> (String.lowercase h, v)) - (Http_parser.parse_headers ic) (* trailing \r\n consumed! *) - in - let body = - (* TODO fallback on Transfer-Encoding if Content-Length isn't defined *) - if meth = `POST then - Buffer.contents - (try (* read only Content-Length bytes *) - let limit_raw = - (try - List.assoc "content-length" headers - with Not_found -> raise Fallback) - in - let limit = - (try (* TODO supports only a maximum content-length of 1Gb *) - int_of_string limit_raw - with Failure "int_of_string" -> - raise (Invalid_header ("content-length: " ^ limit_raw))) - in - Http_misc.buf_of_inchan ~limit ic - with Fallback -> Http_misc.buf_of_inchan ic) (* read until EOF *) - else "" (* TODO empty body for methods other than POST, is what we want? *) + let (headers, body) = + (match version with + | None -> [], "" (* No version given, use request's 1st line only *) + | Some version -> (* Version specified, parse also headers and body *) + let headers = + List.map (* lowercase header names to ease lookups before having a + request object *) + (fun (h,v) -> (String.lowercase h, v)) + (Http_parser.parse_headers ic) (* trailing \r\n consumed! *) + in + let body = + (* TODO fallback on size defined in Transfer-Encoding if + Content-Length isn't defined *) + if meth = `POST then + Buffer.contents + (try (* read only Content-Length bytes *) + let limit_raw = + (try + List.assoc "content-length" headers + with Not_found -> raise Fallback) + in + let limit = + (try (* TODO supports only a maximum content-length of 1Gb *) + int_of_string limit_raw + with Failure "int_of_string" -> + raise (Invalid_header ("content-length: " ^ limit_raw))) + in + Http_misc.buf_of_inchan ~limit ic + with Fallback -> Http_misc.buf_of_inchan ic) (* read until EOF *) + else (* TODO empty body for methods other than POST, is ok? *) + "" + in + (headers, body)) in let query_post_params = match meth with @@ -110,46 +118,11 @@ class request ic = method params_POST = query_post_params method private fstLineToString = - sprintf "%s %s %s" - (string_of_method self#meth) self#uri (string_of_version self#version) - - end - -(* (* OLD IMPLEMENTATION *) -class request - ~body ~headers ~version ~meth ~uri - ~clisockaddr ~srvsockaddr - ~path ~params - () - = - object (self) - - inherit - Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr - - val params_tbl = - let tbl = Hashtbl.create (List.length params) in - List.iter (fun (n,v) -> Hashtbl.add tbl n v) params; - tbl - - method meth = meth - method uri = uri - method path = path - method param name = - try - Hashtbl.find params_tbl name - with Not_found -> - raise (Param_not_found name) - method paramAll name = List.rev (Hashtbl.find_all params_tbl name) - method params = params - - method private fstLineToString = - sprintf - "%s %s %s" - (string_of_method self#meth) - self#uri - (string_of_version self#version) + let method_string = string_of_method self#meth in + match self#version with + | Some version -> + sprintf "%s %s %s" method_string self#uri (string_of_version version) + | None -> sprintf "%s %s" method_string self#uri end -*) diff --git a/helm/DEVEL/ocaml-http/http_response.ml b/helm/DEVEL/ocaml-http/http_response.ml index 913c22755..6fc321325 100644 --- a/helm/DEVEL/ocaml-http/http_response.ml +++ b/helm/DEVEL/ocaml-http/http_response.ml @@ -47,8 +47,10 @@ class response (* "version code reason_phrase" *) object (self) + (* note that response objects can't be created with a None version *) inherit - Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr + Http_message.message + ~body ~headers ~version:(Some version) ~clisockaddr ~srvsockaddr val mutable _code = match status with @@ -56,6 +58,13 @@ class response | Some (s: Http_types.status) -> code_of_status s val mutable _reason: string option = None + method private getRealVersion = + match self#version with + | None -> + failwith ("Http_response.fstLineToString: " ^ + "can't serialize an HTTP response with no HTTP version defined") + | Some v -> string_of_version v + method code = _code method setCode c = ignore (status_of_code c); (* sanity check on c *) @@ -68,9 +77,8 @@ class response | 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] + String.concat " " + [self#getRealVersion; string_of_int self#code; self#reason] method setStatusLine s = try let subs = Pcre.extract ~rex:status_line_RE s in @@ -104,11 +112,7 @@ class response method setServer s = self#replaceHeader "Server" s method private fstLineToString = - sprintf - "%s %d %s" - (string_of_version self#version) - self#code - self#reason + sprintf "%s %d %s" self#getRealVersion self#code self#reason end diff --git a/helm/DEVEL/ocaml-http/http_types.ml b/helm/DEVEL/ocaml-http/http_types.ml index 909b4681a..34c8481a7 100644 --- a/helm/DEVEL/ocaml-http/http_types.ml +++ b/helm/DEVEL/ocaml-http/http_types.ml @@ -128,6 +128,7 @@ exception Invalid_HTTP_method of string exception Invalid_code of int exception Invalid_status of status +exception Malformed_URL of string exception Malformed_query of string exception Malformed_query_part of string * string exception Unsupported_method of string @@ -146,7 +147,7 @@ exception Quit class type message = object - method version: version + method version: version option method setVersion: version -> unit method body: string