fix(security): enforce limits and timeouts in h1/h2 servers

- Add max_body_size enforcement with 413 responses
- Add read_timeout and request_timeout with 408 responses
- Implement lock-free buffer pooling via Kcas for thread-safety
- Use cryptographically secure random for CSRF, sessions, tokens, WebSocket
- Add secure_compare for constant-time auth comparison
- Add WebSocket origin validation and version checking
- Fix h2_server silent :path fallback (now returns 400)
- Replace String.concat with Buffer for body accumulation

bench/client/bench_client.ml

···
           | Hcs.Websocket.Connection_closed -> "Connection closed"
           | Hcs.Websocket.Protocol_error s -> "Protocol error: " ^ s
           | Hcs.Websocket.Io_error s -> "IO error: " ^ s
+          | Hcs.Websocket.Payload_too_large n ->
+              "Payload too large: " ^ string_of_int n ^ " bytes"
         in
         Printf.eprintf "WebSocket connect error: %s\n%!" err_msg
     | Ok ws ->

bin/hc.ml

···
         | Websocket.Connection_closed -> "Connection closed"
         | Websocket.Protocol_error s -> "Protocol error: " ^ s
         | Websocket.Io_error s -> "IO error: " ^ s
+        | Websocket.Payload_too_large n ->
+            "Payload too large: " ^ string_of_int n ^ " bytes"
       in
       Printf.eprintf "WebSocket error: %s\n" msg;
       exit 1
···
         | Error (Websocket.Protocol_error s) ->
             Printf.eprintf "Protocol error: %s\n" s
         | Error (Websocket.Io_error s) -> Printf.eprintf "IO error: %s\n" s
+        | Error (Websocket.Payload_too_large n) ->
+            Printf.eprintf "Payload too large: %d bytes\n" n
       in
       (* Only enter receive loop if we sent a message (otherwise just test connection) *)
       if Option.is_some ws_message then recv_loop ();

lib/dune

···
   bytesrw
   bytesrw.zlib
   bytesrw.zstd
-  mirage-crypto
-  mirage-crypto-rng
+   mirage-crypto
+   mirage-crypto-rng
+   mirage-crypto-rng.unix
   kcas
   kcas_data
   unix

lib/h1_server.ml

···
 
 (** {1 Read Buffer Pool} *)
 
+(** Lock-free buffer pool using Treiber stack via Kcas for thread-safe pooling.
+*)
 module Read_buffer_pool : sig
   val acquire : unit -> Bigstringaf.t * Cstruct.t
   val release : Bigstringaf.t -> unit
 end = struct
   let buffer_size = 0x4000
+  let max_pooled = 256
+  let pool : Bigstringaf.t list Kcas.Loc.t = Kcas.Loc.make []
+  let pool_size : int Kcas.Loc.t = Kcas.Loc.make 0
 
   let acquire () =
-    let buf = Bigstringaf.create buffer_size in
+    let buf =
+      Kcas.Xt.commit
+        {
+          tx =
+            (fun ~xt ->
+              match Kcas.Xt.get ~xt pool with
+              | [] -> None
+              | buf :: rest ->
+                  Kcas.Xt.set ~xt pool rest;
+                  Kcas.Xt.set ~xt pool_size (Kcas.Xt.get ~xt pool_size - 1);
+                  Some buf);
+        }
+    in
+    let buf =
+      match buf with Some b -> b | None -> Bigstringaf.create buffer_size
+    in
     (buf, Cstruct.of_bigarray buf ~off:0 ~len:buffer_size)
 
-  let release _ = ()
+  let release buf =
+    Kcas.Xt.commit
+      {
+        tx =
+          (fun ~xt ->
+            let size = Kcas.Xt.get ~xt pool_size in
+            if size < max_pooled then begin
+              Kcas.Xt.set ~xt pool (buf :: Kcas.Xt.get ~xt pool);
+              Kcas.Xt.set ~xt pool_size (size + 1)
+            end);
+      }
 end
 
 (** {1 Configuration} *)
···
   | `GET | `HEAD | `DELETE | `OPTIONS | `CONNECT | `TRACE -> true
   | `POST | `PUT | `PATCH | `Other _ -> false
 
-(** Create a lazy body reader from H1's body reader *)
-let make_body_reader (h1_body : H1.Body.Reader.t) : body_reader =
+exception Body_too_large
+
+let make_body_reader ?max_body_size (h1_body : H1.Body.Reader.t) : body_reader =
   let read_called = ref false in
   let closed = ref false in
-  let chunks = ref [] in
+  let body_buffer = Buffer.create 4096 in
+  let current_size = ref 0 in
+  let too_large = ref false in
   let done_promise, done_resolver = Eio.Promise.create () in
 
-  (* Start reading in background - will block until first chunk or EOF *)
+  let check_size len =
+    match max_body_size with
+    | Some max when Int64.of_int (!current_size + len) > max ->
+        too_large := true;
+        H1.Body.Reader.close h1_body;
+        Eio.Promise.resolve done_resolver ();
+        false
+    | _ ->
+        current_size := !current_size + len;
+        true
+  in
+
   let rec schedule_read () =
-    if not !closed then
+    if (not !closed) && not !too_large then
       H1.Body.Reader.schedule_read h1_body
         ~on_eof:(fun () -> Eio.Promise.resolve done_resolver ())
         ~on_read:(fun buf ~off ~len ->
-          (* Store chunk as Cstruct to avoid copying bigstring *)
-          let chunk = Cstruct.of_bigarray ~off ~len buf |> Cstruct.to_string in
-          chunks := chunk :: !chunks;
-          schedule_read ())
+          if check_size len then begin
+            Buffer.add_string body_buffer (Bigstringaf.substring buf ~off ~len);
+            schedule_read ()
+          end)
   in
 
   {
···
           else begin
             schedule_read ();
             Eio.Promise.await done_promise;
-            String.concat "" (List.rev !chunks)
+            if !too_large then raise Body_too_large
+            else Buffer.contents body_buffer
           end
         end);
     read_stream =
       (fun () ->
-        (* For streaming, we read one chunk at a time *)
-        if !closed then None
+        if !closed || !too_large then None
         else begin
           let chunk_promise, chunk_resolver = Eio.Promise.create () in
           let got_chunk = ref false in
···
               if not !got_chunk then Eio.Promise.resolve chunk_resolver None)
             ~on_read:(fun buf ~off ~len ->
               got_chunk := true;
-              let cs = Cstruct.of_bigarray ~off ~len buf in
-              Eio.Promise.resolve chunk_resolver (Some cs));
+              if check_size len then begin
+                let cs = Cstruct.of_bigarray ~off ~len buf in
+                Eio.Promise.resolve chunk_resolver (Some cs)
+              end
+              else Eio.Promise.resolve chunk_resolver None);
           Eio.Promise.await chunk_promise
         end);
     close =
···
     close = (fun () -> ());
   }
 
-let handle_connection handler flow =
+let respond_413 reqd =
+  let body = "Request Entity Too Large" in
+  let headers =
+    H1.Headers.of_list
+      [
+        ("Date", Date_cache.get ());
+        ("Content-Length", string_of_int (String.length body));
+        ("Connection", "close");
+      ]
+  in
+  let resp = H1.Response.create ~headers (`Code 413) in
+  H1.Reqd.respond_with_string reqd resp body
+
+let respond_408 reqd =
+  let body = "Request Timeout" in
+  let headers =
+    H1.Headers.of_list
+      [
+        ("Date", Date_cache.get ());
+        ("Content-Length", string_of_int (String.length body));
+        ("Connection", "close");
+      ]
+  in
+  let resp = H1.Response.create ~headers (`Code 408) in
+  H1.Reqd.respond_with_string reqd resp body
+
+let handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+    handler flow =
   let read_buffer, read_cstruct = Read_buffer_pool.acquire () in
   Fun.protect ~finally:(fun () -> Read_buffer_pool.release read_buffer)
   @@ fun () ->
···
     let req = H1.Reqd.request reqd in
     let h1_body = H1.Reqd.request_body reqd in
 
-    (* Create lazy body reader *)
     let body_reader =
       if method_has_no_body req.H1.Request.meth then begin
         H1.Body.Reader.close h1_body;
         empty_body_reader ()
       end
-      else make_body_reader h1_body
+      else make_body_reader ?max_body_size h1_body
     in
 
-    (* Build request with lazy body *)
     let request =
       {
         meth = req.H1.Request.meth;
···
       }
     in
 
