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
28 let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"
32 | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1)
35 (* Warning: keep default values in sync with Http_daemon.respond function *)
36 ?(body = "") ?(headers = []) ?(version = http_version)
37 ?clisockaddr ?srvsockaddr (* optional because response have to be easily
38 buildable in callback functions *)
43 (** if no address were supplied for client and/or server, use a foo address
45 let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in
47 (* "version code reason_phrase" *)
51 Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr
56 | Some (s: Http_types.status) -> code_of_status s
57 val mutable _reason: string option = None
61 ignore (status_of_code c); (* sanity check on c *)
63 method status = status_of_code _code
64 method setStatus (s: Http_types.status) = _code <- code_of_status s
67 | None -> Http_misc.reason_phrase_of_code _code
69 method setReason r = _reason <- Some r
73 [string_of_version self#version; string_of_int self#code; self#reason]
74 method setStatusLine s =
76 let subs = Pcre.extract ~rex:status_line_RE s in
77 self#setVersion (version_of_string subs.(1));
78 self#setCode (int_of_string subs.(2));
79 self#setReason subs.(3)
81 raise (Invalid_status_line s)
83 method isInformational = is_informational _code
84 method isSuccess = is_success _code
85 method isRedirection = is_redirection _code
86 method isClientError = is_client_error _code
87 method isServerError = is_server_error _code
88 method isError = is_error _code
90 (* FIXME duplication of code between this and send_basic_headers *)
91 method addBasicHeaders =
92 self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
93 self#addHeader ~name:"Server" ~value:server_string
95 method contentType = self#header "Content-Type"
96 method setContentType t = self#replaceHeader "Content-Type" t
97 method contentEncoding = self#header "Content-Encoding"
98 method setContentEncoding e = self#replaceHeader "Content-Encoding" e
99 method date = self#header "Date"
100 method setDate d = self#replaceHeader "Date" d
101 method expires = self#header "Expires"
102 method setExpires t = self#replaceHeader "Expires" t
103 method server = self#header "Server"
104 method setServer s = self#replaceHeader "Server" s
106 method private fstLineToString =
109 (string_of_version self#version)