devkit

Development kit - general purpose library
IN THIS PACKAGE
Module Devkit_core . Httpev
module Ev = Libevent
val buffer_size : int
module Hidden : sig ... end

Server

type max_time = {
headers : Time.t;
body : Time.t;
send : Time.t;
}
type config = {
connection : Unix.sockaddr;
backlog : int;
log_epipe : bool;
mutable debug : bool;(*

more logging

*)
events : Ev.event_base;
access_log : out_channel ref;
access_log_enabled : bool;
name : string;
max_request_size : int;
auth : (string * string * string) option;
max_clients : int;(*

limit on total number of requests in processing at any point of time

*)
max_data_childs : int;
max_data_waiting : int;
yield : bool;(*

do Lwt_unix.yield () after accepting connection to give other lwt threads chance to run (set to true when http requests processing causes other threads to stuck)

*)
single : bool;(*

only process one request at a time (intended for preforked workers)

*)
exit_thread : unit Lwt.t option;(*

if set, stop accepting connections as soon as exit_thread terminates (defaults to Daemon.should_exit_lwt)

*)
reuseport : bool;
nodelay : bool;
strict_args : bool;(*

default false, if enabled - will in particular fail on "/path?arg1&arg2", why would anyone want that?

*)
max_time : max_time;
cors_allow_all : bool;
}

server configuration

val default_max_time : max_time
val default : config
include module type of struct include Httpev_common end
type encoding =
| Gzip
| Identity
type meth = [
| `GET
| `POST
| `PUT
| `PATCH
| `DELETE
| `HEAD
| `OPTIONS
]
type request = {
addr : Unix.sockaddr;
url : string;
path : string;
args : (string * string) list;
conn : Time.t;
recv : Time.t;
meth : meth;
headers : (string * string) list;
body : string;
version : int * int;
id : int;
socket : Unix.file_descr;
line : string;(*

request line

*)
mutable blocking : unit IO.output option;
encoding : encoding;
}
type reply_status = [
| `Ok
| `Created
| `No_content
| `Found
| `Moved
| `Bad_request
| `Unauthorized
| `Payment_required
| `Forbidden
| `Not_found
| `Method_not_allowed
| `Not_acceptable
| `Conflict
| `Length_required
| `Request_too_large
| `I'm_a_teapot
| `Internal_server_error
| `Not_implemented
| `Service_unavailable
| `Version_not_supported
| `Custom of string
]
type extended_reply_status = [
| reply_status
| `No_reply
]
type 'status reply' = 'status * (string * string) list * string
val show_method : [< `DELETE | `GET | `HEAD | `OPTIONS | `PATCH | `POST | `PUT ] -> string
val method_of_string : string -> [> `DELETE | `GET | `HEAD | `OPTIONS | `PATCH | `POST | `PUT ]
val show_client_addr : request -> string
val client_addr : request -> Unix.inet_addr * int
val client_ip : request -> Unix.inet_addr
val find_header : request -> string -> string
val header_exn : request -> string -> string
val header_safe : request -> string -> string
val header_referer : request -> string
val show_request : request -> string
val status_code : reply_status -> int
val show_http_reply : reply_status -> string
val cors_preflight_allow_all : [> `No_content ] * (string * string) list * string
type partial_body = {
line1 : string;
content_length : int option;
parsed_headers : (string * string) list;
buf : ExtLib.Buffer.t;
}
type request_state =
| Headers of ExtLib.Buffer.t
| Body of partial_body
| Body_lwt of int
| Ready of request
type client = {
fd : Unix.file_descr;
req_id : int;
time_conn : Time.t;(*

time when client connected

*)
sockaddr : Unix.sockaddr;
mutable req : request_state;
server : server;
}

client state

and server = {
listen_socket : Unix.file_descr;
mutable total : int;
mutable active : int;
mutable errors : int;
mutable reject : int;
reqs : ( int, request ) ExtLib.Hashtbl.t;
clients : ( int, client ) ExtLib.Hashtbl.t;
config : config;
digest_auth : Digest_auth.t option;
h_childs : ( int, unit ) ExtLib.Hashtbl.t;(*

currently running forked childs

*)
q_wait : ( unit -> unit ) Stack.t;(*

the stack of requests to fork

*)
}