-    (* Call user handler *)
-    let response = handler request in
-
-    (* Ensure body is closed if not read *)
-    body_reader.close ();
-
-    let date_header = ("Date", Date_cache.get ()) in
-    let filter_reserved headers =
-      List.filter
-        (fun (k, _) ->
-          let lk = String.lowercase_ascii k in
-          lk <> "content-length" && lk <> "date")
-        headers
+    let handle_request () =
+      match (clock, request_timeout) with
+      | Some clock, Some timeout ->
+          Eio.Time.with_timeout clock timeout (fun () ->
+              let response = handler request in
+              body_reader.close ();
+              Ok response)
+      | _ ->
+          let response = handler request in
+          body_reader.close ();
+          Ok response
     in
 
-    match response.response_body with
-    | Body_string body ->
-        let content_length = String.length body in
-        let headers =
-          H1.Headers.of_list
-            (date_header
-            :: ("Content-Length", string_of_int content_length)
-            :: filter_reserved response.headers)
+    match handle_request () with
+    | Error `Timeout ->
+        body_reader.close ();
+        respond_408 reqd
+    | exception Body_too_large ->
+        body_reader.close ();
+        respond_413 reqd
+    | Ok response -> (
+        let date_header = ("Date", Date_cache.get ()) in
+        let filter_reserved headers =
+          List.filter
+            (fun (k, _) ->
+              let lk = String.lowercase_ascii k in
+              lk <> "content-length" && lk <> "date")
+            headers
         in
-        let resp = H1.Response.create ~headers response.status in
-        H1.Reqd.respond_with_string reqd resp body
-    | Body_bigstring bstr ->
-        let content_length = Bigstringaf.length bstr in
-        let headers =
-          H1.Headers.of_list
-            (date_header
-            :: ("Content-Length", string_of_int content_length)
-            :: filter_reserved response.headers)
-        in
-        let resp = H1.Response.create ~headers response.status in
-        H1.Reqd.respond_with_bigstring reqd resp bstr
-    | Body_prebuilt { h1_response; body } ->
-        let headers =
-          H1.Headers.add h1_response.headers "Date" (Date_cache.get ())
-        in
-        let resp = { h1_response with H1.Response.headers } in
-        H1.Reqd.respond_with_bigstring reqd resp body
-    | Body_cached_prebuilt cached ->
-        let resp = get_cached_response cached in
-        H1.Reqd.respond_with_bigstring reqd resp cached.body
-    | Body_stream { content_length; next } ->
-        let headers =
-          match content_length with
-          | Some len ->
+
+        match response.response_body with
+        | Body_string body ->
+            let content_length = String.length body in
+            let headers =
               H1.Headers.of_list
                 (date_header
-                :: ("Content-Length", Int64.to_string len)
+                :: ("Content-Length", string_of_int content_length)
                 :: filter_reserved response.headers)
-          | None ->
+            in
+            let resp = H1.Response.create ~headers response.status in
+            H1.Reqd.respond_with_string reqd resp body
+        | Body_bigstring bstr ->
+            let content_length = Bigstringaf.length bstr in
+            let headers =
               H1.Headers.of_list
                 (date_header
-                :: ("Transfer-Encoding", "chunked")
+                :: ("Content-Length", string_of_int content_length)
                 :: filter_reserved response.headers)
-        in
-        let resp = H1.Response.create ~headers response.status in
-        let body_writer = H1.Reqd.respond_with_streaming reqd resp in
-        let rec write_chunks () =
-          match next () with
-          | None -> H1.Body.Writer.close body_writer
-          | Some cs ->
-              H1.Body.Writer.write_bigstring body_writer ~off:0
-                ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
-              let flushed, resolve = Eio.Promise.create () in
-              H1.Body.Writer.flush body_writer (fun () ->
-                  Eio.Promise.resolve resolve ());
-              Eio.Promise.await flushed;
-              write_chunks ()
-        in
-        write_chunks ()
+            in
+            let resp = H1.Response.create ~headers response.status in
+            H1.Reqd.respond_with_bigstring reqd resp bstr
+        | Body_prebuilt { h1_response; body } ->
+            let headers =
+              H1.Headers.add h1_response.headers "Date" (Date_cache.get ())
+            in
+            let resp = { h1_response with H1.Response.headers } in
+            H1.Reqd.respond_with_bigstring reqd resp body
+        | Body_cached_prebuilt cached ->
+            let resp = get_cached_response cached in
+            H1.Reqd.respond_with_bigstring reqd resp cached.body
+        | Body_stream { content_length; next } ->
+            let headers =
+              match content_length with
+              | Some len ->
+                  H1.Headers.of_list
+                    (date_header
+                    :: ("Content-Length", Int64.to_string len)
+                    :: filter_reserved response.headers)
+              | None ->
+                  H1.Headers.of_list
+                    (date_header
+                    :: ("Transfer-Encoding", "chunked")
+                    :: filter_reserved response.headers)
+            in
+            let resp = H1.Response.create ~headers response.status in
+            let body_writer = H1.Reqd.respond_with_streaming reqd resp in
+            let rec write_chunks () =
+              match next () with
+              | None -> H1.Body.Writer.close body_writer
+              | Some cs ->
+                  H1.Body.Writer.write_bigstring body_writer ~off:0
+                    ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
+                  let flushed, resolve = Eio.Promise.create () in
+                  H1.Body.Writer.flush body_writer (fun () ->
+                      Eio.Promise.resolve resolve ());
+                  Eio.Promise.await flushed;
+                  write_chunks ()
+            in
+            write_chunks ())
   in
 
   let error_handler ?request:_ _error start_response =
···
 
   let shutdown = ref false in
 
+  let do_read () =
+    match (clock, read_timeout) with
+    | Some clock, Some timeout ->
+        Eio.Time.with_timeout clock timeout (fun () ->
+            Ok (Eio.Flow.single_read flow read_cstruct))
+    | _ -> Ok (Eio.Flow.single_read flow read_cstruct)
+  in
+
   let rec read_loop () =
     if not !shutdown then
       match H1.Server_connection.next_read_operation conn with
       | `Read -> (
-          try
-            let n = Eio.Flow.single_read flow read_cstruct in
-            let _ = H1.Server_connection.read conn read_buffer ~off:0 ~len:n in
-            read_loop ()
-          with End_of_file ->
-            let _ =
-              H1.Server_connection.read_eof conn read_buffer ~off:0 ~len:0
-            in
-            shutdown := true)
+          match do_read () with
+          | Error `Timeout -> shutdown := true
+          | exception End_of_file ->
+              let _ =
+                H1.Server_connection.read_eof conn read_buffer ~off:0 ~len:0
+              in
+              shutdown := true
+          | Ok n ->
+              let _ =
+                H1.Server_connection.read conn read_buffer ~off:0 ~len:n
+              in
+              read_loop ())
       | `Yield -> H1.Server_connection.yield_reader conn read_loop
       | `Close | `Upgrade -> shutdown := true
   in
···
 
   Fiber.both read_loop write_loop
 
-let run ~sw ~net ?(config = default_config) handler =
+let run ~sw ~net ?clock ?(config = default_config) handler =
   ensure_gc_tuned ();
   let addr = `Tcp (Eio.Net.Ipaddr.V4.any, config.port) in
   let socket =
···
       ~reuse_port:config.reuse_port net addr
   in
   traceln "Server listening on port %d" config.port;
+  let max_body_size = config.max_body_size in
+  let read_timeout = Some config.read_timeout in
+  let request_timeout = Some config.request_timeout in
   let connection_handler flow _addr =
     if config.tcp_nodelay then set_tcp_nodelay flow;
-    handle_connection handler flow
+    handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+      handler flow
   in
   let on_error exn = traceln "Connection error: %s" (Printexc.to_string exn) in
   Eio.Net.run_server socket connection_handler
     ~max_connections:config.max_connections ~on_error
 
-let run_parallel ~sw ~net ~domain_mgr ?(config = default_config) handler =
+let run_parallel ~sw ~net ~domain_mgr ?clock ?(config = default_config) handler
+    =
   ensure_gc_tuned ();
   let domain_count = max 1 config.domain_count in
   let addr = `Tcp (Eio.Net.Ipaddr.V4.any, config.port) in
···
       ~reuse_port:config.reuse_port net addr
   in
   traceln "Server listening on port %d (%d domains)" config.port domain_count;
+  let max_body_size = config.max_body_size in
+  let read_timeout = Some config.read_timeout in
+  let request_timeout = Some config.request_timeout in
   let connection_handler flow _addr =
     if config.tcp_nodelay then set_tcp_nodelay flow;
