--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> 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.
+
+ 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.
+
+ 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
+*)
+
+open Http_common;;
+open Http_constants;;
+open Http_types;;
+open Printf;;
+
+class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr =
+
+ (* remove all bindings of 'name' from hashtbl 'tbl' *)
+ let rec hashtbl_remove_all tbl name =
+ if not (Hashtbl.mem tbl name) then
+ raise (Header_not_found name);
+ Hashtbl.remove tbl name;
+ if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
+ in
+
+ let ((cliaddr, cliport), (srvaddr, srvport)) =
+ (Http_misc.explode_sockaddr clisockaddr,
+ Http_misc.explode_sockaddr srvsockaddr)
+ in
+
+ object (self)
+
+ val _contentsBuf = Buffer.create 1024
+ val _headers = Hashtbl.create 11
+ val mutable _version: version = version
+
+ initializer
+ self#setBody body;
+ self#addHeaders headers
+
+ method version = _version
+ method setVersion v = _version <- v
+
+ method body = Buffer.contents _contentsBuf
+ method setBody c =
+ Buffer.clear _contentsBuf;
+ Buffer.add_string _contentsBuf c
+ method bodyBuf = _contentsBuf
+ method setBodyBuf b =
+ Buffer.clear _contentsBuf;
+ Buffer.add_buffer _contentsBuf b
+ method addBody s = Buffer.add_string _contentsBuf s
+ method addBodyBuf b = Buffer.add_buffer _contentsBuf b
+
+ method addHeader ~name ~value =
+ Http_parser_sanity.heal_header (name, value);
+ Hashtbl.add _headers name value
+ method addHeaders =
+ List.iter (fun (name, value) -> self#addHeader ~name ~value)
+ method replaceHeader ~name ~value =
+ Http_parser_sanity.heal_header (name, value);
+ Hashtbl.replace _headers name value
+ method replaceHeaders =
+ List.iter (fun (name, value) -> self#replaceHeader ~name ~value)
+ method removeHeader ~name = hashtbl_remove_all _headers name
+ method hasHeader ~name = Hashtbl.mem _headers name
+ method header ~name =
+ if not (self#hasHeader name) then
+ raise (Header_not_found name);
+ String.concat ", " (List.rev (Hashtbl.find_all _headers name))
+ method headers =
+ List.rev
+ (Hashtbl.fold
+ (fun name _ headers -> (name, self#header ~name)::headers)
+ _headers
+ [])
+
+ method clientSockaddr = clisockaddr
+ method clientAddr = cliaddr
+ method clientPort = cliport
+
+ method serverSockaddr = srvsockaddr
+ method serverAddr = srvaddr
+ method serverPort = srvport
+
+ method private virtual fstLineToString: string
+ method toString =
+ self#fstLineToString ^ (* {request,status} line *)
+ crlf ^
+ (String.concat (* headers, crlf terminated *)
+ ""
+ (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) ^
+ (sprintf "Content-Length: %d" (String.length self#body)) ^ crlf ^
+ crlf ^
+ self#body (* body *)
+ method serialize outchan =
+ output_string outchan self#toString;
+ flush outchan
+
+ end
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> 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.
+
+ 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.
+
+ 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
+*)
+
+open Http_types;;
+
+ (** OO representation of an HTTP message
+ @param entity body included in the message
+ @param headers message headers shipped with the message *)
+class virtual message:
+ body: string -> headers: (string * string) list -> version: version ->
+ clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr ->
+ object
+
+ method version: version
+ 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
+ method replaceHeaders: (string * string) list -> unit
+ method removeHeader: name:string -> unit
+ 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 private virtual fstLineToString: string
+ method toString: string
+ method serialize: out_channel -> unit
+
+ end
+
projects / helm.git / commitdiff