3 OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
5 Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr =
29 (* remove all bindings of 'name' from hashtbl 'tbl' *)
30 let rec hashtbl_remove_all tbl name =
31 if not (Hashtbl.mem tbl name) then
32 raise (Header_not_found name);
33 Hashtbl.remove tbl name;
34 if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
37 let ((cliaddr, cliport), (srvaddr, srvport)) =
38 (Http_misc.explode_sockaddr clisockaddr,
39 Http_misc.explode_sockaddr srvsockaddr)
44 val _contentsBuf = Buffer.create 1024
45 val _headers = Hashtbl.create 11
46 val mutable _version: version = version
50 self#addHeaders headers
52 method version = _version
53 method setVersion v = _version <- v
55 method body = Buffer.contents _contentsBuf
57 Buffer.clear _contentsBuf;
58 Buffer.add_string _contentsBuf c
59 method bodyBuf = _contentsBuf
61 Buffer.clear _contentsBuf;
62 Buffer.add_buffer _contentsBuf b
63 method addBody s = Buffer.add_string _contentsBuf s
64 method addBodyBuf b = Buffer.add_buffer _contentsBuf b
66 method addHeader ~name ~value =
67 Http_parser_sanity.heal_header (name, value);
68 Hashtbl.add _headers name value
70 List.iter (fun (name, value) -> self#addHeader ~name ~value)
71 method replaceHeader ~name ~value =
72 Http_parser_sanity.heal_header (name, value);
73 Hashtbl.replace _headers name value
74 method replaceHeaders =
75 List.iter (fun (name, value) -> self#replaceHeader ~name ~value)
76 method removeHeader ~name = hashtbl_remove_all _headers name
77 method hasHeader ~name = Hashtbl.mem _headers name
79 if not (self#hasHeader name) then
80 raise (Header_not_found name);
81 String.concat ", " (List.rev (Hashtbl.find_all _headers name))
85 (fun name _ headers -> (name, self#header ~name)::headers)
89 method clientSockaddr = clisockaddr
90 method clientAddr = cliaddr
91 method clientPort = cliport
93 method serverSockaddr = srvsockaddr
94 method serverAddr = srvaddr
95 method serverPort = srvport
97 method private virtual fstLineToString: string
99 self#fstLineToString ^ (* {request,status} line *)
101 (String.concat (* headers, crlf terminated *)
103 (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) ^
104 (sprintf "Content-Length: %d" (String.length self#body)) ^ crlf ^
107 method serialize outchan =
108 output_string outchan self#toString;