-    handle_connection handler flow
+    handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+      handler flow
   in
   let on_error exn = traceln "Connection error: %s" (Printexc.to_string exn) in
   if domain_count <= 1 then

lib/h2_server.ml

···
 let make_h2_response ?(status = `OK) headers =
   H2.Response.create ~headers status
 
-(** {1 Internal helpers} *)
+(** Lock-free buffer pool using Treiber stack via Kcas for thread-safe pooling.
+*)
+module Read_buffer_pool : sig
+  val acquire : unit -> Bigstringaf.t * Cstruct.t
+  val release : Bigstringaf.t -> unit
+end = struct
+  let buffer_size = 0x4000
+  let max_pooled = 256
+  let pool : Bigstringaf.t list Kcas.Loc.t = Kcas.Loc.make []
+  let pool_size : int Kcas.Loc.t = Kcas.Loc.make 0
+
+  let acquire () =
+    let buf =
+      Kcas.Xt.commit
+        {
+          tx =
+            (fun ~xt ->
+              match Kcas.Xt.get ~xt pool with
+              | [] -> None
+              | buf :: rest ->
+                  Kcas.Xt.set ~xt pool rest;
+                  Kcas.Xt.set ~xt pool_size (Kcas.Xt.get ~xt pool_size - 1);
+                  Some buf);
+        }
+    in
+    let buf =
+      match buf with Some b -> b | None -> Bigstringaf.create buffer_size
+    in
+    (buf, Cstruct.of_bigarray buf ~off:0 ~len:buffer_size)
+
+  let release buf =
+    Kcas.Xt.commit
+      {
+        tx =
+          (fun ~xt ->
+            let size = Kcas.Xt.get ~xt pool_size in
+            if size < max_pooled then begin
+              Kcas.Xt.set ~xt pool (buf :: Kcas.Xt.get ~xt pool);
+              Kcas.Xt.set ~xt pool_size (size + 1)
+            end);
+      }
+end
 
 let set_tcp_nodelay flow =
   match Eio_unix.Resource.fd_opt flow with
···
 
 (** {1 Connection handling} *)
 
-let handle_connection handler flow =
-  let read_buffer_size = 0x4000 in
-  let read_buffer = Bigstringaf.create read_buffer_size in
+type body_result = Ok_body of string | Body_too_large | Missing_path
+
+let respond_error reqd status body =
+  let headers =
+    H2.Headers.of_list
+      [
+        ("content-length", string_of_int (String.length body));
+        ("date", Date_cache.get ());
+      ]
+  in
+  let resp = H2.Response.create ~headers status in
+  H2.Reqd.respond_with_string reqd resp body
 
+let handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+    handler flow =
+  let read_buffer, read_cstruct = Read_buffer_pool.acquire () in
+  Fun.protect ~finally:(fun () -> Read_buffer_pool.release read_buffer)
+  @@ fun () ->
   let request_handler reqd =
     let req = H2.Reqd.request reqd in
     let body_reader = H2.Reqd.request_body reqd in
 
-    let body =
+    let body_result =
       match req.meth with
       | `GET | `HEAD ->
           H2.Body.Reader.close body_reader;
-          ""
+          Ok_body ""
       | `POST | `PUT | `DELETE | `CONNECT | `OPTIONS | `TRACE | `Other _ ->
           let body_buffer = Buffer.create 4096 in
+          let current_size = ref 0 in
+          let too_large = ref false in
           let body_done_promise, body_done_resolver = Eio.Promise.create () in
           let rec read_body () =
             H2.Body.Reader.schedule_read body_reader
               ~on_eof:(fun () -> Eio.Promise.resolve body_done_resolver ())
               ~on_read:(fun buf ~off ~len ->
-                Buffer.add_string body_buffer
-                  (Bigstringaf.substring buf ~off ~len);
-                read_body ())
+                let new_size = !current_size + len in
+                match max_body_size with
+                | Some max when Int64.of_int new_size > max ->
+                    too_large := true;
+                    H2.Body.Reader.close body_reader;
+                    Eio.Promise.resolve body_done_resolver ()
+                | _ ->
+                    current_size := new_size;
+                    Buffer.add_string body_buffer
+                      (Bigstringaf.substring buf ~off ~len);
+                    read_body ())
           in
           read_body ();
           Eio.Promise.await body_done_promise;
-          Buffer.contents body_buffer
+          if !too_large then Body_too_large
+          else Ok_body (Buffer.contents body_buffer)
     in
 
