diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index e06f5b15..53726469 100644 --- a/src/Tiny_httpd.ml +++ b/src/Tiny_httpd.ml @@ -84,7 +84,9 @@ module Byte_stream = struct let rec iter f (self:t) : unit = let s, i, len = self.bs_fill_buf () in - if len > 0 then ( + if len=0 then ( + self.bs_close(); + ) else ( f s i len; self.bs_consume len; (iter [@tailcall]) f self @@ -98,13 +100,15 @@ module Byte_stream = struct let len = ref ( match len with - | Some n -> min n (Bytes.length s- i) - | None -> Bytes.length s- i + | Some n -> + if n > Bytes.length s -i then invalid_arg "Byte_stream.of_bytes"; + n + | None -> Bytes.length s - i ) in let i = ref i in { bs_fill_buf=(fun () -> s, !i, !len); - bs_close=(fun () -> ()); + bs_close=(fun () -> len := 0); bs_consume=(fun n -> assert (n<= !len); i := !i + n; len := !len - n); } @@ -121,20 +125,17 @@ module Byte_stream = struct close_in_noerr ic; raise e - (* Read as much as possible into [buf]. *) - let read_into_buf (self:t) (buf:Buf_.t) : int = - let s, i, len = self.bs_fill_buf () in - if len > 0 then ( - Buf_.add_bytes buf s i len; - self.bs_consume len; - ); - len - let read_all ?(buf=Buf_.create()) (self:t) : string = let continue = ref true in while !continue do - let n_rd = read_into_buf self buf in - if n_rd = 0 then ( + let s, i, len = self.bs_fill_buf () in + _debug (fun k->k "read-all: got i=%d, len=%d, bufsize %d" i len (Buf_.size buf)); + if len > 0 then ( + Buf_.add_bytes buf s i len; + self.bs_consume len; + ); + assert (len >= 0); + if len = 0 then ( continue := false ) done; @@ -145,24 +146,24 @@ module Byte_stream = struct assert (Bytes.length bytes >= n); let offset = ref 0 in while !offset < n do - let n_read = - let s, i, len = self.bs_fill_buf () in - let n_read = min len (n- !offset) in - Bytes.blit s i bytes !offset n_read; - offset := !offset + n_read; - self.bs_consume n_read; - n_read - in + let s, i, len = self.bs_fill_buf () in + let n_read = min len (n- !offset) in + Bytes.blit s i bytes !offset n_read; + offset := !offset + n_read; + self.bs_consume n_read; if n_read=0 then too_short(); done - (* read a line into the buffer *) + (* read a line into the buffer, after clearing it. *) let read_line_into (self:t) ~buf : unit = Buf_.clear buf; let continue = ref true in while !continue do let s, i, len = self.bs_fill_buf () in - if len=0 then continue := false; + if len=0 then ( + continue := false; + if Buf_.size buf = 0 then raise End_of_file; + ); let j = ref i in while !j < i+len && Bytes.get s !j <> '\n' do incr j @@ -178,6 +179,56 @@ module Byte_stream = struct ) done + (* new stream with maximum size [max_size]. + @param close_rec if true, closing this will also close the input stream + @param too_big called with read size if the max size is reached *) + let limit_size_to ~close_rec ~max_size ~too_big (self:t) : t = + let size = ref 0 in + let continue = ref true in + { bs_fill_buf = + (fun () -> + if !continue then self.bs_fill_buf() else Bytes.empty, 0, 0); + bs_close=(fun () -> + if close_rec then self.bs_close ()); + bs_consume = (fun n -> + size := !size + n; + if !size > max_size then ( + continue := false; + too_big !size + ) else ( + self.bs_consume n + )); + } + + (* read exactly [size] bytes from the stream *) + let read_exactly ~close_rec ~size ~too_short (self:t) : t = + if size=0 then ( + empty + ) else ( + let size = ref size in + { bs_fill_buf = (fun () -> + (* must not block on [self] if we're done *) + if !size = 0 then Bytes.empty, 0, 0 + else ( + let buf, i, len = self.bs_fill_buf () in + let len = min len !size in + if len = 0 && !size > 0 then ( + too_short !size; + ); + buf, i, len + ) + ); + bs_close=(fun () -> + (* close underlying stream if [close_rec] *) + if close_rec then self.bs_close(); + size := 0); + bs_consume = (fun n -> + let n = min n !size in + size := !size - n; + self.bs_consume n); + } + ) + let read_line ?(buf=Buf_.create()) self : string = read_line_into self ~buf; Buf_.contents buf @@ -306,6 +357,7 @@ module Request = struct (* decode a "chunked" stream into a normal stream *) let read_stream_chunked_ ?(buf=Buf_.create()) (bs:byte_stream) : byte_stream = + _debug (fun k->k "body: start reading chunked stream..."); let read_next_chunk_len () : int = let line = Byte_stream.read_line ~buf bs in (* parse chunk length, ignore extensions *) @@ -318,7 +370,7 @@ module Request = struct chunk_size in let refill = ref true in - let bytes = Bytes.make 4096 ' ' in + let bytes = Bytes.make (16 * 4096) ' ' in let offset = ref 0 in let len = ref 0 in let chunk_size = ref 0 in @@ -354,46 +406,24 @@ module Request = struct let limit_body_size_ ~max_size (bs:byte_stream) : byte_stream = _debug (fun k->k "limit size of body to max-size=%d" max_size); - let size = ref 0 in - { bs_fill_buf = bs.bs_fill_buf; - bs_close=bs.bs_close; - bs_consume = (fun n -> - size := !size + n; - if !size > max_size then ( - (* read too much *) - bad_reqf 413 - "body size was supposed to be %d, but at least %d bytes received" - max_size !size - ); - bs.bs_consume n); - } + Byte_stream.limit_size_to ~max_size ~close_rec:true bs + ~too_big:(fun size -> + (* read too much *) + bad_reqf 413 + "body size was supposed to be %d, but at least %d bytes received" + max_size size + ) let limit_body_size ~max_size (req:byte_stream t) : byte_stream t = { req with body=limit_body_size_ ~max_size req.body } (* read exactly [size] bytes from the stream *) let read_exactly ~size (bs:byte_stream) : byte_stream = - if size=0 then ( - Byte_stream.empty - ) else ( - let size = ref size in - { bs_fill_buf = (fun () -> - let buf, i, len = bs.bs_fill_buf () in - let len = min len !size in - if len = 0 && !size > 0 then ( - bad_reqf 400 "body is too short" - ); - buf, i, len - ); - bs_close=(fun () -> - (* do not close underlying stream *) - size := 0); - bs_consume = (fun n -> - let n = min n !size in - size := !size - n; - bs.bs_consume n); - } - ) + _debug (fun k->k "body: must read exactly %d bytes" size); + Byte_stream.read_exactly bs ~close_rec:false + ~size ~too_short:(fun size -> + bad_reqf 400 "body is too short by %d bytes" size + ) (* parse request, but not body (yet) *) let parse_req_start ~buf (bs:byte_stream) : unit t option resp_result = diff --git a/src/bin/http_of_dir.ml b/src/bin/http_of_dir.ml index 30642f10..f2558ccf 100644 --- a/src/bin/http_of_dir.ml +++ b/src/bin/http_of_dir.ml @@ -141,6 +141,7 @@ let serve ~config (dir:string) : _ result = S.Byte_stream.to_chan oc req.S.Request.body; flush oc; close_out oc; + S._debug (fun k->k "done uploading"); S.Response.make_raw ~code:201 "upload successful" ) ) else (