server state

val incr_active : server -> unit
val decr_active : server -> unit
val incr_total : server -> unit
val incr_errors : server -> unit
val incr_reject : server -> unit
val make_server_state : Unix.file_descr -> config -> server
val show_socket_error : Unix.file_descr -> string
val show_peer : client -> string
val show_client : client -> string
type ('a, 'b) result = [
| `Ok of 'a
| `Error of 'b
]
val space : Pcre.regexp
type reason =
| Url
| Version
| Method
| Header
| RequestLine
| Split
| Extra
| NotAcceptable
exception Parse of reason * string
val failed : reason -> string -> 'a
val get_content_length : (string * string) list -> int option
val decode_args : string -> (string * string) list
val acceptable_encoding : (string * string) list -> encoding
val make_request_exn : line1:string -> headers:(string * string) list -> body:string -> client -> request
val extract_header : string -> string * string
val extract_headers : string -> string * (string * string) list
val is_body_ready : partial_body -> bool -> bool
val teardown : Unix.file_descr -> unit
val finish : ?shutdown:bool -> client -> unit
val write_f : client -> (string list ref * int ref) -> Ev.event -> Unix.file_descr -> 'a -> unit
val log_access_apache : out_channel -> int -> int -> ?background:bool -> request -> unit
val log_status_apache : out_channel -> [< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported ] -> int -> request -> unit
val wait : Async.Ev.event_base -> Unix.file_descr -> ( unit -> unit ) -> Async.Ev.event

Wait until fd becomes readable and close it (for eventfd-backed notifications)

val write_some : Unix.file_descr -> string -> [> `Done | `Some of int ]
val abort : client -> exn -> string -> unit

close transport connection, count as error

val write_reply : client -> string list -> unit
val write_reply_blocking : client -> string -> unit
val set_blocking : request -> unit IO.output
val make_request_headers : reply_status -> (string * string) list -> string
val send_reply_async : client -> encoding -> (reply_status * (string * string) list * string) -> unit
val send_reply_blocking : client -> (reply_status * (string * string) list) -> unit
val maybe_allow_cors : client -> (string * string) list -> (string * string) list
val send_reply_user : client -> request -> ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported ] * (string * string) list * string) -> unit
val make_error : exn -> [> `Bad_request | `Not_acceptable | `Not_implemented ] * string
val send_reply_limit : client -> int -> unit
val handle_request : client -> partial_body -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
val process_chunk : client -> Ev.event -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> string -> bool -> unit
val handle_client : client -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
module Tcp : sig ... end
val check_hung_requests : server -> unit
val check_waiting_requests : server -> unit
val finish_child : server -> int -> unit
val reap_orphans : server -> unit
val start_listen : config -> Unix.file_descr
val setup_server_fd : Unix.file_descr -> config -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> server
val setup_server : config -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> server
val setup_fd : Unix.file_descr -> config -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
val setup : config -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
val server : config -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
val header : 'a -> 'b -> 'c * 'd
val forbidden : [> `Forbidden ] * 'a list * string
val not_found : [> `Not_found ] * 'a list * string
val found : 'a -> [> `Found ] * (string * 'b) list * string
val moved : 'a -> [> `Moved ] * (string * 'b) list * string
val cache_no : (string * string) list
val cache_yes : float -> (string * string) list

Utilities

module type Args = sig ... end
module Args (T : sig ... end) : Args
val noclose_io : 'a IO.output -> unit IO.output
val output : ( unit IO.output -> unit ) -> string

Buffers all output