-    let target =
-      match H2.Headers.get req.headers ":path" with Some p -> p | None -> "/"
-    in
-
-    let request = { meth = req.meth; target; headers = req.headers; body } in
-    let response = handler request in
-
-    match response.response_body with
-    | Body_string body ->
-        let headers =
-          H2.Headers.of_list
-            (("content-length", string_of_int (String.length body))
-            :: response.headers)
-        in
-        let resp = H2.Response.create ~headers response.status in
-        H2.Reqd.respond_with_string reqd resp body
-    | Body_bigstring bstr ->
-        let headers =
-          H2.Headers.of_list
-            (("content-length", string_of_int (Bigstringaf.length bstr))
-            :: response.headers)
-        in
-        let resp = H2.Response.create ~headers response.status in
-        H2.Reqd.respond_with_bigstring reqd resp bstr
-    | Body_prebuilt { h2_response; body } ->
-        H2.Reqd.respond_with_bigstring reqd h2_response body
-    | Body_stream { content_length; next } ->
-        let headers =
-          match content_length with
-          | Some len ->
-              H2.Headers.of_list
-                (("content-length", Int64.to_string len) :: response.headers)
-          | None -> H2.Headers.of_list response.headers
-        in
-        let resp = H2.Response.create ~headers response.status in
-        let body_writer = H2.Reqd.respond_with_streaming reqd resp in
-        let rec write_chunks () =
-          match next () with
-          | None -> H2.Body.Writer.close body_writer
-          | Some cs ->
-              H2.Body.Writer.write_bigstring body_writer ~off:0
-                ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
-              let flushed, resolve = Eio.Promise.create () in
-              H2.Body.Writer.flush body_writer (fun _result ->
-                  Eio.Promise.resolve resolve ());
-              Eio.Promise.await flushed;
-              write_chunks ()
+    match body_result with
+    | Body_too_large ->
+        respond_error reqd (`Code 413) "Request Entity Too Large"
+    | Missing_path -> respond_error reqd `Bad_request "Missing :path header"
+    | Ok_body body -> (
+        let target =
+          match H2.Headers.get req.headers ":path" with
+          | Some p -> Some p
+          | None -> None
         in
-        write_chunks ()
+        match target with
+        | None -> respond_error reqd `Bad_request "Missing :path header"
+        | Some target -> (
+            let request =
+              { meth = req.meth; target; headers = req.headers; body }
+            in
+            let handler_result =
+              match (clock, request_timeout) with
+              | Some clock, Some timeout ->
+                  Eio.Time.with_timeout clock timeout (fun () ->
+                      Ok (handler request))
+              | _ -> Ok (handler request)
+            in
+            match handler_result with
+            | Error `Timeout -> respond_error reqd (`Code 408) "Request Timeout"
+            | Ok response -> (
+                let date_header = ("date", Date_cache.get ()) in
+                match response.response_body with
+                | Body_string body ->
+                    let headers =
+                      H2.Headers.of_list
+                        (date_header
+                        :: ("content-length", string_of_int (String.length body))
+                        :: response.headers)
+                    in
+                    let resp = H2.Response.create ~headers response.status in
+                    H2.Reqd.respond_with_string reqd resp body
+                | Body_bigstring bstr ->
+                    let headers =
+                      H2.Headers.of_list
+                        (date_header
+                        :: ( "content-length",
+                             string_of_int (Bigstringaf.length bstr) )
+                        :: response.headers)
+                    in
+                    let resp = H2.Response.create ~headers response.status in
+                    H2.Reqd.respond_with_bigstring reqd resp bstr
+                | Body_prebuilt { h2_response; body } ->
+                    let headers =
+                      H2.Headers.add h2_response.H2.Response.headers "date"
+                        (Date_cache.get ())
+                    in
+                    let resp = { h2_response with H2.Response.headers } in
+                    H2.Reqd.respond_with_bigstring reqd resp body
+                | Body_stream { content_length; next } ->
+                    let headers =
+                      match content_length with
+                      | Some len ->
+                          H2.Headers.of_list
+                            (date_header
+                            :: ("content-length", Int64.to_string len)
+                            :: response.headers)
+                      | None ->
+                          H2.Headers.of_list (date_header :: response.headers)
+                    in
+                    let resp = H2.Response.create ~headers response.status in
+                    let body_writer =
+                      H2.Reqd.respond_with_streaming reqd resp
+                    in
+                    let rec write_chunks () =
+                      match next () with
+                      | None -> H2.Body.Writer.close body_writer
+                      | Some cs ->
+                          H2.Body.Writer.write_bigstring body_writer ~off:0
+                            ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
+                          let flushed, resolve = Eio.Promise.create () in
+                          H2.Body.Writer.flush body_writer (fun _result ->
+                              Eio.Promise.resolve resolve ());
+                          Eio.Promise.await flushed;
+                          write_chunks ()
+                    in
+                    write_chunks ())))
   in
 
   let error_handler ?request:_ _error start_response =
-    let resp_body = start_response H2.Headers.empty in
+    let resp_body =
+      start_response (H2.Headers.of_list [ ("date", Date_cache.get ()) ])
+    in
     H2.Body.Writer.write_string resp_body "Internal Server Error";
     H2.Body.Writer.close resp_body
   in
···
 
   let shutdown = ref false in
 
+  let do_read () =
+    match (clock, read_timeout) with
+    | Some clock, Some timeout ->
+        Eio.Time.with_timeout clock timeout (fun () ->
+            Ok (Eio.Flow.single_read flow read_cstruct))
+    | _ -> Ok (Eio.Flow.single_read flow read_cstruct)
+  in
+
   let read_loop () =
     let rec loop () =
       if not !shutdown then
         match H2.Server_connection.next_read_operation conn with
         | `Read -> (
-            let cs =
-              Cstruct.of_bigarray read_buffer ~off:0 ~len:read_buffer_size
-            in
-            try
-              let n = Eio.Flow.single_read flow cs in
-              let _ =
-                H2.Server_connection.read conn read_buffer ~off:0 ~len:n
-              in
-              loop ()
-            with End_of_file ->
-              let _ =
-                H2.Server_connection.read_eof conn read_buffer ~off:0 ~len:0
-              in
-              shutdown := true)
+            match do_read () with
+            | Error `Timeout -> shutdown := true
+            | exception End_of_file ->
+                let _ =
+                  H2.Server_connection.read_eof conn read_buffer ~off:0 ~len:0
+                in
+                shutdown := true
+            | Ok n ->
+                let _ =
+                  H2.Server_connection.read conn read_buffer ~off:0 ~len:n
+                in
+                loop ())
         | `Close -> shutdown := true
     in
     loop ()
···
 
 (** {1 Public API} *)
 
-let run ~sw ~net ?(config = H1_server.default_config) handler =
+let run ~sw ~net ?clock ?(config = H1_server.default_config) handler =
   let addr = `Tcp (Eio.Net.Ipaddr.V4.any, config.port) in
   let socket =
     Eio.Net.listen ~sw ~backlog:config.backlog ~reuse_addr:config.reuse_addr
       ~reuse_port:config.reuse_port net addr
   in
   traceln "HTTP/2 Server listening on port %d" config.port;
+  let max_body_size = config.max_body_size in
+  let read_timeout = Some config.read_timeout in
+  let request_timeout = Some config.request_timeout in
   let connection_handler flow _addr =
     if config.tcp_nodelay then set_tcp_nodelay flow;
-    handle_connection handler flow
+    handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+      handler flow
   in
   let on_error exn = traceln "Connection error: %s" (Printexc.to_string exn) in
   Eio.Net.run_server socket connection_handler
     ~max_connections:config.max_connections ~on_error
 
-let run_tls ~sw ~net ?(config = H1_server.default_config) ~tls_config handler =
+let run_tls ~sw ~net ?clock ?(config = H1_server.default_config) ~tls_config
+    handler =
   let addr = `Tcp (Eio.Net.Ipaddr.V4.any, config.port) in
   let socket =
     Eio.Net.listen ~sw ~backlog:config.backlog ~reuse_addr:config.reuse_addr
       ~reuse_port:config.reuse_port net addr
   in
   traceln "HTTP/2 Server (TLS) listening on port %d" config.port;
+  let max_body_size = config.max_body_size in
+  let read_timeout = Some config.read_timeout in
+  let request_timeout = Some config.request_timeout in
   let connection_handler flow _addr =
     if config.tcp_nodelay then set_tcp_nodelay flow;
     match Tls_config.Server.to_tls_config tls_config with
···
     | Ok tls_cfg -> (
         try
           let tls_flow = Tls_eio.server_of_flow tls_cfg flow in
-          handle_connection handler tls_flow
+          handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+            handler tls_flow
         with
         | Tls_eio.Tls_failure failure ->
             traceln "TLS error: %s" (Tls_config.failure_to_string failure)
···
   Eio.Net.run_server socket connection_handler
     ~max_connections:config.max_connections ~on_error
 
-let run_parallel ~sw ~net ~domain_mgr ?(config = H1_server.default_config)
-    handler =
+let run_parallel ~sw ~net ~domain_mgr ?clock
+    ?(config = H1_server.default_config) handler =
   let domain_count = max 1 config.domain_count in
   let addr = `Tcp (Eio.Net.Ipaddr.V4.any, config.port) in
   let socket =
···
   in
   traceln "HTTP/2 Server listening on port %d (%d domains)" config.port
     domain_count;
+  let max_body_size = config.max_body_size in
+  let read_timeout = Some config.read_timeout in
+  let request_timeout = Some config.request_timeout in
   let connection_handler flow _addr =
     if config.tcp_nodelay then set_tcp_nodelay flow;
-    handle_connection handler flow
+    handle_connection ?clock ?read_timeout ?request_timeout ?max_body_size
+      handler flow
   in
   let on_error exn = traceln "Connection error: %s" (Printexc.to_string exn) in
   if domain_count <= 1 then

lib/plug/basic_auth.ml

···
 
     Implements RFC 7617 Basic authentication. *)
 
+let secure_compare a b =
+  let len_a = String.length a in
+  let len_b = String.length b in
+  if len_a <> len_b then false
+  else
+    let result = ref 0 in
+    for i = 0 to len_a - 1 do
+      result := !result lor (Char.code a.[i] lxor Char.code b.[i])
+    done;
+    !result = 0
+
 (** Decode base64 credentials from Authorization header *)
 let decode_credentials auth_header =
   let prefix = "Basic " in
···
     @param username Expected username
     @param password Expected password *)
 let create_static ~realm ~username ~password : Core.t =
-  create ~realm ~validate:(fun u p -> u = username && p = password)
+  create ~realm ~validate:(fun u p ->
+      secure_compare u username && secure_compare p password)
 
 (** Create basic auth plug with credential map.
 
···
     =
   create ~realm ~validate:(fun u p ->
       match Hashtbl.find_opt credentials u with
-      | Some expected -> expected = p
+      | Some expected -> secure_compare expected p
       | None -> false)

lib/plug/csrf.ml

···
 
     Implements Double Submit Cookie pattern for CSRF protection. *)
 
-(** Generate a random CSRF token *)
-let generate_token () =
-  let bytes = Stdlib.Bytes.create 32 in
-  for i = 0 to 31 do
-    Stdlib.Bytes.set bytes i (Char.chr (Random.int 256))
-  done;
-  Base64.encode_string ~alphabet:Base64.uri_safe_alphabet
-    (Stdlib.Bytes.to_string bytes)
+let generate_token () = Secure_random.token ~bytes:32 ()
 
 (** Extract token from cookie header *)
 let get_cookie_token ~cookie_name (req : Server.request) : string option =

lib/plug/session.ml

···
   Buffer.add_string buf same_site;
   Buffer.contents buf
 
-let generate_id () =
-  let b = Bytes.create 16 in
-  for i = 0 to 15 do
-    Bytes.set b i (Char.chr (Random.int 256))
-  done;
-  Token.b64_encode (Bytes.unsafe_to_string b)
+let generate_id () = Secure_random.token ~bytes:16 ()
 
 (** Create session plug with configurable storage and cookie options. *)
 let create ~store ?(cookie_name = "_session") ?(secure = true)

lib/plug/token.ml

···
     if String.length secret >= 32 then String.sub secret 0 32
     else Digestif.SHA256.(digest_string secret |> to_raw_string)
   in
-  let nonce =
-    let b = Bytes.create 12 in
-    for i = 0 to 11 do
-      Bytes.set b i (Char.chr (Random.int 256))
-    done;
-    Bytes.unsafe_to_string b
-  in
+  let nonce = Secure_random.generate 12 in
   let key = Mirage_crypto.AES.GCM.of_secret aes_key in
   let ciphertext =
     Mirage_crypto.AES.GCM.authenticate_encrypt ~key ~nonce data

lib/secure_random.ml

···
+let initialized = ref false
+
+let ensure_initialized () =
+  if not !initialized then begin
+    Mirage_crypto_rng_unix.use_default ();
+    initialized := true
+  end
+
+let generate n =
+  ensure_initialized ();
+  Mirage_crypto_rng.generate n
+
+let generate_bytes n = Bytes.of_string (Mirage_crypto_rng.generate n)
+
+let int bound =
+  if bound <= 0 then invalid_arg "Secure_random.int: bound must be positive";
+  let rec sample () =
+    let s = Mirage_crypto_rng.generate 8 in
+    let v =
+      (Char.code s.[0] lsl 56)
+      lor (Char.code s.[1] lsl 48)
+      lor (Char.code s.[2] lsl 40)
+      lor (Char.code s.[3] lsl 32)
+      lor (Char.code s.[4] lsl 24)
+      lor (Char.code s.[5] lsl 16)
+      lor (Char.code s.[6] lsl 8)
+      lor Char.code s.[7]
+    in
+    let v = v land max_int in
+    let limit = max_int - (max_int mod bound) in
+    if v < limit then v mod bound else sample ()
+  in
+  sample ()
+
+let token ?(bytes = 32) () =
+  let raw = generate bytes in
+  Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet raw
+
+let uuid () =
+  let bytes = generate_bytes 16 in
+  Bytes.set bytes 6
+    (Char.chr (Char.code (Bytes.get bytes 6) land 0x0f lor 0x40));
+  Bytes.set bytes 8
+    (Char.chr (Char.code (Bytes.get bytes 8) land 0x3f lor 0x80));
+  let hex = Bytes.create 36 in
+  let hex_chars = "0123456789abcdef" in
+  let pos = ref 0 in
+  for i = 0 to 15 do
+    if i = 4 || i = 6 || i = 8 || i = 10 then begin
+      Bytes.set hex !pos '-';
+      incr pos
+    end;
+    let b = Char.code (Bytes.get bytes i) in
+    Bytes.set hex !pos hex_chars.[b lsr 4];
+    incr pos;
+    Bytes.set hex !pos hex_chars.[b land 0x0f];
+    incr pos
+  done;
+  Bytes.to_string hex

lib/server.ml

···
 type handler = request -> response
 type ws_handler = Websocket.t -> unit
 
+type ws_config = {
+  origin_policy : Websocket.origin_policy;
+  max_payload_size : int;
+}
+
+let default_ws_config =
+  {
+    origin_policy = Websocket.Allow_all;
+    max_payload_size = Websocket.default_max_payload_size;
+  }
+
 let respond ?(status = `OK) ?(headers = []) body =
   Response.make ~status ~headers body
 
···
 (** {1 Internal: HTTP/1.1 Connection Handler} *)
 
 module H1_handler = struct
-  let handle ~handler ~ws_handler ~initial_data flow =
+  let handle ~handler ~ws_handler ?(ws_config = default_ws_config)
+      ?max_body_size ~initial_data flow =
     let buffer_size = 16384 in
     let read_buffer = Bigstringaf.create buffer_size in
     let read_cstruct =
···
       (* Check for WebSocket upgrade *)
       if Option.is_some ws_handler && Websocket.is_upgrade_request req.headers
       then begin
-        match Websocket.get_websocket_key req.headers with
-        | Some key ->
-            ws_upgrade := Some key;
+        match
+          Websocket.validate_origin ~policy:ws_config.origin_policy req.headers
+        with
+        | Error reason ->
             H1.Body.Reader.close h1_body;
-            let accept = Websocket.compute_accept_key key in
+            let body = "Forbidden: " ^ reason in
             let headers =
               H1.Headers.of_list
                 [
-                  ("upgrade", "websocket");
-                  ("connection", "Upgrade");
-                  ("sec-websocket-accept", accept);
+                  ("date", Date_cache.get ());
+                  ("content-length", string_of_int (String.length body));
                 ]
             in
-            H1.Reqd.respond_with_upgrade reqd headers
-        | None ->
-            H1.Body.Reader.close h1_body;
-            let headers =
-              H1.Headers.of_list
-                [ ("date", Date_cache.get ()); ("content-length", "11") ]
-            in
-            let resp = H1.Response.create ~headers `Bad_request in
-            H1.Reqd.respond_with_string reqd resp "Bad Request"
+            let resp = H1.Response.create ~headers `Forbidden in
+            H1.Reqd.respond_with_string reqd resp body
+        | Ok () -> (
+            match Websocket.validate_websocket_version req.headers with
+            | Error _reason ->
+                H1.Body.Reader.close h1_body;
+                let body = "Upgrade Required" in
+                let headers =
+                  H1.Headers.of_list
+                    [
+                      ("date", Date_cache.get ());
+                      ("content-length", string_of_int (String.length body));
+                      ( "sec-websocket-version",
+                        Websocket.supported_websocket_version );
+                    ]
+                in
+                let resp = H1.Response.create ~headers (`Code 426) in
+                H1.Reqd.respond_with_string reqd resp body
+            | Ok () -> (
+                match Websocket.get_websocket_key req.headers with
+                | Some key ->
+                    ws_upgrade := Some key;
+                    H1.Body.Reader.close h1_body;
+                    let accept = Websocket.compute_accept_key key in
+                    let headers =
+                      H1.Headers.of_list
+                        [
+                          ("upgrade", "websocket");
+                          ("connection", "Upgrade");
+                          ("sec-websocket-accept", accept);
+                        ]
+                    in
+                    H1.Reqd.respond_with_upgrade reqd headers
+                | None ->
+                    H1.Body.Reader.close h1_body;
+                    let headers =
+                      H1.Headers.of_list
+                        [
+                          ("date", Date_cache.get ()); ("content-length", "11");
+                        ]
+                    in
+                    let resp = H1.Response.create ~headers `Bad_request in
+                    H1.Reqd.respond_with_string reqd resp "Bad Request"))
       end
       else begin
         (* Regular HTTP/1.1 request *)
         (* Read body for POST/PUT, skip for GET/HEAD *)
-        let body =
+        let body_result =
           match req.meth with
           | `GET | `HEAD | `DELETE | `OPTIONS | `CONNECT | `TRACE ->
               H1.Body.Reader.close h1_body;
-              ""
+              Ok ""
           | `POST | `PUT | `Other _ ->
               let body_buffer = Buffer.create 4096 in
+              let body_size = ref 0 in
+              let too_large = ref false in
               let body_done, resolver = Eio.Promise.create () in
               let rec read_body () =
                 H1.Body.Reader.schedule_read h1_body
                   ~on_eof:(fun () -> Eio.Promise.resolve resolver ())
                   ~on_read:(fun buf ~off ~len ->
-                    Buffer.add_string body_buffer
-                      (Bigstringaf.substring buf ~off ~len);
-                    read_body ())
+                    let new_size = !body_size + len in
+                    match max_body_size with
+                    | Some max when Int64.of_int new_size > max ->
+                        too_large := true;
+                        H1.Body.Reader.close h1_body;
+                        Eio.Promise.resolve resolver ()
+                    | _ ->
+                        body_size := new_size;
+                        Buffer.add_string body_buffer
+                          (Bigstringaf.substring buf ~off ~len);
+                        read_body ())
               in
               read_body ();
               Eio.Promise.await body_done;
-              Buffer.contents body_buffer
+              if !too_large then Error `Body_too_large
+              else Ok (Buffer.contents body_buffer)
         in
-
-        let request =
-          {
-            meth = req.meth;
-            target = req.target;
-            headers = h1_headers_to_list req.headers;
-            body;
-            version = HTTP_1_1;
-          }
-        in
-        let response : Response.t = handler request in
-
-        let date_header = ("date", Date_cache.get ()) in
-        match response.Response.body with
-        | Response.Prebuilt_body prebuilt -> Prebuilt.respond_h1 reqd prebuilt
-        | Response.Empty ->
+        match body_result with
+        | Error `Body_too_large ->
+            let body = "Request body too large" in
             let headers =
               H1.Headers.of_list
-                (date_header :: ("content-length", "0") :: response.headers)
-            in
-            let resp = H1.Response.create ~headers response.status in
-            H1.Reqd.respond_with_string reqd resp ""
-        | Response.String body ->
-            let headers =
-              H1.Headers.of_list
-                (date_header
-                :: ("content-length", string_of_int (String.length body))
-                :: response.headers)
+                [
+                  ("date", Date_cache.get ());
+                  ("content-length", string_of_int (String.length body));
+                ]
             in
-            let resp = H1.Response.create ~headers response.status in
+            let resp = H1.Response.create ~headers (`Code 413) in
             H1.Reqd.respond_with_string reqd resp body
-        | Response.Bigstring body ->
-            let headers =
-              H1.Headers.of_list
-                (date_header
-                :: ("content-length", string_of_int (Bigstringaf.length body))
-                :: response.headers)
+        | Ok body -> (
+            let request =
+              {
+                meth = req.meth;
+                target = req.target;
+                headers = h1_headers_to_list req.headers;
+                body;
+                version = HTTP_1_1;
+              }
             in
-            let resp = H1.Response.create ~headers response.status in
-            H1.Reqd.respond_with_bigstring reqd resp body
-        | Response.Cstruct cs ->
-            let len = Cstruct.length cs in
-            let headers =
-              H1.Headers.of_list
-                (date_header
-                :: ("content-length", string_of_int len)
-                :: response.headers)
-            in
-            let resp = H1.Response.create ~headers response.status in
-            let body_writer = H1.Reqd.respond_with_streaming reqd resp in
-            H1.Body.Writer.write_bigstring body_writer ~off:cs.off ~len
-              cs.buffer;
-            H1.Body.Writer.close body_writer
-        | Response.Stream { content_length; next } ->
-            let headers =
-              match content_length with
-              | Some len ->
+            let response : Response.t = handler request in
+
+            let date_header = ("date", Date_cache.get ()) in
+            match response.Response.body with
+            | Response.Prebuilt_body prebuilt ->
+                Prebuilt.respond_h1 reqd prebuilt
+            | Response.Empty ->
+                let headers =
+                  H1.Headers.of_list
+                    (date_header :: ("content-length", "0") :: response.headers)
+                in
+                let resp = H1.Response.create ~headers response.status in
+                H1.Reqd.respond_with_string reqd resp ""
+            | Response.String body ->
+                let headers =
                   H1.Headers.of_list
                     (date_header
-                    :: ("content-length", Int64.to_string len)
+                    :: ("content-length", string_of_int (String.length body))
                     :: response.headers)
-              | None ->
+                in
+                let resp = H1.Response.create ~headers response.status in
+                H1.Reqd.respond_with_string reqd resp body
+            | Response.Bigstring body ->
+                let headers =
                   H1.Headers.of_list
                     (date_header
-                    :: ("transfer-encoding", "chunked")
+                    :: ( "content-length",
+                         string_of_int (Bigstringaf.length body) )
+                    :: response.headers)
+                in
+                let resp = H1.Response.create ~headers response.status in
+                H1.Reqd.respond_with_bigstring reqd resp body
+            | Response.Cstruct cs ->
+                let len = Cstruct.length cs in
+                let headers =
+                  H1.Headers.of_list
+                    (date_header
+                    :: ("content-length", string_of_int len)
                     :: response.headers)
-            in
-            let resp = H1.Response.create ~headers response.status in
-            let body_writer = H1.Reqd.respond_with_streaming reqd resp in
-            let rec write_chunks () =
-              match next () with
-              | None -> H1.Body.Writer.close body_writer
-              | Some cs ->
-                  H1.Body.Writer.write_bigstring body_writer ~off:0
-                    ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
-                  (* Flush to ensure data is sent immediately (required for SSE) *)
-                  let flushed, resolve = Eio.Promise.create () in
-                  H1.Body.Writer.flush body_writer (fun () ->
-                      Eio.Promise.resolve resolve ());
-                  Eio.Promise.await flushed;
-                  write_chunks ()
-            in
-            write_chunks ()
+                in
+                let resp = H1.Response.create ~headers response.status in
+                let body_writer = H1.Reqd.respond_with_streaming reqd resp in
+                H1.Body.Writer.write_bigstring body_writer ~off:cs.off ~len
+                  cs.buffer;
+                H1.Body.Writer.close body_writer
+            | Response.Stream { content_length; next } ->
+                let headers =
+                  match content_length with
+                  | Some len ->
+                      H1.Headers.of_list
+                        (date_header
+                        :: ("content-length", Int64.to_string len)
+                        :: response.headers)
+                  | None ->
+                      H1.Headers.of_list
+                        (date_header
+                        :: ("transfer-encoding", "chunked")
+                        :: response.headers)
+                in
+                let resp = H1.Response.create ~headers response.status in
+                let body_writer = H1.Reqd.respond_with_streaming reqd resp in
+                let rec write_chunks () =
+                  match next () with
+                  | None -> H1.Body.Writer.close body_writer
+                  | Some cs ->
+                      H1.Body.Writer.write_bigstring body_writer ~off:0
+                        ~len:(Cstruct.length cs) (Cstruct.to_bigarray cs);
+                      (* Flush to ensure data is sent immediately (required for SSE) *)
+                      let flushed, resolve = Eio.Promise.create () in
+                      H1.Body.Writer.flush body_writer (fun () ->
+                          Eio.Promise.resolve resolve ());
+                      Eio.Promise.await flushed;
+                      write_chunks ()
+                in
+                write_chunks ())
       end
     in
 
···
                 closed = false;
                 is_client = false;
                 read_buf = Buffer.create 4096;
+                max_payload_size = ws_config.max_payload_size;
               }
             in
             (try ws_h ws with _ -> ());
···
     | None -> ()
 
   (** Direct H1 handler - no protocol detection, no initial data buffering *)
-  let handle_direct ~handler flow =
+  let handle_direct ?max_body_size ~handler flow =
     let buffer_size = 16384 in
     let read_buffer = Bigstringaf.create buffer_size in
     let read_cstruct =
···
       let h1_body = H1.Reqd.request_body reqd in
 
       (* Read body for POST/PUT, skip for GET/HEAD *)
-      let body =
+      let body_result =
         match req.meth with
         | `GET | `HEAD | `DELETE | `OPTIONS | `CONNECT | `TRACE ->
             H1.Body.Reader.close h1_body;
-            ""
+            Ok ""
         | `POST | `PUT | `Other _ ->
             let body_buffer = Buffer.create 4096 in
+            let body_size = ref 0 in
+            let too_large = ref false in
             let body_done, resolver = Eio.Promise.create () in
             let rec read_body () =
               H1.Body.Reader.schedule_read h1_body
                 ~on_eof:(fun () -> Eio.Promise.resolve resolver ())
                 ~on_read:(fun buf ~off ~len ->
-                  Buffer.add_string body_buffer
-                    (Bigstringaf.substring buf ~off ~len);
-                  read_body ())
+                  let new_size = !body_size + len in
+                  match max_body_size with
+                  | Some max when Int64.of_int new_size > max ->
+                      too_large := true;
+                      H1.Body.Reader.close h1_body;
+                      Eio.Promise.resolve resolver ()
+                  | _ ->
+                      body_size := new_size;
+                      Buffer.add_string body_buffer
+                        (Bigstringaf.substring buf ~off ~len);
+                      read_body ())
             in
             read_body ();
             Eio.Promise.await body_done;
-            Buffer.contents body_buffer
-      in
-
-      let request =
-        {
-          meth = req.meth;
-          target = req.target;
-          headers = h1_headers_to_list req.headers;
-          body;
-          version = HTTP_1_1;
-        }
+            if !too_large then Error `Body_too_large
+            else Ok (Buffer.contents body_buffer)
       in
-      let response : Response.t = handler request in
-
-      let date_header = ("date", Date_cache.get ()) in
-      match response.Response.body with
-      | Response.Prebuilt_body prebuilt -> Prebuilt.respond_h1 reqd prebuilt
-      | Response.Empty ->
-          let headers =
-            H1.Headers.of_list
-              (date_header :: ("content-length", "0") :: response.headers)
-          in
-          let resp = H1.Response.create ~headers response.status in
-          H1.Reqd.respond_with_string reqd resp ""
-      | Response.String body ->
+      match body_result with
+      | Error `Body_too_large ->
+          let body = "Request body too large" in
           let headers =
             H1.Headers.of_list
-              (date_header
-              :: ("content-length", string_of_int (String.length body))
-              :: response.headers)
+              [
+                ("date", Date_cache.get ());
+                ("content-length", string_of_int (String.length body));
+              ]
           in
-          let resp = H1.Response.create ~headers response.status in
+          let resp = H1.Response.create ~headers (`Code 413) in
           H1.Reqd.respond_with_string reqd resp body
