diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index 9d51056b..c522a6eb 100644 --- a/src/Tiny_httpd.ml +++ b/src/Tiny_httpd.ml @@ -30,7 +30,8 @@ end let create ?enable_logging ?(masksigpipe = not Sys.win32) ?max_connections ?(timeout = 0.0) ?buf_size ?(get_time_s = Unix.gettimeofday) ?(new_thread = fun f -> ignore (Thread.create f () : Thread.t)) - ?(addr = "127.0.0.1") ?(port = 8080) ?sock ?middlewares () : t = + ?(addr = "127.0.0.1") ?(port = 8080) ?sock ?head_middlewares ?middlewares () + : t = let max_connections = get_max_connection_ ?max_connections () in let server = { @@ -65,4 +66,5 @@ let create ?enable_logging ?(masksigpipe = not Sys.win32) ?max_connections let tcp_server () = tcp_server_builder end in let backend = (module B : IO_BACKEND) in - Server.create_from ?enable_logging ?buf_size ?middlewares ~backend () + Server.create_from ?enable_logging ?buf_size ?head_middlewares ?middlewares + ~backend () diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 92463446..7bad8e27 100644 --- a/src/Tiny_httpd.mli +++ b/src/Tiny_httpd.mli @@ -135,6 +135,7 @@ val create : ?addr:string -> ?port:int -> ?sock:Unix.file_descr -> + ?head_middlewares:Head_middleware.t list -> ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list -> unit -> t diff --git a/src/core/server.ml b/src/core/server.ml index 871671fc..46f2354d 100644 --- a/src/core/server.ml +++ b/src/core/server.ml @@ -88,6 +88,7 @@ type t = { mutable tcp_server: IO.TCP_server.t option; mutable handler: IO.Input.t Request.t -> Response.t; (** toplevel handler, if any *) + mutable head_middlewares: Head_middleware.t list; mutable middlewares: (int * Middleware.t) list; (** Global middlewares *) mutable middlewares_sorted: (int * Middleware.t) list lazy_t; (** sorted version of {!middlewares} *) @@ -128,6 +129,9 @@ let add_middleware ~stage self m = self.middlewares <- (stage, m) :: self.middlewares; self.middlewares_sorted <- lazy (sort_middlewares_ self.middlewares) +let add_head_middleware (self : t) m : unit = + self.head_middlewares <- m :: self.head_middlewares + let add_decode_request_cb self f = (* turn it into a middleware *) let m h req ~resp = @@ -258,6 +262,7 @@ let add_route_server_sent_handler ?accept ?(middlewares = []) self route f = let add_upgrade_handler ?(accept = fun _ -> Ok ()) ?(middlewares = []) (self : t) route f : unit = let ph req : handler_result option = + let middlewares = List.rev_append self.head_middlewares middlewares in if req.Request.meth <> `GET then None else ( @@ -274,7 +279,7 @@ let add_upgrade_handler ?(accept = fun _ -> Ok ()) ?(middlewares = []) let clear_bytes_ bs = Bytes.fill bs 0 (Bytes.length bs) '\x00' let create_from ?(enable_logging = not Log.dummy) ?(buf_size = 16 * 1_024) - ?(middlewares = []) ~backend () : t = + ?(head_middlewares = []) ?(middlewares = []) ~backend () : t = let handler _req = Response.fail ~code:404 "no top handler" in let self = { @@ -283,6 +288,7 @@ let create_from ?(enable_logging = not Log.dummy) ?(buf_size = 16 * 1_024) tcp_server = None; handler; path_handlers = []; + head_middlewares; middlewares = []; middlewares_sorted = lazy []; bytes_pool = diff --git a/src/core/server.mli b/src/core/server.mli index 4dcb5926..32d7586b 100644 --- a/src/core/server.mli +++ b/src/core/server.mli @@ -83,6 +83,7 @@ end val create_from : ?enable_logging:bool -> ?buf_size:int -> + ?head_middlewares:Head_middleware.t list -> ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list -> backend:(module IO_BACKEND) -> unit -> @@ -94,6 +95,7 @@ val create_from : {!set_top_handler} to specify how to handle incoming requests. @param buf_size size for buffers (since 0.11) + @param head_middlewares see {!add_head_middleware} for details (since NEXT_RELEASE) @param middlewares see {!add_middleware} for more details. @param enable_logging if true and [Logs] is installed, emit logs via Logs (since NEXT_RELEASE). @@ -152,6 +154,12 @@ val add_middleware : @since 0.11 *) +val add_head_middleware : t -> Head_middleware.t -> unit +(** Add a request-header only {!Head_middleware.t}. + This is called on requests, to modify them, and returns a new request + immediately. + @since NEXT_RELEASE *) + (** {2 Request handlers} *) val set_top_handler : t -> (IO.Input.t Request.t -> Response.t) -> unit