-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)