-      | Response.Bigstring body ->
-          let headers =
-            H1.Headers.of_list
-              (date_header
-              :: ("content-length", string_of_int (Bigstringaf.length body))
-              :: response.headers)
+      | Ok body -> (
+          let request =
+            {
+              meth = req.meth;
+              target = req.target;
+              headers = h1_headers_to_list req.headers;
+              body;
+              version = HTTP_1_1;
+            }
           in
-          let resp = H1.Response.create ~headers response.status in
-          H1.Reqd.respond_with_bigstring reqd resp body
-      | Response.Cstruct cs ->
-          let len = Cstruct.length cs in
-          let headers =
-            H1.Headers.of_list
-              (date_header
-              :: ("content-length", string_of_int len)
-              :: response.headers)
-          in
-          let resp = H1.Response.create ~headers response.status in
-          let body_writer = H1.Reqd.respond_with_streaming reqd resp in
-          H1.Body.Writer.write_bigstring body_writer ~off:cs.off ~len cs.buffer;
-          H1.Body.Writer.close body_writer
-      | Response.Stream { content_length; next } ->
-          let headers =
-            match content_length with
-            | Some len ->
+          let response : Response.t = handler request in
+
+          let date_header = ("date", Date_cache.get ()) in
+          match response.Response.body with
+          | Response.Prebuilt_body prebuilt -> Prebuilt.respond_h1 reqd prebuilt
+          | Response.Empty ->
+              let headers =
+                H1.Headers.of_list
+                  (date_header :: ("content-length", "0") :: response.headers)
+              in
+              let resp = H1.Response.create ~headers response.status in
+              H1.Reqd.respond_with_string reqd resp ""
+          | Response.String body ->
+              let headers =
                 H1.Headers.of_list
                   (date_header
-                  :: ("content-length", Int64.to_string len)
+                  :: ("content-length", string_of_int (String.length body))
                   :: response.headers)
-            | None ->
+              in
+              let resp = H1.Response.create ~headers response.status in
+              H1.Reqd.respond_with_string reqd resp body
+          | Response.Bigstring body ->
+              let headers =
                 H1.Headers.of_list
                   (date_header
-                  :: ("transfer-encoding", "chunked")
+                  :: ("content-length", string_of_int (Bigstringaf.length body))
                   :: response.headers)
-          in
-          let resp = H1.Response.create ~headers response.status in
-          let body_writer = H1.Reqd.respond_with_streaming reqd resp in
-          let rec write_chunks () =
-            match next () with
-            | None -> H1.Body.Writer.close body_writer
-            | Some cs ->
-                H1.Body.Writer.write_bigstring body_writer ~off:cs.off
-                  ~len:(Cstruct.length cs) cs.buffer;
-                let flushed, resolve = Eio.Promise.create () in
-                H1.Body.Writer.flush body_writer (fun () ->
-                    Eio.Promise.resolve resolve ());
-                Eio.Promise.await flushed;
-                write_chunks ()
-          in
-          write_chunks ()
+              in
+              let resp = H1.Response.create ~headers response.status in
+              H1.Reqd.respond_with_bigstring reqd resp body
+          | Response.Cstruct cs ->
+              let len = Cstruct.length cs in
+              let headers =
+                H1.Headers.of_list
+                  (date_header
+                  :: ("content-length", string_of_int len)
+                  :: response.headers)
+              in
+              let resp = H1.Response.create ~headers response.status in
+              let body_writer = H1.Reqd.respond_with_streaming reqd resp in
+              H1.Body.Writer.write_bigstring body_writer ~off:cs.off ~len
+                cs.buffer;
+              H1.Body.Writer.close body_writer
+          | Response.Stream { content_length; next } ->
+              let headers =
+                match content_length with
+                | Some len ->
+                    H1.Headers.of_list
+                      (date_header
+                      :: ("content-length", Int64.to_string len)
+                      :: response.headers)
+                | None ->
+                    H1.Headers.of_list
+                      (date_header
+                      :: ("transfer-encoding", "chunked")
+                      :: response.headers)
+              in
+              let resp = H1.Response.create ~headers response.status in
+              let body_writer = H1.Reqd.respond_with_streaming reqd resp in
+              let rec write_chunks () =
+                match next () with
+                | None -> H1.Body.Writer.close body_writer
+                | Some cs ->
+                    H1.Body.Writer.write_bigstring body_writer ~off:cs.off
+                      ~len:(Cstruct.length cs) cs.buffer;
+                    let flushed, resolve = Eio.Promise.create () in
+                    H1.Body.Writer.flush body_writer (fun () ->
+                        Eio.Promise.resolve resolve ());
+                    Eio.Promise.await flushed;
+                    write_chunks ()
+              in
+              write_chunks ())
     in
 
     let error_handler ?request:_ _error start_response =
