Merge branch 'master' into master

CHANGES.md

@@ -1,6 +1,7 @@
 ## Unreleased
 
 - cohttp-eio: Don't blow up `Server.callback` on client disconnections. (mefyl #1015)
+- http: Fix assertion in `Source.to_string_trim` when `pos <> 0` (mefyl #1017)
 
 ## v6.0.0~beta2 (2024-01-05)
 

cohttp-bench.opam

@@ -26,8 +26,10 @@ depends: [
   "dune" {>= "3.0"}
   "core" {>= "v0.13.0"}
   "core_bench"
+  "eio" {>= "0.12"}
   "http" {= version}
   "cohttp" {= version}
+  "cohttp-eio" {= version}
   "cohttp-lwt-unix" {= version}
   "cohttp-server-lwt-unix" {= version}
   "cohttp-async" {= version}

cohttp-bench/dune

@@ -13,6 +13,11 @@
  (modules async_server)
  (libraries cohttp-async core_unix.command_unix logs.fmt fmt.tty))
 
+(executable
+ (name eio_server)
+ (modules eio_server)
+ (libraries cohttp-eio eio_main))
+
 (rule
  (alias bench)
  (package cohttp-bench)

cohttp-bench/eio_server.ml

@@ -0,0 +1,22 @@
+open Cohttp_eio
+
+let length = 2053
+let text = String.make length 'a'
+let headers = Cohttp.Header.of_list [ ("content-length", Int.to_string length) ]
+
+let server_callback _conn _req _body =
+  Server.respond_string ~headers ~status:`OK ~body:text ()
+
+
+let () =
+  let port = ref 8080 in
+  Arg.parse
+    [ ("-p", Arg.Set_int port, " Listening port number(8080 by default)") ]
+    ignore "An HTTP/1.1 server";
+  Eio_main.run @@ fun env ->
+  Eio.Switch.run @@ fun sw ->
+  let socket =
+    Eio.Net.listen env#net ~sw ~backlog:11_000 ~reuse_addr:true
+      (`Tcp (Eio.Net.Ipaddr.V4.loopback, !port))
+  and server = Cohttp_eio.Server.make ~callback:server_callback () in
+  Cohttp_eio.Server.run socket server ~on_error:raise

cohttp-bench/latency.sh

@@ -4,7 +4,7 @@ set -xe
 rm -rf output/*
 mkdir -p output
 
-for cmd in "lwt_unix_server" "async_server" "lwt_unix_server_new"; do
+for cmd in "lwt_unix_server" "async_server" "lwt_unix_server_new" "eio_server"; do
   ./$cmd.exe &
   running_pid=$!
   echo "Measuring latency of $cmd"

cohttp-eio/src/io.ml

@@ -1,3 +1,7 @@
+let src = Logs.Src.create "cohttp.eio.io" ~doc:"Cohttp Eio IO module"
+
+module Logs = (val Logs.src_log src : Logs.LOG)
+
 module IO = struct
   type 'a t = 'a
 
@@ -22,16 +26,30 @@ module IO = struct
     let () = Eio.Buf_read.consume ic consumed in
     res
 
-  let read_line ic = try Some (Eio.Buf_read.line ic) with End_of_file -> None
+  let read_line ic =
+    try
+      let line = Eio.Buf_read.line ic in
+      let () = Logs.debug (fun f -> f "<<< %s" line) in
+      Some line
+    with End_of_file ->
+      let () = Logs.debug (fun f -> f "<<< EOF") in
+      None
 
   let read ic len =
     match Eio.Buf_read.ensure ic 1 with
-    | exception End_of_file -> ""
+    | exception End_of_file ->
+        let () = Logs.debug (fun f -> f "<<< EOF") in
+        ""
     | () ->
         let len = Int.min len (Eio.Buf_read.buffered_bytes ic) in
-        Eio.Buf_read.take len ic
+        let read = Eio.Buf_read.take len ic in
+        let () = Logs.debug (fun f -> f "<<< %s" read) in
+        read
+
+  let write oc string =
+    let () = Logs.debug (fun f -> f ">>> %s" (String.trim string)) in
+    Eio.Buf_write.string oc string
 
-  let write oc string = Eio.Buf_write.string oc string
   let flush = Eio.Buf_write.flush
 end
 

dune-project

@@ -346,10 +346,14 @@
   (core
    (>= v0.13.0))
   core_bench
+  (eio
+   (>= 0.12))
   (http
    (= :version))
   (cohttp
    (= :version))
+  (cohttp-eio
+   (= :version))
   (cohttp-lwt-unix
    (= :version))
   (cohttp-server-lwt-unix

http/src/http.ml

@@ -944,7 +944,7 @@ module Parser = struct
              "Http_parser.Source.substring: Index out of bounds., Requested \
               off: %d, len: %d"
              pos len);
-      let last = ref (t.pos + len - 1) in
+      let last = ref (t.pos + pos + len - 1) in
       let pos = ref (t.pos + pos) in
       while is_space (String.unsafe_get t.buffer !pos) do
         incr pos
@@ -953,7 +953,7 @@ module Parser = struct
         decr last
       done;
       let len = !last - !pos + 1 in
-      String.sub t.buffer !pos len
+      if len < 0 then "" else String.sub t.buffer !pos len
 
     let rec index_rec t ch idx len =
       if idx = len then -1

http/test/test_parser.ml

@@ -15,6 +15,7 @@ let req =
    Cookie: wp_ozh_wsa_visits=2; wp_ozh_wsa_visit_lasttime=xxxxxxxxxx; \
    __utma=xxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.x; \
    __utmz=xxxxxxxxx.xxxxxxxxxx.x.x.utmccn=(referral)|utmcsr=reader.livedoor.com|utmcct=/reader/|utmcmd=referral\r\n\
+   Empty:    \r\n\
    \r\n"
 
 let assert_req_success ~here ~expected_req ~expected_consumed ?pos ?len buf =
@@ -69,13 +70,14 @@ let req_expected =
               __utma=xxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.xxxxxxxxxx.x; \
               __utmz=xxxxxxxxx.xxxxxxxxxx.x.x.utmccn=(referral)|utmcsr=reader.livedoor.com|utmcct=/reader/|utmcmd=referral"
            );
+           ("Empty", "");
          ])
     `GET "/wp-content/uploads/2010/03/hello-kitty-darth-vader-pink.jpg"
 
 let parse_single_request () =
   assert_req_success
     ~here:[ [%here] ]
-    ~expected_req:req_expected ~expected_consumed:706 req
+    ~expected_req:req_expected ~expected_consumed:718 req
 
 let reject_headers_with_space_before_colon () =
   let req =