package devkit

  1. Overview
  2. Docs
package devkit
Legend:
Library
Module
Module type
Parameter
Class
Class type

Very simple and incomplete HTTP server

module Ev = Libevent
val buffer_size : int
module Hidden : sig ... end

Server

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

    more logging

    *)
  5. events : Ev.event_base;
  6. access_log : out_channel ref;
  7. access_log_enabled : bool;
  8. name : string;
  9. max_request_size : int;
  10. auth : (string * string * string) option;
  11. max_clients : int;
    (*

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

    *)
  12. max_data_childs : int;
  13. max_data_waiting : int;
  14. 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)

    *)
  15. single : bool;
    (*

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

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

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

    *)
  17. reuseport : bool;
  18. nodelay : bool;
  19. strict_args : bool;
    (*

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

    *)
  20. max_time : max_time;
  21. 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 = Httpev_common.encoding =
  1. | Gzip
  2. | Identity
type meth = [
  1. | `GET
  2. | `POST
  3. | `PUT
  4. | `PATCH
  5. | `DELETE
  6. | `HEAD
  7. | `OPTIONS
]
type request = Httpev_common.request = {
  1. addr : Unix.sockaddr;
  2. url : string;
  3. path : string;
  4. args : (string * string) list;
  5. conn : Time.t;
  6. recv : Time.t;
  7. meth : meth;
  8. headers : (string * string) list;
  9. body : string;
  10. version : int * int;
  11. id : int;
  12. socket : Unix.file_descr;
  13. line : string;
    (*

    request line

    *)
  14. mutable blocking : unit IO.output option;
  15. encoding : encoding;
}
type reply_status = [
  1. | `Ok
  2. | `Created
  3. | `No_content
  4. | `Found
  5. | `Moved
  6. | `Bad_request
  7. | `Unauthorized
  8. | `Payment_required
  9. | `Forbidden
  10. | `Not_found
  11. | `Method_not_allowed
  12. | `Not_acceptable
  13. | `Conflict
  14. | `Length_required
  15. | `Request_too_large
  16. | `I'm_a_teapot
  17. | `Internal_server_error
  18. | `Not_implemented
  19. | `Service_unavailable
  20. | `Version_not_supported
  21. | `Custom of string
]
type extended_reply_status = [
  1. | reply_status
  2. | `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 = {
  1. line1 : string;
  2. content_length : int option;
  3. parsed_headers : (string * string) list;
  4. buf : ExtLib.Buffer.t;
}
type request_state =
  1. | Headers of ExtLib.Buffer.t
  2. | Body of partial_body
  3. | Body_lwt of int
  4. | Ready of request
type client = {
  1. fd : Unix.file_descr;
  2. req_id : int;
  3. time_conn : Time.t;
    (*

    time when client connected

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

client state

and server = {
  1. listen_socket : Unix.file_descr;
  2. mutable total : int;
  3. mutable active : int;
  4. mutable errors : int;
  5. mutable reject : int;
  6. reqs : (int, request) ExtLib.Hashtbl.t;
  7. clients : (int, client) ExtLib.Hashtbl.t;
  8. config : config;
  9. digest_auth : Digest_auth.t option;
  10. h_childs : (int, unit) ExtLib.Hashtbl.t;
    (*

    currently running forked childs

    *)
  11. 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 = [
  1. | `Ok of 'a
  2. | `Error of 'b
]
val space : Pcre.regexp
type reason =
  1. | Url
  2. | Version
  3. | Method
  4. | Header
  5. | RequestLine
  6. | Split
  7. | Extra
  8. | 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

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