···
   let handle ~config ~handler ~ws_handler tls_cfg flow =
     try
       let tls_flow = Tls_eio.server_of_flow tls_cfg flow in
+      let max_body_size = config.max_body_size in
       match config.protocol with
-      | Http1_only ->
-          (* No ALPN check, direct H1 *)
-          H1_handler.handle_direct ~handler tls_flow
-      | Http2_only ->
-          (* No ALPN check, direct H2 *)
-          H2_handler.handle_direct ~handler tls_flow
+      | Http1_only -> H1_handler.handle_direct ?max_body_size ~handler tls_flow
+      | Http2_only -> H2_handler.handle_direct ~handler tls_flow
       | Auto | Auto_websocket -> (
-          (* Check ALPN negotiated protocol *)
           match Tls_config.negotiated_protocol tls_flow with
           | Some Tls_config.HTTP_2 -> H2_handler.handle_direct ~handler tls_flow
           | Some Tls_config.HTTP_1_1 | None ->
               if config.protocol = Auto_websocket then
                 H1_handler.handle ~handler ~ws_handler:(Some ws_handler)
-                  ~initial_data:"" tls_flow
-              else H1_handler.handle_direct ~handler tls_flow)
+                  ?max_body_size ~initial_data:"" tls_flow
+              else H1_handler.handle_direct ?max_body_size ~handler tls_flow)
     with
     | Tls_eio.Tls_failure failure ->
         traceln "TLS error: %s" (Tls_config.failure_to_string failure)
