From ec3dec6b72bde5048ab2d662526c2cc6b882d4f5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Feb 2024 16:28:31 -0500 Subject: [PATCH] wip: bugfixes --- examples/echo.ml | 93 +++++++++++++++++++++--------------------- examples/echo_ws.ml | 8 ++-- examples/sse_server.ml | 27 ++++++------ examples/writer.ml | 13 +++--- src/Tiny_httpd.ml | 3 ++ src/Tiny_httpd.mli | 2 + src/bin/vfs_pack.ml | 6 +-- src/core/IO.ml | 88 +++++++++++++++++++-------------------- src/core/request.ml | 24 +++++------ src/core/request.mli | 4 +- tests/unit/dune | 2 +- tests/unit/t_buf.ml | 2 +- tests/unit/t_server.ml | 12 ++++-- tests/unit/t_util.ml | 33 +++++++-------- 14 files changed, 158 insertions(+), 159 deletions(-) diff --git a/examples/echo.ml b/examples/echo.ml index a8b1b232..f3d0f2af 100644 --- a/examples/echo.ml +++ b/examples/echo.ml @@ -1,4 +1,4 @@ -module S = Tiny_httpd +open Tiny_httpd_core module Log = Tiny_httpd.Log let now_ = Unix.gettimeofday @@ -34,7 +34,7 @@ let alice_text = sides of the well, and noticed that they were filled with cupboards......" (* util: a little middleware collecting statistics *) -let middleware_stat () : S.Middleware.t * (unit -> string) = +let middleware_stat () : Server.Middleware.t * (unit -> string) = let n_req = ref 0 in let total_time_ = ref 0. in let parse_time_ = ref 0. in @@ -43,7 +43,7 @@ let middleware_stat () : S.Middleware.t * (unit -> string) = let m h req ~resp = incr n_req; - let t1 = S.Request.start_time req in + let t1 = Request.start_time req in let t2 = now_ () in h req ~resp:(fun response -> let t3 = now_ () in @@ -92,23 +92,23 @@ let () = (fun _ -> raise (Arg.Bad "")) "echo [option]*"; - let server = S.create ~port:!port_ ~max_connections:!j () in + let server = Tiny_httpd.create ~port:!port_ ~max_connections:!j () in Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server; let m_stats, get_stats = middleware_stat () in - S.add_middleware server ~stage:(`Stage 1) m_stats; + Server.add_middleware server ~stage:(`Stage 1) m_stats; (* say hello *) - S.add_route_handler ~meth:`GET server - S.Route.(exact "hello" @/ string @/ return) - (fun name _req -> S.Response.make_string (Ok ("hello " ^ name ^ "!\n"))); + Server.add_route_handler ~meth:`GET server + Route.(exact "hello" @/ string @/ return) + (fun name _req -> Response.make_string (Ok ("hello " ^ name ^ "!\n"))); (* compressed file access *) - S.add_route_handler ~meth:`GET server - S.Route.(exact "zcat" @/ string_urlencoded @/ return) + Server.add_route_handler ~meth:`GET server + Route.(exact "zcat" @/ string_urlencoded @/ return) (fun path _req -> let ic = open_in path in - let str = S.Byte_stream.of_chan ic in + let str = IO.Input.of_in_channel ic in let mime_type = try let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" path) in @@ -121,42 +121,42 @@ let () = [] with _ -> [] in - S.Response.make_stream ~headers:mime_type (Ok str)); + Response.make_stream ~headers:mime_type (Ok str)); (* echo request *) - S.add_route_handler server - S.Route.(exact "echo" @/ return) + Server.add_route_handler server + Route.(exact "echo" @/ return) (fun req -> let q = - S.Request.query req + Request.query req |> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v) |> String.concat ";" in - S.Response.make_string - (Ok (Format.asprintf "echo:@ %a@ (query: %s)@." S.Request.pp req q))); + Response.make_string + (Ok (Format.asprintf "echo:@ %a@ (query: %s)@." Request.pp req q))); (* file upload *) - S.add_route_handler_stream ~meth:`PUT server - S.Route.(exact "upload" @/ string @/ return) + Server.add_route_handler_stream ~meth:`PUT server + Route.(exact "upload" @/ string @/ return) (fun path req -> Log.debug (fun k -> k "start upload %S, headers:\n%s\n\n%!" path - (Format.asprintf "%a" S.Headers.pp (S.Request.headers req))); + (Format.asprintf "%a" Headers.pp (Request.headers req))); try let oc = open_out @@ "/tmp/" ^ path in - S.Byte_stream.to_chan oc req.S.Request.body; + IO.Input.to_chan oc req.Request.body; flush oc; - S.Response.make_string (Ok "uploaded file") + Response.make_string (Ok "uploaded file") with e -> - S.Response.fail ~code:500 "couldn't upload file: %s" + Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e)); (* protected by login *) - S.add_route_handler server - S.Route.(exact "protected" @/ return) + Server.add_route_handler server + Route.(exact "protected" @/ return) (fun req -> let ok = - match S.Request.get_header req "authorization" with + match Request.get_header req "authorization" with | Some v -> Log.debug (fun k -> k "authenticate with %S" v); v = "Basic " ^ base64 "user:foobar" @@ -167,40 +167,40 @@ let () = let s = "

hello, this is super secret!

log out" in - S.Response.make_string (Ok s) + Response.make_string (Ok s) ) else ( let headers = - S.Headers.(empty |> set "www-authenticate" "basic realm=\"echo\"") + Headers.(empty |> set "www-authenticate" "basic realm=\"echo\"") in - S.Response.fail ~code:401 ~headers "invalid" + Response.fail ~code:401 ~headers "invalid" )); (* logout *) - S.add_route_handler server - S.Route.(exact "logout" @/ return) - (fun _req -> S.Response.fail ~code:401 "logged out"); + Server.add_route_handler server + Route.(exact "logout" @/ return) + (fun _req -> Response.fail ~code:401 "logged out"); (* stats *) - S.add_route_handler server - S.Route.(exact "stats" @/ return) + Server.add_route_handler server + Route.(exact "stats" @/ return) (fun _req -> let stats = get_stats () in - S.Response.make_string @@ Ok stats); + Response.make_string @@ Ok stats); - S.add_route_handler server - S.Route.(exact "alice" @/ return) - (fun _req -> S.Response.make_string (Ok alice_text)); + Server.add_route_handler server + Route.(exact "alice" @/ return) + (fun _req -> Response.make_string (Ok alice_text)); (* VFS *) - Tiny_httpd_dir.add_vfs server + Tiny_httpd.Dir.add_vfs server ~config: - (Tiny_httpd_dir.config ~download:true - ~dir_behavior:Tiny_httpd_dir.Index_or_lists ()) + (Tiny_httpd.Dir.config ~download:true + ~dir_behavior:Tiny_httpd.Dir.Index_or_lists ()) ~vfs:Vfs.vfs ~prefix:"vfs"; (* main page *) - S.add_route_handler server - S.Route.(return) + Server.add_route_handler server + Route.(return) (fun _req -> let open Tiny_httpd_html in let h = @@ -272,9 +272,10 @@ let () = ] in let s = to_string_top h in - S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s); + Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s); - Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server); - match S.run server with + Printf.printf "listening on http://%s:%d\n%!" (Server.addr server) + (Server.port server); + match Server.run server with | Ok () -> () | Error e -> raise e diff --git a/examples/echo_ws.ml b/examples/echo_ws.ml index 5a616d3f..f24cf283 100644 --- a/examples/echo_ws.ml +++ b/examples/echo_ws.ml @@ -1,6 +1,5 @@ module S = Tiny_httpd -module Log = Tiny_httpd.Log -module IO = Tiny_httpd_io +open Tiny_httpd_core let setup_logging ~debug () = Logs.set_reporter @@ Logs.format_reporter (); @@ -13,8 +12,7 @@ let setup_logging ~debug () = let handle_ws _client_addr ic oc = Log.info (fun k -> - k "new client connection from %s" - (Tiny_httpd_util.show_sockaddr _client_addr)); + k "new client connection from %s" (Util.show_sockaddr _client_addr)); let (_ : Thread.t) = Thread.create @@ -58,7 +56,7 @@ let () = let server = S.create ~port:!port_ ~max_connections:!j () in Tiny_httpd_ws.add_route_handler server - S.Route.(exact "echo" @/ return) + Route.(exact "echo" @/ return) handle_ws; Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server); diff --git a/examples/sse_server.ml b/examples/sse_server.ml index 650c05cd..c458026a 100644 --- a/examples/sse_server.ml +++ b/examples/sse_server.ml @@ -1,7 +1,6 @@ (* serves some streams of events *) -module S = Tiny_httpd -module Log = Tiny_httpd_log +open Tiny_httpd_core let port = ref 8080 @@ -14,7 +13,7 @@ let () = ]) (fun _ -> ()) "sse_clock [opt*]"; - let server = S.create ~port:!port () in + let server = Tiny_httpd.create ~port:!port () in let extra_headers = [ @@ -24,9 +23,9 @@ let () = in (* tick/tock goes the clock *) - S.add_route_server_sent_handler server - S.Route.(exact "clock" @/ return) - (fun _req (module EV : S.SERVER_SENT_GENERATOR) -> + Server.add_route_server_sent_handler server + Route.(exact "clock" @/ return) + (fun _req (module EV : Server.SERVER_SENT_GENERATOR) -> Log.debug (fun k -> k "new SSE connection"); EV.set_headers extra_headers; let tick = ref true in @@ -47,26 +46,26 @@ let () = done); (* just count *) - S.add_route_server_sent_handler server - S.Route.(exact "count" @/ return) - (fun _req (module EV : S.SERVER_SENT_GENERATOR) -> + Server.add_route_server_sent_handler server + Route.(exact "count" @/ return) + (fun _req (module EV : Server.SERVER_SENT_GENERATOR) -> let n = ref 0 in while true do EV.send_event ~data:(string_of_int !n) (); incr n; Unix.sleepf 0.1 done); - S.add_route_server_sent_handler server - S.Route.(exact "count" @/ int @/ return) - (fun n _req (module EV : S.SERVER_SENT_GENERATOR) -> + Server.add_route_server_sent_handler server + Route.(exact "count" @/ int @/ return) + (fun n _req (module EV : Server.SERVER_SENT_GENERATOR) -> for i = 0 to n do EV.send_event ~data:(string_of_int i) (); Unix.sleepf 0.1 done; EV.close ()); - Printf.printf "listening on http://localhost:%d/\n%!" (S.port server); - match S.run server with + Printf.printf "listening on http://localhost:%d/\n%!" (Server.port server); + match Server.run server with | Ok () -> () | Error e -> Printf.eprintf "error: %s\n%!" (Printexc.to_string e); diff --git a/examples/writer.ml b/examples/writer.ml index 9911ac3b..fed4eb60 100644 --- a/examples/writer.ml +++ b/examples/writer.ml @@ -1,7 +1,8 @@ module H = Tiny_httpd +open Tiny_httpd_core let serve_zeroes server : unit = - H.add_route_handler server H.(Route.(exact "zeroes" @/ int @/ return)) + Server.add_route_handler server Route.(exact "zeroes" @/ int @/ return) @@ fun n _req -> (* stream [n] zeroes *) let write (oc : H.IO.Output.t) : unit = @@ -11,7 +12,7 @@ let serve_zeroes server : unit = done in let writer = H.IO.Writer.make ~write () in - H.Response.make_writer @@ Ok writer + Response.make_writer @@ Ok writer let serve_file server : unit = H.add_route_handler server H.(Route.(exact "file" @/ string @/ return)) @@ -32,9 +33,9 @@ let serve_file server : unit = in let writer = H.IO.Writer.make ~write () in - H.Response.make_writer @@ Ok writer + Response.make_writer @@ Ok writer ) else - H.Response.fail ~code:404 "file not found" + Response.fail ~code:404 "file not found" let () = let port = ref 8085 in @@ -43,7 +44,7 @@ let () = Printf.printf "listen on http://localhost:%d/\n%!" !port; serve_file server; serve_zeroes server; - H.add_route_handler server H.Route.return (fun _req -> + H.add_route_handler server Route.return (fun _req -> let body = H.Html.( div [] @@ -58,5 +59,5 @@ let () = ]) |> H.Html.to_string_top in - H.Response.make_string @@ Ok body); + Response.make_string @@ Ok body); H.run_exn server diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index 6263199a..85c7c3fe 100644 --- a/src/Tiny_httpd.ml +++ b/src/Tiny_httpd.ml @@ -2,6 +2,9 @@ module Buf = Buf include Server module Util = Util module Dir = Tiny_httpd_unix.Dir + +module type VFS = Tiny_httpd_unix.Dir.VFS + module Html = Tiny_httpd_html module IO = Tiny_httpd_core.IO module Pool = Tiny_httpd_core.Pool diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 2eb3afbb..584d0188 100644 --- a/src/Tiny_httpd.mli +++ b/src/Tiny_httpd.mli @@ -108,6 +108,8 @@ module Pool = Tiny_httpd_core.Pool module Dir = Tiny_httpd_unix.Dir +module type VFS = Tiny_httpd_unix.Dir.VFS + (** {2 HTML combinators} *) module Html = Tiny_httpd_html diff --git a/src/bin/vfs_pack.ml b/src/bin/vfs_pack.ml index 8eacfeff..0b888ebc 100644 --- a/src/bin/vfs_pack.ml +++ b/src/bin/vfs_pack.ml @@ -33,12 +33,12 @@ let is_url s = is_prefix "http://" s || is_prefix "https://" s let emit oc (l : entry list) : unit = - fpf oc "let embedded_fs = Tiny_httpd_dir.Embedded_fs.create ~mtime:%f ()\n" + fpf oc "let embedded_fs = Tiny_httpd.Dir.Embedded_fs.create ~mtime:%f ()\n" now_; let add_vfs ~mtime vfs_path content = fpf oc - "let () = Tiny_httpd_dir.Embedded_fs.add_file embedded_fs \n\ + "let () = Tiny_httpd.Dir.Embedded_fs.add_file embedded_fs \n\ \ ~mtime:%h ~path:%S\n\ \ %S\n" mtime vfs_path content @@ -99,7 +99,7 @@ let emit oc (l : entry list) : unit = in List.iter add_entry l; - fpf oc "let vfs = Tiny_httpd_dir.Embedded_fs.to_vfs embedded_fs\n"; + fpf oc "let vfs = Tiny_httpd.Dir.Embedded_fs.to_vfs embedded_fs\n"; () let help = diff --git a/src/core/IO.ml b/src/core/IO.ml index 03ff5919..525b0472 100644 --- a/src/core/IO.ml +++ b/src/core/IO.ml @@ -295,56 +295,51 @@ module Input = struct | () -> Some (Buf.contents_and_clear buf) | exception End_of_file -> None - (** new stream with maximum size [max_size]. - @param close_rec if true, closing this will also close the input stream *) - let limit_size_to ~close_rec ~max_size ~(bytes : bytes) (arg : t) : t = - let remaining_size = ref max_size in + let reading_exactly_ ~skip_on_close ~close_rec ~size (arg : t) : t = + let remaining_size = ref size in object - inherit Iostream.In_buf.t_from_refill ~bytes () - method close () = if close_rec then close arg + method close () = + if !remaining_size > 0 && skip_on_close then skip arg !remaining_size; + if close_rec then close arg - method private refill slice = - if slice.len = 0 then - if !remaining_size > 0 then ( - let sub = fill_buf arg in - let len = min sub.len !remaining_size in + method fill_buf () = + if !remaining_size > 0 then + fill_buf arg + else + Slice.empty - Bytes.blit sub.bytes sub.off slice.bytes 0 len; - slice.off <- 0; - slice.len <- len; - Slice.consume sub len - ) + method input bs i len = + if !remaining_size > 0 then ( + let slice = fill_buf arg in + let n = min len (min slice.len !remaining_size) in + Bytes.blit slice.bytes slice.off bs i n; + remaining_size := !remaining_size - n; + Slice.consume slice n; + n + ) else + 0 + + method consume n = + if n > !remaining_size then + invalid_arg "reading_exactly: consuming too much"; + remaining_size := !remaining_size - n; + consume arg n end + (** new stream with maximum size [max_size]. + @param close_rec if true, closing this will also close the input stream *) + let limit_size_to ~close_rec ~max_size (arg : t) : t = + reading_exactly_ ~size:max_size ~skip_on_close:false ~close_rec arg + (** New stream that consumes exactly [size] bytes from the input. If fewer bytes are read before [close] is called, we read and discard the remaining quota of bytes before [close] returns. @param close_rec if true, closing this will also close the input stream *) - let reading_exactly ~close_rec ~size ~(bytes : bytes) (arg : t) : t = - let remaining_size = ref size in + let reading_exactly ~close_rec ~size (arg : t) : t = + reading_exactly_ ~size ~close_rec ~skip_on_close:true arg - object - inherit Iostream.In_buf.t_from_refill ~bytes () - - method close () = - if !remaining_size > 0 then skip arg !remaining_size; - if close_rec then close arg - - method private refill slice = - if slice.len = 0 then - if !remaining_size > 0 then ( - let sub = fill_buf arg in - let len = min sub.len !remaining_size in - - Bytes.blit sub.bytes sub.off slice.bytes 0 len; - slice.off <- 0; - slice.len <- len; - Slice.consume sub len - ) - end - - let read_chunked ~(bytes : bytes) ~fail (bs : #t) : t = + let read_chunked ~(bytes : bytes) ~fail (ic : #t) : t = let first = ref true in (* small buffer to read the chunk sizes *) @@ -353,11 +348,11 @@ module Input = struct if !first then first := false else ( - let line = read_line_using ~buf:line_buf bs in + let line = read_line_using ~buf:line_buf ic in if String.trim line <> "" then raise (fail "expected crlf between chunks") ); - let line = read_line_using ~buf:line_buf bs in + let line = read_line_using ~buf:line_buf ic in (* parse chunk length, ignore extensions *) let chunk_size = if String.trim line = "" then @@ -380,7 +375,10 @@ module Input = struct inherit t_from_refill ~bytes () method private refill (slice : Slice.t) : unit = - if !chunk_size = 0 && not !eof then chunk_size := read_next_chunk_len (); + if !chunk_size = 0 && not !eof then ( + chunk_size := read_next_chunk_len (); + if !chunk_size = 0 then eof := true (* stream is finished *) + ); slice.off <- 0; slice.len <- 0; if !chunk_size > 0 then ( @@ -388,12 +386,10 @@ module Input = struct let to_read = min !chunk_size (Bytes.length slice.bytes) in read_exactly_ ~too_short:(fun () -> raise (fail "chunk is too short")) - bs slice.bytes to_read; + ic slice.bytes to_read; slice.len <- to_read; chunk_size := !chunk_size - to_read - ) else - (* stream is finished *) - eof := true + ) method close () = eof := true (* do not close underlying stream *) end diff --git a/src/core/request.ml b/src/core/request.ml index df0cd1e0..c5404d85 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -71,18 +71,17 @@ let read_stream_chunked_ ~bytes (bs : #IO.Input.t) : IO.Input.t = Log.debug (fun k -> k "body: start reading chunked stream..."); IO.Input.read_chunked ~bytes ~fail:(fun s -> Bad_req (400, s)) bs -let limit_body_size_ ~max_size ~bytes (bs : #IO.Input.t) : IO.Input.t = +let limit_body_size_ ~max_size (bs : #IO.Input.t) : IO.Input.t = Log.debug (fun k -> k "limit size of body to max-size=%d" max_size); - IO.Input.limit_size_to ~max_size ~close_rec:false ~bytes bs + IO.Input.limit_size_to ~max_size ~close_rec:false bs -let limit_body_size ~max_size ?(bytes = Bytes.create 4096) (req : IO.Input.t t) - : IO.Input.t t = - { req with body = limit_body_size_ ~max_size ~bytes req.body } +let limit_body_size ~max_size (req : IO.Input.t t) : IO.Input.t t = + { req with body = limit_body_size_ ~max_size req.body } (** read exactly [size] bytes from the stream *) -let read_exactly ~size ~bytes (bs : #IO.Input.t) : IO.Input.t = +let read_exactly ~size (bs : #IO.Input.t) : IO.Input.t = Log.debug (fun k -> k "body: must read exactly %d bytes" size); - IO.Input.reading_exactly bs ~close_rec:false ~size ~bytes + IO.Input.reading_exactly bs ~close_rec:false ~size (* parse request, but not body (yet) *) let parse_req_start ~client_addr ~get_time_s ~buf (bs : IO.Input.t) : @@ -160,18 +159,15 @@ let parse_body_ ~tr_stream ~bytes (req : IO.Input.t t) : in let body = match get_header ~f:String.trim req "Transfer-Encoding" with - | None -> - let bytes = Bytes.create 4096 in - read_exactly ~size ~bytes @@ tr_stream req.body + | None -> read_exactly ~size @@ tr_stream req.body | Some "chunked" -> (* body sent by chunks *) let bs : IO.Input.t = read_stream_chunked_ ~bytes @@ tr_stream req.body in - if size > 0 then ( - let bytes = Bytes.create 4096 in - limit_body_size_ ~max_size:size ~bytes bs - ) else + if size > 0 then + limit_body_size_ ~max_size:size bs + else bs | Some s -> bad_reqf 500 "cannot handle transfer encoding: %s" s in diff --git a/src/core/request.mli b/src/core/request.mli index 731cfe69..25981a66 100644 --- a/src/core/request.mli +++ b/src/core/request.mli @@ -107,11 +107,9 @@ val start_time : _ t -> float (** time stamp (from {!Unix.gettimeofday}) after parsing the first line of the request @since 0.11 *) -val limit_body_size : - max_size:int -> ?bytes:bytes -> IO.Input.t t -> IO.Input.t t +val limit_body_size : max_size:int -> IO.Input.t t -> IO.Input.t t (** Limit the body size to [max_size] bytes, or return a [413] error. - @param bytes intermediate buffer @since 0.3 *) diff --git a/tests/unit/dune b/tests/unit/dune index c6944d20..7be0c4d9 100644 --- a/tests/unit/dune +++ b/tests/unit/dune @@ -2,4 +2,4 @@ (tests (names t_util t_buf t_server) (package tiny_httpd) - (libraries tiny_httpd qcheck-core qcheck-core.runner test_util)) + (libraries tiny_httpd.core qcheck-core qcheck-core.runner test_util)) diff --git a/tests/unit/t_buf.ml b/tests/unit/t_buf.ml index 9ee0f685..68e0d20d 100644 --- a/tests/unit/t_buf.ml +++ b/tests/unit/t_buf.ml @@ -1,5 +1,5 @@ open Test_util -open Tiny_httpd_buf +open Tiny_httpd_core.Buf let spf = Printf.sprintf diff --git a/tests/unit/t_server.ml b/tests/unit/t_server.ml index 56dd77ff..c3c888dc 100644 --- a/tests/unit/t_server.ml +++ b/tests/unit/t_server.ml @@ -1,5 +1,5 @@ open Test_util -open Tiny_httpd_server +open Tiny_httpd_core let () = let q = @@ -9,9 +9,13 @@ let () = \r\n\ salutationsSOMEJUNK" in - let str = Tiny_httpd.Byte_stream.of_string q in + let str = IO.Input.of_string q in let client_addr = Unix.(ADDR_INET (inet_addr_loopback, 1024)) in - let r = Request.Internal_.parse_req_start ~client_addr ~get_time_s:(fun _ -> 0.) str in + let r = + Request.Private_.parse_req_start_exn ~client_addr ~buf:(Buf.create ()) + ~get_time_s:(fun _ -> 0.) + str + in match r with | None -> failwith "should parse" | Some req -> @@ -19,6 +23,6 @@ let () = assert_eq (Some "coucou") (Headers.get "host" req.Request.headers); assert_eq (Some "11") (Headers.get "content-length" req.Request.headers); assert_eq "hello" req.Request.path; - let req = Request.Internal_.parse_body req str |> Request.read_body_full in + let req = Request.Private_.parse_body req str |> Request.read_body_full in assert_eq ~to_string:(fun s -> s) "salutations" req.Request.body; () diff --git a/tests/unit/t_util.ml b/tests/unit/t_util.ml index 3ae913a4..7f9eac7f 100644 --- a/tests/unit/t_util.ml +++ b/tests/unit/t_util.ml @@ -1,33 +1,34 @@ open Test_util -open Tiny_httpd_util +open Tiny_httpd_core +module U = Util -let () = assert_eq "hello%20world" (percent_encode "hello world") -let () = assert_eq "%23%25^%24%40^%40" (percent_encode "#%^$@^@") +let () = assert_eq "hello%20world" (U.percent_encode "hello world") +let () = assert_eq "%23%25^%24%40^%40" (U.percent_encode "#%^$@^@") let () = assert_eq "a%20ohm%2B5235%25%26%40%23%20---%20_" - (percent_encode "a ohm+5235%&@# --- _") + (U.percent_encode "a ohm+5235%&@# --- _") -let () = assert_eq (Some "?") (percent_decode @@ percent_encode "?") +let () = assert_eq (Some "?") (U.percent_decode @@ U.percent_encode "?") let () = add_qcheck @@ QCheck.Test.make ~count:1_000 ~long_factor:20 Q.string (fun s -> String.iter (fun c -> Q.assume @@ is_ascii_char c) s; - match percent_decode (percent_encode s) with + match U.percent_decode (U.percent_encode s) with | Some s' -> s = s' | None -> Q.Test.fail_report "invalid percent encoding") -let () = assert_eq [ "a"; "b" ] (split_on_slash "/a/b") -let () = assert_eq [ "coucou"; "lol" ] (split_on_slash "/coucou/lol") -let () = assert_eq [ "a"; "b"; "c" ] (split_on_slash "/a/b//c/") -let () = assert_eq [ "a"; "b" ] (split_on_slash "//a/b/") -let () = assert_eq [ "a" ] (split_on_slash "/a//") -let () = assert_eq [] (split_on_slash "/") -let () = assert_eq [] (split_on_slash "//") +let () = assert_eq [ "a"; "b" ] (U.split_on_slash "/a/b") +let () = assert_eq [ "coucou"; "lol" ] (U.split_on_slash "/coucou/lol") +let () = assert_eq [ "a"; "b"; "c" ] (U.split_on_slash "/a/b//c/") +let () = assert_eq [ "a"; "b" ] (U.split_on_slash "//a/b/") +let () = assert_eq [ "a" ] (U.split_on_slash "/a//") +let () = assert_eq [] (U.split_on_slash "/") +let () = assert_eq [] (U.split_on_slash "//") let () = - assert_eq ~cmp:eq_sorted (Ok [ "a", "b"; "c", "d" ]) (parse_query "a=b&c=d") + assert_eq ~cmp:eq_sorted (Ok [ "a", "b"; "c", "d" ]) (U.parse_query "a=b&c=d") let () = add_qcheck @@ -43,9 +44,9 @@ let () = let s = String.concat "&" (List.map - (fun (x, y) -> percent_encode x ^ "=" ^ percent_encode y) + (fun (x, y) -> U.percent_encode x ^ "=" ^ U.percent_encode y) l) in - eq_sorted (Ok l) (parse_query s)) + eq_sorted (Ok l) (U.parse_query s)) let () = run_qcheck_and_exit ()