From 6475217984ca26812aa433a8df698698f5ae7167 Mon Sep 17 00:00:00 2001 From: Prashanth Mundkur Date: Mon, 4 May 2009 18:10:59 -0700 Subject: [PATCH] Fixes from testing to request parsing. --- libs/http/http.ml | 75 ++++++++++++++++++++++++------------ libs/http/http.mli | 4 ++ libs/http/tests/test_http.ml | 16 +++++--- 3 files changed, 64 insertions(+), 31 deletions(-) diff --git a/libs/http/http.ml b/libs/http/http.ml index baea3ed..c874258 100644 --- a/libs/http/http.ml +++ b/libs/http/http.ml @@ -285,6 +285,7 @@ module Request_header = struct mutable s_uri: string option; mutable s_version: version option; mutable s_headers: header_fields; + mutable num_bytes_parsed: int } type error = @@ -315,9 +316,12 @@ module Request_header = struct s_uri = None; s_version = Some HTTP09; s_headers = []; + num_bytes_parsed = 0 } let is_done s = s.cursor = Done + let num_bytes_parsed state = + if state.cursor = Start then 0 else state.num_bytes_parsed (* From http://tools.ietf.org/html/rfc1945#section-4: Simple-Request = "GET" SP Request-URI CRLF ; HTTP/0.9 @@ -437,7 +441,8 @@ module Request_header = struct let i = ref 0 in while get_parse_result state = None && !i < len do parse_char state str.[!i]; - incr i + incr i; + state.num_bytes_parsed <- state.num_bytes_parsed + 1 done; match get_parse_result state with | Some v -> Result (v, (String.sub str !i (len - !i))) @@ -479,6 +484,7 @@ module Response_header = struct mutable s_status_code: int option; mutable s_reason_phrase: string option; mutable s_headers: header_fields; + mutable num_bytes_parsed: int } type error = @@ -512,9 +518,12 @@ module Response_header = struct s_status_code = None; s_reason_phrase = None; s_headers = []; + num_bytes_parsed = 0 } let is_done s = s.cursor = Done + let num_bytes_parsed state = + if state.cursor = Start then 0 else state.num_bytes_parsed (* From http://tools.ietf.org/html/rfc1945#section-4: Simple-Response = [ Entity-Body ] ; HTTP/0.9 @@ -627,7 +636,8 @@ module Response_header = struct let i = ref 0 in while get_parse_result state = None && !i < len do parse_char state str.[!i]; - incr i + incr i; + state.num_bytes_parsed <- state.num_bytes_parsed + 1 done; match get_parse_result state with | Some v -> Result (v, (String.sub str !i (len - !i))) @@ -675,10 +685,13 @@ module Payload = struct mutable remaining_length: int64; max_payload_length: int64; mutable body: Buffer.t; - mutable headers: header_fields + mutable headers: header_fields; + mutable num_bytes_parsed: int64 } let is_done s = s.cursor = Done + let num_bytes_parsed state = state.num_bytes_parsed + type error = | Parse_error of cursor * char @@ -739,7 +752,8 @@ module Payload = struct remaining_length = -1L; max_payload_length = max_payload_length; body = Buffer.create 512; - headers = [] + headers = []; + num_bytes_parsed = 0L } let default_max_payload_length = Int64.of_int (10*1024*1024) @@ -752,24 +766,30 @@ module Payload = struct let content_length = get_content_length version hdrs in let multipart_body = content_type_is_multipart_byteranges hdrs in let default = init_default_state max_payload_length in + match version, meth, content_length, chunked, multipart_body with | HTTP09, _, _, _, _ - | _, Request_header.Connect, _, _, _ (* The caller really needs to handle this specially. *) - | _, _, `HTTP09, _, _ - | _, _, `Some 0L, _, _ -> No_payload - | _, _, `Some l, _, _ -> Payload { default with - content_length = Length l; - remaining_length = l - } - | _, _, `Error, _, _ -> Error "Invalid Content-Length" - | _, _, _, true, _ -> Payload { default with - cursor = Start_chunk_length; - content_length = Chunked - } - | _, _, _, _, true -> Error "multipart/byteranges is currently unsupported" + | _, Request_header.Connect, _, _, _ -> No_payload + + (* We need to check Transfer-Encoding before Content-Length. + http://tools.ietf.org/html/rfc2616#section-4.4, Item 3. + *) + | _, _, _, true, false -> Payload { default with + cursor = Start_chunk_length; + content_length = Chunked + } + | _, _, `HTTP09, _, false + | HTTP11, _, `None, _, false -> No_payload + | _, _, `Some 0L, _, false -> No_payload + | _, _, `Some l, _, false -> Payload { default with + content_length = Length l; + remaining_length = l + } + | _, _, `Error, _, false -> Error "Invalid Content-Length" + | _, _, _, _, true -> Error "multipart/byteranges is unsupported" (* Default to assuming that the payload is terminated by a Connection:close. *) - | _ -> Payload default + | _ -> Payload default let init_from_response ?(max_payload_length=default_max_payload_length) resp = let version = resp.Response_header.version in @@ -779,11 +799,20 @@ module Payload = struct let content_length = get_content_length version hdrs in let multipart_body = content_type_is_multipart_byteranges hdrs in let default = init_default_state max_payload_length in + match status_code, content_length, chunked, multipart_body with | sc, _, _, _ (* http://tools.ietf.org/html/rfc2616#section-4.4, Item 1. *) when sc/100 = 1 || sc = 204 || sc = 304 -> No_payload + (* We need to check Transfer-Encoding before Content-Length. + http://tools.ietf.org/html/rfc2616#section-4.4, Item 3. + *) + | _, _, true, _ -> Payload { default with + cursor = Start_chunk_length; + content_length = Chunked + } + | _, `HTTP09, _, _ -> Payload default (* Connection: close *) | _, `Some 0L, _, _ -> No_payload | _, `Some l, _, _ -> Payload { default with @@ -792,18 +821,13 @@ module Payload = struct } | _, `Error, _, _ -> Error "Invalid Content-Length" - | _, _, true, _ -> Payload { default with - cursor = Start_chunk_length; - content_length = Chunked - } - | _, _, _, true -> Error "multipart/byteranges is currently unsupported" (* Default to assuming that the payload is terminated by a Connection:close. *) | _ -> Payload default let parse_char s c = - Printf.printf "parsing %C in state %s...\n" c (string_of_cursor s.cursor); + dbg "parsing %C in state %s...\n" c (string_of_cursor s.cursor); let raise_bad_char () = raise_error (Parse_error (s.cursor, c)) in match s.cursor with | In_body -> @@ -893,7 +917,8 @@ module Payload = struct let i = ref 0 in while get_parse_result state = None && !i < len do parse_char state str.[!i]; - incr i + incr i; + state.num_bytes_parsed <- Int64.succ state.num_bytes_parsed done; match get_parse_result state with | Some v -> Result (v, (String.sub str !i (len - !i))) diff --git a/libs/http/http.mli b/libs/http/http.mli index 5c47ed0..a957d11 100644 --- a/libs/http/http.mli +++ b/libs/http/http.mli @@ -24,6 +24,7 @@ module Request_header : sig type state val init_state : unit -> state + val num_bytes_parsed : state -> int type t = { @@ -45,6 +46,7 @@ end module Response_header : sig type state val init_state : unit -> state + val num_bytes_parsed : state -> int type t = { @@ -65,6 +67,8 @@ end module Payload : sig type state + val num_bytes_parsed : state -> int64 + type payload_type = | No_payload | Payload of state diff --git a/libs/http/tests/test_http.ml b/libs/http/tests/test_http.ml index c75413a..30d4bd7 100644 --- a/libs/http/tests/test_http.ml +++ b/libs/http/tests/test_http.ml @@ -19,8 +19,8 @@ let do_requests = ref false let do_responses = ref false let parse_args () = - let options = [("-requests", Arg.Set do_requests, " parse request stream"); - ("-responses", Arg.Set do_responses, " parse response stream") + let options = [("-q", Arg.Set do_requests, " parse request stream"); + ("-p", Arg.Set do_responses, " parse response stream") ] in let file = ref None in let usage = Printf.sprintf "Usage: %s [options] file" Sys.argv.(0) in @@ -41,7 +41,7 @@ let read_whole_file ic = let rec do_read () = try let line = input_line ic in - Buffer.add_string buf line; + Buffer.add_string buf line; Buffer.add_char buf '\n'; do_read () with End_of_file -> Buffer.contents buf @@ -82,8 +82,10 @@ let parse_requests inp = input := "" ) ); + state := Request_header.init_state () | Request_header.Parse_incomplete st -> - Printf.printf "Request incomplete!\n"; + if Request_header.num_bytes_parsed st > 0 then + Printf.printf "Request incomplete!\n"; input := ""; state := st done @@ -122,9 +124,11 @@ let parse_responses inp = ); input := "" ) - ) + ); + state := Response_header.init_state () | Response_header.Parse_incomplete st -> - Printf.printf "Response incomplete!\n"; + if Response_header.num_bytes_parsed st > 0 then + Printf.printf "Response incomplete!\n"; input := ""; state := st done -- 2.39.5