···
 (** {1 Internal: Connection Handler} *)
 
 let handle_connection ~config ~handler ~ws_handler flow =
+  let max_body_size = config.max_body_size in
   match config.protocol with
-  | Http1_only ->
-      (* Fastest path: direct H1, no detection *)
-      H1_handler.handle_direct ~handler flow
-  | Http2_only ->
-      (* Direct H2 (h2c) *)
-      H2_handler.handle_direct ~handler flow
+  | Http1_only -> H1_handler.handle_direct ?max_body_size ~handler flow
+  | Http2_only -> H2_handler.handle_direct ~handler flow
   | Auto | Auto_websocket -> (
-      (* Peek to detect protocol *)
       match peek_bytes flow h2_preface_prefix_len with
-      | Error `Eof -> () (* Client disconnected immediately *)
+      | Error `Eof -> ()
       | Error (`Exn exn) ->
           traceln "Connection error: %s" (Printexc.to_string exn)
       | Ok initial_data ->
···
             H2_handler.handle ~handler ~initial_data flow
           else if config.protocol = Auto_websocket then
             H1_handler.handle ~handler ~ws_handler:(Some ws_handler)
-              ~initial_data flow
-          else H1_handler.handle ~handler ~ws_handler:None ~initial_data flow)
+              ?max_body_size ~initial_data flow
+          else
+            H1_handler.handle ~handler ~ws_handler:None ?max_body_size
+              ~initial_data flow)
 
 (** {1 Public API} *)
 

lib/websocket.ml

···
   in
   { opcode = Close; extension = 0; final = true; content }
 
+let default_max_payload_size = 16 * 1024 * 1024
+
 type t = {
   flow : Eio.Flow.two_way_ty r;
   mutable closed : bool;
-  is_client : bool;  (** Client must mask frames *)
+  is_client : bool;
   read_buf : Buffer.t;
+  max_payload_size : int;
 }
-(** WebSocket connection *)
 
-(** Error type *)
-type error = Connection_closed | Protocol_error of string | Io_error of string
+type error =
+  | Connection_closed
+  | Protocol_error of string
+  | Io_error of string
+  | Payload_too_large of int
 
 (** {1 Cryptographic helpers} *)
 
···
 (** Compute the Sec-WebSocket-Accept value *)
 let compute_accept_key key = b64_encoded_sha1sum (key ^ websocket_uuid)
 
-(** {1 Random number generation for masking} *)
-
 module Rng = struct
-  let initialized = ref false
-
-  let init () =
-    if not !initialized then begin
-      Random.self_init ();
-      initialized := true
-    end
-
-  (** Generate n random bytes *)
-  let generate n =
-    init ();
-    let buf = Bytes.create n in
-    for i = 0 to n - 1 do
-      Bytes.set buf i (Char.chr (Random.int 256))
-    done;
-    Bytes.to_string buf
+  let generate n = Secure_random.generate n
 end
 
 (** {1 Frame parsing/serialization} *)
···
   loop 0;
   Cstruct.to_string buf
 
-(** Parse a frame from flow *)
-let read_frame ~is_client flow =
+let read_frame ~is_client ~max_payload_size flow =
   try
-    (* Read first 2 bytes *)
     let header = read_exactly flow 2 in
     let b0 = Char.code header.[0] in
     let b1 = Char.code header.[1] in
···
     let masked = b1 land 0x80 <> 0 in
     let len0 = b1 land 0x7f in
 
-    (* Server receiving from client: frames must be masked
-       Client receiving from server: frames must not be masked *)
     if (not is_client) && not masked then
       Error (Protocol_error "Client frames must be masked")
     else if is_client && masked then
       Error (Protocol_error "Server frames must not be masked")
     else begin
-      (* Read extended length if needed *)
       let len =
         if len0 < 126 then len0
         else if len0 = 126 then begin
···
           (Char.code ext.[0] lsl 8) lor Char.code ext.[1]
         end
         else begin
-          (* 64-bit length *)
           let ext = read_exactly flow 8 in
           let len = ref 0 in
           for i = 0 to 7 do
···
         end
       in
 
-      (* Control frames cannot be fragmented and max 125 bytes *)
-      if Opcode.is_control opcode && ((not final) || len > 125) then
+      if len > max_payload_size then Error (Payload_too_large len)
+      else if Opcode.is_control opcode && ((not final) || len > 125) then
         Error (Protocol_error "Invalid control frame")
       else begin
-        (* Read mask key if present *)
         let mask_key = if masked then Some (read_exactly flow 4) else None in
-
-        (* Read payload *)
         let content = if len > 0 then read_exactly flow len else "" in
         let content =
           match mask_key with
           | Some key -> xor_mask key content
           | None -> content
         in
-
         Ok { opcode; extension; final; content }
       end
     end
···
 let send_pong t ?(content = "") () =
   send t (make_frame ~opcode:Pong ~content ())
 
-(** Receive a frame *)
 let recv t =
   if t.closed then Error Connection_closed
   else
-    match read_frame ~is_client:t.is_client t.flow with
+    match
+      read_frame ~is_client:t.is_client ~max_payload_size:t.max_payload_size
+        t.flow
+    with
     | Ok frame ->
-        (* Handle control frames *)
         (match frame.opcode with
         | Close ->
             t.closed <- true;
-            (* Echo close frame back *)
             ignore (send t (close_frame (-1)))
-        | Ping ->
-            (* Auto-respond to pings with pong *)
-            ignore (send_pong t ~content:frame.content ())
+        | Ping -> ignore (send_pong t ~content:frame.content ())
         | _ -> ());
         Ok frame
     | Error e ->
···
 (** Get the Sec-WebSocket-Key from request headers *)
 let get_websocket_key headers = H1.Headers.get headers "sec-websocket-key"
 
+let supported_websocket_version = "13"
+
+let get_websocket_version headers =
+  H1.Headers.get headers "sec-websocket-version"
+
+let validate_websocket_version headers =
+  match get_websocket_version headers with
+  | Some v when v = supported_websocket_version -> Ok ()
+  | Some v -> Error ("Unsupported WebSocket version: " ^ v)
+  | None -> Error "Missing Sec-WebSocket-Version header"
+
+(** Get the Origin header from request headers *)
+let get_origin headers = H1.Headers.get headers "origin"
+
+(** Origin policy for WebSocket connections.
+    - [`Allow_all] accepts connections from any origin (NOT RECOMMENDED for
+      production)
+    - [`Allow_list origins] only accepts connections from the specified origins
+    - [`Allow_same_origin] only accepts connections where Origin matches the
+      Host header *)
+type origin_policy = Allow_all | Allow_list of string list | Allow_same_origin
+
+(** Validate Origin header against policy.
+    @param policy The origin validation policy
+    @param headers The request headers (must contain Origin, may contain Host)
+    @return [Ok ()] if origin is allowed, [Error reason] if rejected *)
+let validate_origin ~policy headers =
+  match policy with
+  | Allow_all -> Ok ()
+  | Allow_list allowed -> (
+      match get_origin headers with
+      | None ->
+          (* Missing Origin header - could be same-origin request or non-browser client.
+             For security, we require Origin for Allow_list policy. *)
+          Error "Missing Origin header"
+      | Some origin ->
+          let origin_lower = String.lowercase_ascii origin in
+          if
+            List.exists
+              (fun allowed -> String.lowercase_ascii allowed = origin_lower)
+              allowed
+          then Ok ()
+          else Error ("Origin not allowed: " ^ origin))
+  | Allow_same_origin -> (
+      match (get_origin headers, H1.Headers.get headers "host") with
+      | None, _ ->
+          (* No Origin header - likely same-origin or non-browser, allow it *)
+          Ok ()
+      | Some origin, Some host ->
+          (* Extract host from origin URL (e.g., "https://example.com" -> "example.com") *)
+          let origin_host =
+            let uri = Uri.of_string origin in
+            match Uri.host uri with
+            | Some h -> (
+                match Uri.port uri with
+                | Some p -> h ^ ":" ^ string_of_int p
+                | None -> h)
+            | None -> origin
+          in
+          if String.lowercase_ascii origin_host = String.lowercase_ascii host
+          then Ok ()
+          else Error ("Cross-origin request: " ^ origin ^ " vs " ^ host)
+      | Some origin, None ->
+          Error ("Missing Host header for origin check: " ^ origin))
+
 (** Generate random base64-encoded key for client handshake *)
 let generate_key () = Base64.encode_exn (Rng.generate 16)
 
