]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/DEVEL/ocaml-http/http_types.ml
ocaml 3.09 transition
[helm.git] / helm / DEVEL / ocaml-http / http_types.ml
index 40015e6831cd2d4d650fcc856a16935d3f62eb46..5c88b212ed010990015a936355824685f6d737d8 100644 (file)
@@ -2,65 +2,42 @@
 (*
   OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
 
-  Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
 
   This program is free software; you can redistribute it and/or modify
-  it under the terms of the GNU General Public License as published by
-  the Free Software Foundation; either version 2 of the License, or
-  (at your option) any later version.
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
 
   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-  GNU General Public License for more details.
+  GNU Library General Public License for more details.
 
-  You should have received a copy of the GNU General Public License
-  along with this program; if not, write to the Free Software
-  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+  You should have received a copy of the GNU Library General Public
+  License along with this program; if not, write to the Free Software
+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
+  USA
 *)
 
 (** Type definitions *)
 
-  (** HTTP version, actually only 1.0 and 1.1 are supported. Note that
-  'supported' here means only 'accepted inside a HTTP request line', no
-  different behaviours are actually implemented depending on HTTP version *)
-type version =
-  [ `HTTP_1_0
-  | `HTTP_1_1
-  ]
-
-  (** HTTP method, actually only GET and POST methods are supported *)
-type meth =
-  [ `GET
-  | `POST
-  ]
-
-  (** Daemon behaviour wrt request handling. `Single mode use a single process
-  to handle all requests, no request is served until a previous one has been
-  fully served. `Fork mode fork a new process for each request, the new process
-  will execute the callback function and then exit. `Thread mode create a new
-  thread for each request, the new thread will execute the callback function and
-  then exit, threads can communicate using standard OCaml Thread library. *)
+type version = [ `HTTP_1_0 | `HTTP_1_1 ]
+type meth = [ `GET | `POST ]
 type daemon_mode = [ `Single | `Fork | `Thread ]
 
-  (** A TCP server is a function taking an address on which bind and listen for
-  connections, an optional timeout after which abort client connections and a
-  callback function which in turn takes an input and an output channel as
-  arguments. After receiving this argument a TCP server sits and waits for
-  connection, on each connection it apply the callback function to channels
-  connected to client. *)
 type tcp_server =
   sockaddr:Unix.sockaddr -> timeout:int option ->
   (in_channel -> out_channel -> unit) ->
     unit
 
-  (** informational HTTP status, see RFC2616 *)
+type auth_info =
+  [ `Basic of string * string (* username, password *)
+  ]
+
 type informational_substatus =
   [ `Continue
   | `Switching_protocols
   ]
-
-  (** success HTTP status, see RFC2616 *)
 type success_substatus =
   [ `OK
   | `Created
@@ -70,8 +47,6 @@ type success_substatus =
   | `Reset_content
   | `Partial_content
   ]
-
-  (** redirection HTTP status, see RFC2616 *)
 type redirection_substatus =
   [ `Multiple_choices
   | `Moved_permanently
@@ -81,8 +56,6 @@ type redirection_substatus =
   | `Use_proxy
   | `Temporary_redirect
   ]
-
-  (** client error HTTP status, see RFC2616 *)
 type client_error_substatus =
   [ `Bad_request
   | `Unauthorized
@@ -103,8 +76,6 @@ type client_error_substatus =
   | `Requested_range_not_satisfiable
   | `Expectation_failed
   ]
-
-  (** server error HTTP status, see RFC2616 *)
 type server_error_substatus =
   [ `Internal_server_error
   | `Not_implemented
@@ -113,19 +84,15 @@ type server_error_substatus =
   | `Gateway_time_out
   | `HTTP_version_not_supported
   ]
-
 type informational_status = [ `Informational of informational_substatus ]
 type success_status = [ `Success of success_substatus ]
 type redirection_status = [ `Redirection of redirection_substatus ]
 type client_error_status = [ `Client_error of client_error_substatus ]
 type server_error_status = [ `Server_error of server_error_substatus ]
-
 type error_status =
   [ client_error_status
   | server_error_status
   ]
-
-  (** HTTP status *)
 type status =
   [ informational_status
   | success_status
@@ -134,75 +101,39 @@ type status =
   | server_error_status
   ]
 
-  (** File sources *)
-type file_source =
-  | FileSrc of string           (** filename *)
-  | InChanSrc of in_channel     (** input channel *)
+type status_code = [ `Code of int | `Status of status ]
 
-  (** {2 Exceptions} *)
+type file_source =
+  | FileSrc of string
+  | InChanSrc of in_channel
 
-  (** invalid header encountered *)
 exception Invalid_header of string
-
-  (** invalid header name encountered *)
 exception Invalid_header_name of string
-
-  (** invalid header value encountered *)
 exception Invalid_header_value of string
-
-  (** unsupported or invalid HTTP version encountered *)
 exception Invalid_HTTP_version of string
-
-  (** unsupported or invalid HTTP method encountered *)
 exception Invalid_HTTP_method of string
-
-  (** invalid HTTP status code integer representation encountered *)
 exception Invalid_code of int
-
-  (** invalid URL encountered *)
 exception Malformed_URL of string
-
-  (** invalid query string encountered *)
 exception Malformed_query of string
-
-  (** invalid query string part encountered, arguments are parameter name and
-  parameter value *)
 exception Malformed_query_part of string * string
-
-  (** invalid request URI encountered *)
 exception Malformed_request_URI of string
-
-  (** malformed request received *)
 exception Malformed_request of string
-
-  (** a parameter you were looking for was not found *)
+exception Malformed_response of string
 exception Param_not_found of string
-
-  (** invalid HTTP status line encountered *)
 exception Invalid_status_line of string
