add ?get_time_s param to create

src/Tiny_httpd.ml

@@ -490,10 +490,10 @@ module Request = struct
         )
 
   (* parse request, but not body (yet) *)
-  let parse_req_start ~buf (bs:byte_stream) : unit t option resp_result =
+  let parse_req_start ~get_time_s ~buf (bs:byte_stream) : unit t option resp_result =
     try
       let line = Byte_stream.read_line ~buf bs in
-      let start_time = Unix.gettimeofday () in
+      let start_time = get_time_s() in
       let meth, path, version =
         try
           let meth, path, version = Scanf.sscanf line "%s %s HTTP/1.%d\r" (fun x y z->x,y,z) in
@@ -566,8 +566,8 @@ module Request = struct
     | e -> bad_reqf 500 "failed to read body: %s" (Printexc.to_string e)
 
   module Internal_ = struct
-    let parse_req_start ?(buf=Buf_.create()) bs =
+    let parse_req_start ?(buf=Buf_.create()) ~get_time_s bs =
-      parse_req_start ~buf bs |> unwrap_resp_result
+      parse_req_start ~get_time_s ~buf bs |> unwrap_resp_result
 
     let parse_body ?(buf=Buf_.create()) req bs : _ t =
       parse_body_ ~tr_stream:(fun s->s) ~buf {req with body=bs} |> unwrap_resp_result
@@ -577,7 +577,7 @@ end
 (*$R
   let q = "GET hello HTTP/1.1\r\nHost: coucou\r\nContent-Length: 11\r\n\r\nsalutationsSOMEJUNK" in
   let str = Byte_stream.of_string q in
-  let r = Request.Internal_.parse_req_start str in
+  let r = Request.Internal_.parse_req_start ~get_time_s:(fun _ -> 0.) str in
   match r with
   | None -> assert_failure "should parse"
   | Some req ->
@@ -863,6 +863,8 @@ type t = {
 
   buf_size: int;
 
+  get_time_s : unit -> float;
+
   mutable handler: (string Request.t -> Response.t);
   (* toplevel handler, if any *)
 
@@ -1006,6 +1008,7 @@ let create
     ?(max_connections=32)
     ?(timeout=0.0)
     ?(buf_size=16 * 1_024)
+    ?(get_time_s=Unix.gettimeofday)
     ?(new_thread=(fun f -> ignore (Thread.create f () : Thread.t)))
     ?(addr="127.0.0.1") ?(port=8080) ?sock
     ?(middlewares=[])
@@ -1015,7 +1018,7 @@ let create
   let self = {
     new_thread; addr; port; sock; masksigpipe; handler; buf_size;
     running= true; sem_max_connections=Sem_.create max_connections;
-    path_handlers=[]; timeout;
+    path_handlers=[]; timeout; get_time_s;
     middlewares=[]; middlewares_sorted=lazy [];
   } in
   List.iter (fun (stage,m) -> add_middleware self ~stage m) middlewares;
@@ -1042,7 +1045,7 @@ let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
   let continue = ref true in
   while !continue && self.running do
     _debug (fun k->k "read next request");
-    match Request.parse_req_start ~buf is with
+    match Request.parse_req_start ~get_time_s:self.get_time_s ~buf is with
     | Ok None ->
       continue := false (* client is done *)
 

src/Tiny_httpd.mli

@@ -228,7 +228,9 @@ module Request : sig
     path_components: string list;
     query: (string*string) list;
     body: 'body;
-    start_time: float; (** @since NEXT_RELEASE *)
+    start_time: float;
+    (** Obtained via [get_time_s] in {!create}
+        @since NEXT_RELEASE *)
   }
   (** A request with method, path, host, headers, and a body, sent by a client.
 
@@ -238,8 +240,9 @@ module Request : sig
       entirely read as a string via {!read_body_full}.
 
       @since 0.6 The field [query] was added and contains the query parameters in ["?foo=bar,x=y"]
-
       @since 0.6 The field [path_components] is the part of the path that precedes [query] and is split on ["/"].
+      @since NEXT_RELEASE the type is a private alias
+      @since NEXT_RELEASE the field [start_time] was added
   *)
 
   val pp : Format.formatter -> string t -> unit
@@ -300,7 +303,7 @@ module Request : sig
   (**/**)
   (* for testing purpose, do not use *)
   module Internal_ : sig
-    val parse_req_start : ?buf:Buf_.t -> byte_stream -> unit t option
+    val parse_req_start : ?buf:Buf_.t -> get_time_s:(unit -> float) -> byte_stream -> unit t option
     val parse_body : ?buf:Buf_.t -> unit t -> byte_stream -> byte_stream t
   end
   (**/**)
@@ -503,6 +506,7 @@ val create :
   ?max_connections:int ->
   ?timeout:float ->
   ?buf_size:int ->
+  ?get_time_s:(unit -> float) ->
   ?new_thread:((unit -> unit) -> unit) ->
   ?addr:string ->
   ?port:int ->
@@ -537,6 +541,9 @@ val create :
       systemd on Linux (or launchd on macOS). If passed in, this socket will be
       used instead of the [addr] and [port]. If not passed in, those will be
       used. This parameter exists since 0.10.
+
+    @param get_time_s obtain the current timestamp in seconds.
+      This parameter exists since NEXT_RELEASE.
 *)
 
 val addr : t -> string