···
                       header_lines
                   in
 
-                  (* Validate accept key *)
                   let accept = List.assoc_opt "sec-websocket-accept" headers in
                   match accept with
                   | Some a when a = expected_accept ->
···
                           closed = false;
                           is_client = true;
                           read_buf = Buffer.create 4096;
+                          max_payload_size = default_max_payload_size;
                         }
                   | Some a ->
                       let buf =
···
 
 (** {1 Server API} *)
 
-(** Accept a WebSocket upgrade from an HTTP connection. Returns a WebSocket
-    connection after sending the upgrade response. *)
-let accept ~flow ~key =
+let accept ?max_payload_size ~flow ~key () =
+  let max_payload_size =
+    Option.value max_payload_size ~default:default_max_payload_size
+  in
   let accept = compute_accept_key key in
   let buf = Buffer.create (String.length accept + 128) in
   Buffer.add_string buf "HTTP/1.1 101 Switching Protocols\r\n";
···
         closed = false;
         is_client = false;
         read_buf = Buffer.create 4096;
+        max_payload_size;
       }
   with exn -> Error (Io_error (Printexc.to_string exn))

test/test_websocket.ml

···
                 (match e with
                 | Hcs.Websocket.Connection_closed -> "closed"
                 | Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
-                | Hcs.Websocket.Io_error s -> "io: " ^ s))
+                | Hcs.Websocket.Io_error s -> "io: " ^ s
+                | Hcs.Websocket.Payload_too_large n ->
+                    "payload too large: " ^ string_of_int n))
       | Error _ -> Eio.traceln "  FAIL: send error");
       Hcs.Websocket.close ws
   | Error e ->
···
         (match e with
         | Hcs.Websocket.Connection_closed -> "closed"
         | Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
-        | Hcs.Websocket.Io_error s -> "io: " ^ s));
+        | Hcs.Websocket.Io_error s -> "io: " ^ s
+        | Hcs.Websocket.Payload_too_large n ->
+            "payload too large: " ^ string_of_int n));
 
   Eio.traceln "Test 3: WebSocket on /ws/chat path...";
   (match
···
         (match e with
         | Hcs.Websocket.Connection_closed -> "closed"
         | Hcs.Websocket.Protocol_error s -> "protocol: " ^ s
-        | Hcs.Websocket.Io_error s -> "io: " ^ s));
+        | Hcs.Websocket.Io_error s -> "io: " ^ s
+        | Hcs.Websocket.Payload_too_large n ->
+            "payload too large: " ^ string_of_int n));
 
   Eio.traceln "Test 4: Multiple messages...";
   (match