-
-  (** an header you were looking for was not found *)
 exception Header_not_found of string
-
-  (** raisable by callback functions to make main daemon quit, this is the only
-  'clean' way to make start functions return *)
 exception Quit
+exception Unauthorized of string
 
-  (** {2 OO representation of HTTP messages} *)
-
-  (** HTTP generic messages. See {! Http_message.message} *)
 class type message = object
-
     method version: version option
     method setVersion: version -> unit
-
     method body: string
     method setBody: string -> unit
     method bodyBuf: Buffer.t
     method setBodyBuf: Buffer.t -> unit
     method addBody: string -> unit
     method addBodyBuf: Buffer.t -> unit
-
     method addHeader: name:string -> value:string -> unit
     method addHeaders: (string * string) list -> unit
     method replaceHeader: name:string -> value:string -> unit
@@ -211,175 +142,78 @@ class type message = object
     method hasHeader: name:string -> bool
     method header: name:string -> string
     method headers: (string * string) list
-
     method clientSockaddr: Unix.sockaddr
     method clientAddr: string
     method clientPort: int
-
     method serverSockaddr: Unix.sockaddr
     method serverAddr: string
     method serverPort: int
-
     method toString: string
     method serialize: out_channel -> unit
-
   end
 
-  (** HTTP requests *)
 class type request = object
-
-      (** an HTTP request is a flavour of HTTP message *)
     inherit message
-
-      (** @return request method *)
     method meth: meth
-
-      (** @return requested URI (including query string, fragment, ...) *)
     method uri: string
-
-      (** @return requested path *)
     method path: string
-
-      (** lookup a given parameter
-      @param meth if given restrict the lookup area (e.g. if meth = POST than
-      only parameters received via POST are searched), if not given both GET and
-      POST parameter are searched in an unspecified order (actually the
-      implementation prefers POST parameters but this is not granted, you've
-      been warned)
-      @param name name of the parameter to lookup
-      @return value associated to parameter name
-      @raise Param_not_found if parameter name was not found *)
-    method param: ?meth:meth -> string -> string
-
-      (** like param above but return a list of values associated to given
-      parameter (a parameter could be defined indeed more than once: passed more
-      than once in a query string or passed both insider the url (the GET way)
-      and inside message body (the POST way)) *)
+    method param: ?meth:meth -> ?default:string -> string -> string
     method paramAll: ?meth:meth -> string -> string list
-
-      (** @return the list of all received parameters *)
     method params: (string * string) list
-
-      (** @return the list of all parameters received via GET *)
     method params_GET: (string * string) list
-
-      (** @return the list of all parameter received via POST *)
     method params_POST: (string * string) list
-
+    method authorization: auth_info option
   end
 
-  (** HTTP responses *)
 class type response = object
-
     inherit message
-
-      (** @return response code *)
     method code: int
-
-      (** set response code *)
     method setCode: int -> unit
-
-      (** @return response status, see {! Http_types.status} *)
     method status: status
-
-      (** set response status *)
     method setStatus: status -> unit
-
-      (** @return reason string *)
     method reason: string
-
-      (** set reason string *)
     method setReason: string -> unit
-
-      (** @return status line *)
     method statusLine: string
-
-      (** set status line
-      @raise Invalid_status_line if an invalid HTTP status line was passed *)
     method setStatusLine: string -> unit
-
-      (** response is an informational one *)
     method isInformational: bool
-
-      (** response is a success one *)
     method isSuccess: bool
-
-      (** response is a redirection one *)
     method isRedirection: bool
-
-      (** response is a client error one *)
     method isClientError: bool
-
-      (** response is a server error one *)
     method isServerError: bool
-
-      (** response is either a client error or a server error response *)
     method isError: bool
-
-      (** add basic headers to response, see {! Http_daemon.send_basic_headers}
-      *)
     method addBasicHeaders: unit
-
-      (** facilities to access some frequently used headers *)
-
-      (** @return Content-Type header value *)
     method contentType: string
-
-      (** set Content-Type header value *)
     method setContentType: string -> unit
-
-      (** @return Content-Encoding header value *)
     method contentEncoding: string
-
-      (** set Content-Encoding header value *)
     method setContentEncoding: string -> unit
-
-      (** @return Date header value *)
     method date: string
-
-      (** set Date header value *)
     method setDate: string -> unit
-
-      (** @return Expires header value *)
     method expires: string
-
-      (** set Expires header value *)
     method setExpires: string -> unit
-
-      (** @return Server header value *)
     method server: string
-
-      (** set Server header value *)
     method setServer: string -> unit
-
   end
 
-  (** {2 OO representation of other HTTP "entities"} *)
-
-  (** an HTTP connection from a client to a server *)
 class type connection =
   object
-      (** @return next request object, may block if client hasn't submitted any
-      request yet, may be None if client request was ill-formed *)
     method getRequest: request option
-
-      (** respond to client sending it a response *)
     method respond_with: response -> unit
-
-      (** close connection to client. Warning: this object can't be used any
-      longer after this method has been called *)
     method close: unit
   end
-
-  (** an HTTP daemon *)
 class type daemon =
   object
-      (** @return a connection to a client, may block if no client has connected
-      yet *)
     method accept: connection
-
-      (** shortcut method, blocks until a client has submit a request and
-      return a pair request * connection *)
     method getRequest: request * connection
   end
 
+type daemon_spec = {
+  address: string;
+  auth: (string * auth_info) option;
+  callback: request -> out_channel -> unit;
+  mode: daemon_mode;
+  port: int;
+  root_dir: string option;
+  exn_handler: (exn -> out_channel -> unit) option;
+  timeout: int option;
+}
+