val serve : request -> ?status:[> `Ok ] as 'a -> ?extra:(string * 'b) list -> 'c -> 'd -> 'e * (string * 'b) list * 'f
val serve_io : request -> ?status:[> `Ok ] as 'a -> ?extra:(string * 'b) list -> 'c -> ( unit IO.output -> unit ) -> 'd * (string * 'b) list * string
val serve_text_io : request -> ?status:[> `Ok ] as 'a -> ( unit IO.output -> unit ) -> 'b * (string * string) list * string
val serve_gzip_io : request -> ?status:[> `Ok ] as 'a -> ( unit IO.output -> unit ) -> 'b * (string * string) list * string
val serve_text : request -> ?status:[> `Ok ] as 'a -> 'b -> 'c * (string * string) list * 'd
val run : ?ip:Unix.inet_addr -> int -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit
val run_unix : string -> ( server -> request -> ( ([< `Bad_request | `Conflict | `Created | `Custom of string | `Forbidden | `Found | `I'm_a_teapot | `Internal_server_error | `Length_required | `Method_not_allowed | `Moved | `No_content | `No_reply | `Not_acceptable | `Not_found | `Not_implemented | `Ok | `Payment_required | `Request_too_large | `Service_unavailable | `Unauthorized | `Version_not_supported Unauthorized ] * (string * string) list * string) -> unit ) -> unit ) -> unit

Forked workers

val check_req : request -> [> `Error of int | `Ok ]
val check_req_exn : request -> unit
exception Continue of unit -> unit
val answer_blocking : ?debug:bool -> server -> request -> ( ( (string * string) list -> unit ) -> int64 IO.output -> unit ) -> ( ([> `Ok ] * (string * string) list * string) -> 'a ) -> unit
val stats : Var.typ
val nr_forked : int ref
val nr_queued : int ref
val nr_rejected : int ref
val answer_forked : ?debug:bool -> server -> request -> ( ( (string * string) list -> unit ) -> int64 IO.output -> unit ) -> ( ([> `Internal_server_error | `No_reply | `Ok | `Service_unavailable ] * (string * string) list * string) -> unit ) -> unit

Lwt support

val timeout : float -> 'a Lwt.t -> 'a Lwt.t
val send_reply : client -> Lwt_io.output_channel -> [< `Body of reply_status * (string * string) list * string | `Chunks of reply_status * (string * string) list * ( ( string -> unit Lwt.t ) -> unit Lwt.t ) ] -> unit Lwt.t
val handle_request_lwt : client -> request -> ( server -> request -> [> `Body of [> `Not_found | `Unauthorized | `Version_not_supported ] * (string * string) list * string ] as 'a Lwt.t ) -> 'b Lwt.t
val read_buf : Lwt_io.input_channel -> bytes -> string Lwt.t
module ReqBuffersCache : sig ... end
val read_headers : Lwt_io.input_channel -> int -> (string list * string) Lwt.t
val handle_client_lwt : client -> Lwt_io.input_channel -> ( server -> request -> [> `Body of [> `Not_found | `Unauthorized | `Version_not_supported ] * (string * string) list * string ] as 'a Lwt.t ) -> 'b Lwt.t
val accept_hook : ( unit -> unit ) ref
val handle_lwt : config -> Lwt_unix.file_descr -> ( (Lwt_unix.file_descr * Lwt_unix.sockaddr) -> unit Lwt.t ) -> unit Lwt.t
module BuffersCache : sig ... end
val setup_fd_lwt : Lwt_unix.file_descr -> config -> ( server -> request -> [ `Body of reply_status * (string * string) list * string | `Chunks of reply_status * (string * string) list * ( ( string -> unit Lwt.t ) -> unit Lwt.t ) ] Lwt.t ) -> unit Lwt.t
val setup_lwt : config -> ( server -> request -> [ `Body of reply_status * (string * string) list * string | `Chunks of reply_status * (string * string) list * ( ( string -> unit Lwt.t ) -> unit Lwt.t ) ] Lwt.t ) -> unit Lwt.t
val server_lwt : config -> ( server -> request -> [ `Body of reply_status * (string * string) list * string | `Chunks of reply_status * (string * string) list * ( ( string -> unit Lwt.t ) -> unit Lwt.t ) ] Lwt.t ) -> unit
module Answer : sig ... end