mirror of
https://github.com/c-cube/tiny_httpd.git
synced 2025-12-06 03:05:29 -05:00
463 lines
14 KiB
OCaml
463 lines
14 KiB
OCaml
|
|
(** {1 Tiny Http Server}
|
|
|
|
This library implements a very simple, basic HTTP/1.1 server using blocking
|
|
IOs and threads. Basic routing based on {!Scanf} is provided for convenience,
|
|
so that several handlers can be registered.
|
|
|
|
It is possible to use a thread pool, see {!create}'s argument [new_thread].
|
|
|
|
The [echo] example (see [src/examples/echo.ml]) demonstrates some of the
|
|
features by declaring a few endpoints, including one for uploading files:
|
|
|
|
{[
|
|
module S = Tiny_httpd
|
|
|
|
let () =
|
|
let server = S.create () in
|
|
(* say hello *)
|
|
S.add_path_handler ~meth:`GET server
|
|
"/hello/%s@/" (fun name _req ->
|
|
S.Response.make_string (Ok ("hello " ^name ^"!\n")));
|
|
(* echo request *)
|
|
S.add_path_handler server
|
|
"/echo" (fun req -> S.Response.make_string
|
|
(Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
|
|
S.add_path_handler ~meth:`PUT server
|
|
"/upload/%s" (fun path req ->
|
|
try
|
|
let oc = open_out @@ "/tmp/" ^ path in
|
|
output_string oc req.S.Request.body;
|
|
flush oc;
|
|
S.Response.make_string (Ok "uploaded file")
|
|
with e ->
|
|
S.Response.fail ~code:500 "couldn't upload file: %s"
|
|
(Printexc.to_string e)
|
|
);
|
|
Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
|
|
match S.run server with
|
|
| Ok () -> ()
|
|
| Error e -> raise e
|
|
]}
|
|
|
|
It is then possible to query it using curl:
|
|
|
|
{[
|
|
$ dune exec src/examples/echo.exe &
|
|
listening on http://127.0.0.1:8080
|
|
|
|
# the path "hello/name" greets you.
|
|
$ curl -X GET http://localhost:8080/hello/quadrarotaphile
|
|
hello quadrarotaphile!
|
|
|
|
# the path "echo" just prints the request.
|
|
$ curl -X GET http://localhost:8080/echo --data "howdy y'all"
|
|
echo:
|
|
{meth=GET;
|
|
headers=Host: localhost:8080
|
|
User-Agent: curl/7.66.0
|
|
Accept: */*
|
|
Content-Length: 10
|
|
Content-Type: application/x-www-form-urlencoded;
|
|
path="/echo"; body="howdy y'all"}
|
|
|
|
|
|
]}
|
|
|
|
*)
|
|
|
|
|
|
(** {2 Tiny buffer implementation}
|
|
|
|
These buffers are used to avoid allocating too many byte arrays when
|
|
processing streams and parsing requests.
|
|
*)
|
|
|
|
module Buf_ : sig
|
|
type t
|
|
val size : t -> int
|
|
val clear : t -> unit
|
|
val create : ?size:int -> unit -> t
|
|
val contents : t -> string
|
|
end
|
|
|
|
(** {2 Generic stream of data}
|
|
|
|
Streams are used to represent a series of bytes that can arrive progressively.
|
|
For example, an uploaded file will be sent as a series of chunks. *)
|
|
|
|
type byte_stream = {
|
|
bs_fill_buf: unit -> (bytes * int * int);
|
|
(** See the current slice of the internal buffer as [bytes, i, len],
|
|
where the slice is [bytes[i] .. [bytes[i+len-1]]].
|
|
Can block to refill the buffer if there is currently no content.
|
|
If [len=0] then there is no more data. *)
|
|
bs_consume: int -> unit;
|
|
(** Consume n bytes from the buffer. This should only be called with [n <= len]
|
|
after a call to [is_fill_buf] that returns a slice of length [len]. *)
|
|
bs_close: unit -> unit;
|
|
(** Close the stream. *)
|
|
}
|
|
(** A buffered stream, with a view into the current buffer (or refill if empty),
|
|
and a function to consume [n] bytes.
|
|
See {!Byte_stream} for more details. *)
|
|
|
|
module Byte_stream : sig
|
|
type t = byte_stream
|
|
|
|
val close : t -> unit
|
|
|
|
val empty : t
|
|
|
|
val of_chan : in_channel -> t
|
|
(** Make a buffered stream from the given channel. *)
|
|
|
|
val of_chan_close_noerr : in_channel -> t
|
|
(** Same as {!of_chan} but the [close] method will never fail. *)
|
|
|
|
val of_bytes : ?i:int -> ?len:int -> bytes -> t
|
|
(** A stream that just returns the slice of bytes starting from [i]
|
|
and of length [len]. *)
|
|
|
|
val of_string : string -> t
|
|
|
|
val iter : (bytes -> int -> int -> unit) -> t -> unit
|
|
(** Iterate on the chunks of the stream
|
|
@since 0.3 *)
|
|
|
|
val to_chan : out_channel -> t -> unit
|
|
(** Write the stream to the channel.
|
|
@since 0.3 *)
|
|
|
|
val with_file : string -> (t -> 'a) -> 'a
|
|
(** Open a file with given name, and obtain an input stream
|
|
on its content. When the function returns, the stream (and file) are closed. *)
|
|
|
|
val read_line : ?buf:Buf_.t -> t -> string
|
|
(** Read a line from the stream.
|
|
@param buf a buffer to (re)use. Its content will be cleared. *)
|
|
|
|
val read_all : ?buf:Buf_.t -> t -> string
|
|
(** Read the whole stream into a string.
|
|
@param buf a buffer to (re)use. Its content will be cleared. *)
|
|
end
|
|
|
|
(** {2 Methods} *)
|
|
|
|
module Meth : sig
|
|
type t = [
|
|
| `GET
|
|
| `PUT
|
|
| `POST
|
|
| `HEAD
|
|
| `DELETE
|
|
]
|
|
(** A HTTP method.
|
|
For now we only handle a subset of these.
|
|
|
|
See https://tools.ietf.org/html/rfc7231#section-4 *)
|
|
|
|
val pp : Format.formatter -> t -> unit
|
|
val to_string : t -> string
|
|
end
|
|
|
|
(** {2 Headers}
|
|
|
|
Headers are metadata associated with a request or response. *)
|
|
|
|
module Headers : sig
|
|
type t = (string * string) list
|
|
(** The header files of a request or response.
|
|
|
|
Neither the key nor the value can contain ['\r'] or ['\n'].
|
|
See https://tools.ietf.org/html/rfc7230#section-3.2 *)
|
|
|
|
val get : ?f:(string->string) -> string -> t -> string option
|
|
(** [get k headers] looks for the header field with key [k].
|
|
@param f if provided, will transform the value before it is returned. *)
|
|
|
|
val set : string -> string -> t -> t
|
|
(** [set k v headers] sets the key [k] to value [v].
|
|
It erases any previous entry for [k] *)
|
|
|
|
val remove : string -> t -> t
|
|
(** Remove the key from the headers, if present. *)
|
|
|
|
val contains : string -> t -> bool
|
|
(** Is there a header with the given key? *)
|
|
|
|
val pp : Format.formatter -> t -> unit
|
|
(** Pretty print the headers. *)
|
|
end
|
|
|
|
(** {2 Requests}
|
|
|
|
Requests are sent by a client, e.g. a web browser or cURL. *)
|
|
|
|
module Request : sig
|
|
type 'body t = {
|
|
meth: Meth.t;
|
|
host: string;
|
|
headers: Headers.t;
|
|
path: string;
|
|
body: 'body;
|
|
}
|
|
(** A request with method, path, host, headers, and a body, sent by a client.
|
|
|
|
The body is polymorphic because the request goes through
|
|
several transformations. First it has no body, as only the request
|
|
and headers are read; then it has a stream body; then the body might be
|
|
entirely read as a string via {!read_body_full}. *)
|
|
|
|
val pp : Format.formatter -> string t -> unit
|
|
(** Pretty print the request and its body *)
|
|
|
|
val pp_ : Format.formatter -> _ t -> unit
|
|
(** Pretty print the request without its body *)
|
|
|
|
val headers : _ t -> Headers.t
|
|
(** List of headers of the request, including ["Host"] *)
|
|
|
|
val get_header : ?f:(string->string) -> _ t -> string -> string option
|
|
|
|
val get_header_int : _ t -> string -> int option
|
|
|
|
val set_header : 'a t -> string -> string -> 'a t
|
|
|
|
val host : _ t -> string
|
|
(** Host field of the request. It also appears in the headers. *)
|
|
|
|
val meth : _ t -> Meth.t
|
|
(** Method for the request. *)
|
|
|
|
val path : _ t -> string
|
|
(** Request path. *)
|
|
|
|
val body : 'b t -> 'b
|
|
(** Request body, possibly empty. *)
|
|
|
|
val limit_body_size : max_size:int -> byte_stream t -> byte_stream t
|
|
(** Limit the body size to [max_size] bytes, or return
|
|
a [413] error.
|
|
@since 0.3
|
|
*)
|
|
|
|
val read_body_full : byte_stream t -> string t
|
|
(** Read the whole body into a string. Potentially blocking. *)
|
|
end
|
|
|
|
(** {2 Response Codes} *)
|
|
|
|
module Response_code : sig
|
|
type t = int
|
|
(** A standard HTTP code.
|
|
|
|
https://tools.ietf.org/html/rfc7231#section-6 *)
|
|
|
|
val ok : t
|
|
(** The code [200] *)
|
|
|
|
val not_found : t
|
|
(** The code [404] *)
|
|
|
|
val descr : t -> string
|
|
(** A description of some of the error codes.
|
|
NOTE: this is not complete (yet). *)
|
|
end
|
|
|
|
(** {2 Responses}
|
|
|
|
Responses are what a http server, such as {!Tiny_httpd}, send back to
|
|
the client to answer a {!Request.t}*)
|
|
|
|
module Response : sig
|
|
type body = [`String of string | `Stream of byte_stream]
|
|
(** Body of a response, either as a simple string,
|
|
or a stream of bytes. *)
|
|
|
|
type t = {
|
|
code: Response_code.t; (** HTTP response code. See {!Response_code}. *)
|
|
headers: Headers.t; (** Headers of the reply. Some will be set by [Tiny_httpd] automatically. *)
|
|
body: body; (** Body of the response. Can be empty. *)
|
|
}
|
|
(** A response to send back to a client. *)
|
|
|
|
val make_raw :
|
|
?headers:Headers.t ->
|
|
code:Response_code.t ->
|
|
string ->
|
|
t
|
|
(** Make a response from its raw components, with a string body.
|
|
Use [""] to not send a body at all. *)
|
|
|
|
val make_raw_stream :
|
|
?headers:Headers.t ->
|
|
code:Response_code.t ->
|
|
byte_stream ->
|
|
t
|
|
(** Same as {!make_raw} but with a stream body. The body will be sent with
|
|
the chunked transfer-encoding. *)
|
|
|
|
val make :
|
|
?headers:Headers.t ->
|
|
(body, Response_code.t * string) result -> t
|
|
(** [make r] turns a result into a response.
|
|
|
|
- [make (Ok body)] replies with [200] and the body.
|
|
- [make (Error (code,msg))] replies with the given error code
|
|
and message as body.
|
|
*)
|
|
|
|
val make_string :
|
|
?headers:Headers.t ->
|
|
(string, Response_code.t * string) result -> t
|
|
(** Same as {!make} but with a string body. *)
|
|
|
|
val make_stream :
|
|
?headers:Headers.t ->
|
|
(byte_stream, Response_code.t * string) result -> t
|
|
(** Same as {!make} but with a stream body. *)
|
|
|
|
val fail : ?headers:Headers.t -> code:int ->
|
|
('a, unit, string, t) format4 -> 'a
|
|
(** Make the current request fail with the given code and message.
|
|
Example: [fail ~code:404 "oh noes, %s not found" "waldo"].
|
|
*)
|
|
|
|
val fail_raise : code:int -> ('a, unit, string, 'b) format4 -> 'a
|
|
(** Similar to {!fail} but raises an exception that exits the current handler.
|
|
This should not be used outside of a (path) handler.
|
|
Example: [fail_raise ~code:404 "oh noes, %s not found" "waldo"; never_executed()]
|
|
*)
|
|
|
|
val pp : Format.formatter -> t -> unit
|
|
(** Pretty print the response. *)
|
|
end
|
|
|
|
(** {2 Server} *)
|
|
|
|
type t
|
|
(** A HTTP server. See {!create} for more details. *)
|
|
|
|
val create :
|
|
?masksigpipe:bool ->
|
|
?max_connections:int ->
|
|
?new_thread:((unit -> unit) -> unit) ->
|
|
?addr:string ->
|
|
?port:int ->
|
|
unit ->
|
|
t
|
|
(** Create a new webserver.
|
|
|
|
The server will not do anything until {!run} is called on it.
|
|
Before starting the server, one can use {!add_path_handler} and
|
|
{!set_top_handler} to specify how to handle incoming requests.
|
|
|
|
@param masksigpipe if true, block the signal {!Sys.sigpipe} which otherwise
|
|
tends to kill client threads when they try to write on broken sockets. Default: [true].
|
|
|
|
@param new_thread a function used to spawn a new thread to handle a
|
|
new client connection. By default it is {!Thread.create} but one
|
|
could use a thread pool instead.
|
|
|
|
@param max_connections maximum number of simultaneous connections.
|
|
@param addr address (IPv4 or IPv6) to listen on. Default ["127.0.0.1"].
|
|
@param port to listen on. Default [8080].
|
|
*)
|
|
|
|
val addr : t -> string
|
|
(** Address on which the server listens. *)
|
|
|
|
val is_ipv6 : t -> bool
|
|
(** [is_ipv6 server] returns [true] iff the address of the server is an IPv6 address.
|
|
@since 0.3 *)
|
|
|
|
val port : t -> int
|
|
(** Port on which the server listens. *)
|
|
|
|
val add_decode_request_cb :
|
|
t ->
|
|
(unit Request.t -> (unit Request.t * (byte_stream -> byte_stream)) option) -> unit
|
|
(** Add a callback for every request.
|
|
The callback can provide a stream transformer and a new request (with
|
|
modified headers, typically).
|
|
A possible use is to handle decompression by looking for a [Transfer-Encoding]
|
|
header and returning a stream transformer that decompresses on the fly.
|
|
*)
|
|
|
|
val add_encode_response_cb:
|
|
t -> (unit Request.t -> Response.t -> Response.t option) -> unit
|
|
(** Add a callback for every request/response pair.
|
|
Similarly to {!add_encode_response_cb} the callback can return a new
|
|
response, for example to compress it.
|
|
The callback is given the query with only its headers,
|
|
as well as the current response.
|
|
*)
|
|
|
|
val set_top_handler : t -> (string Request.t -> Response.t) -> unit
|
|
(** Setup a handler called by default.
|
|
|
|
This handler is called with any request not accepted by any handler
|
|
installed via {!add_path_handler}.
|
|
If no top handler is installed, unhandled paths will return a [404] not found. *)
|
|
|
|
val add_path_handler :
|
|
?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
|
|
?meth:Meth.t ->
|
|
t ->
|
|
('a, Scanf.Scanning.in_channel,
|
|
'b, 'c -> string Request.t -> Response.t, 'a -> 'd, 'd) format6 ->
|
|
'c -> unit
|
|
(** [add_path_handler server "/some/path/%s@/%d/" f]
|
|
calls [f "foo" 42 request] when a request with path "some/path/foo/42/"
|
|
is received.
|
|
|
|
This uses {!Scanf}'s splitting, which has some gotchas (in particular,
|
|
["%s"] is eager, so it's generally necessary to delimit its
|
|
scope with a ["@/"] delimiter. The "@" before a character indicates it's
|
|
a separator.
|
|
|
|
Note that the handlers are called in the reverse order of their addition,
|
|
so the last registered handler can override previously registered ones.
|
|
|
|
@param meth if provided, only accept requests with the given method.
|
|
Typically one could react to [`GET] or [`PUT].
|
|
@param accept should return [Ok()] if the given request (before its body
|
|
is read) should be accepted, [Error (code,message)] if it's to be rejected (e.g. because
|
|
its content is too big, or for some permission error).
|
|
See the {!http_of_dir} program for an example of how to use [accept] to
|
|
filter uploads that are too large before the upload even starts.
|
|
*)
|
|
|
|
val add_path_handler_stream :
|
|
?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
|
|
?meth:Meth.t ->
|
|
t ->
|
|
('a, Scanf.Scanning.in_channel,
|
|
'b, 'c -> byte_stream Request.t -> Response.t, 'a -> 'd, 'd) format6 ->
|
|
'c -> unit
|
|
(** Similar to {!add_path_handler}, but where the body of the request
|
|
is a stream of bytes that has not been read yet.
|
|
This is useful when one wants to stream the body directly into a parser,
|
|
json decoder (such as [Jsonm]) or into a file.
|
|
@since 0.3 *)
|
|
|
|
val stop : t -> unit
|
|
(** Ask the server to stop. This might not have an immediate effect
|
|
as {!run} might currently be waiting on IO. *)
|
|
|
|
val run : t -> (unit, exn) result
|
|
(** Run the main loop of the server, listening on a socket
|
|
described at the server's creation time, using [new_thread] to
|
|
start a thread for each new client.
|
|
|
|
This returns [Ok ()] if the server exits gracefully, or [Error e] if
|
|
it exits with an error. *)
|
|
|
|
(**/**)
|
|
|
|
val _debug : ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit) -> unit
|
|
val _enable_debug: bool -> unit
|
|
|
|
(**/**)
|
|
|