1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
(*
OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
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 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 Library General Public License for more details.
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
*)
open Http_types;;
open Http_constants;;
open Http_common;;
open Http_daemon;;
open Printf;;
let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"
let anyize = function
| Some addr -> addr
| None -> Unix.ADDR_INET (Unix.inet_addr_any, -1)
class response
(* Warning: keep default values in sync with Http_daemon.respond function *)
?(body = "") ?(headers = []) ?(version = http_version)
?clisockaddr ?srvsockaddr (* optional because response have to be easily
buildable in callback functions *)
?(code = 200) ?status
()
=
(** if no address were supplied for client and/or server, use a foo address
instead *)
let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in
(* "version code reason_phrase" *)
object (self)
(* note that response objects can't be created with a None version *)
inherit
Http_message.message
~body ~headers ~version:(Some version) ~clisockaddr ~srvsockaddr
val mutable _code =
match status with
| None -> code
| Some (s: Http_types.status) -> code_of_status s
val mutable _reason: string option = None
method private getRealVersion =
match self#version with
| None ->
failwith ("Http_response.fstLineToString: " ^
"can't serialize an HTTP response with no HTTP version defined")
| Some v -> string_of_version v
method code = _code
method setCode c =
ignore (status_of_code c); (* sanity check on c *)
_code <- c
method status = status_of_code _code
method setStatus (s: Http_types.status) = _code <- code_of_status s
method reason =
match _reason with
| None -> Http_misc.reason_phrase_of_code _code
| Some r -> r
method setReason r = _reason <- Some r
method statusLine =
String.concat " "
[self#getRealVersion; string_of_int self#code; self#reason]
method setStatusLine s =
try
let subs = Pcre.extract ~rex:status_line_RE s in
self#setVersion (version_of_string subs.(1));
self#setCode (int_of_string subs.(2));
self#setReason subs.(3)
with Not_found ->
raise (Invalid_status_line s)
method isInformational = is_informational _code
method isSuccess = is_success _code
method isRedirection = is_redirection _code
method isClientError = is_client_error _code
method isServerError = is_server_error _code
method isError = is_error _code
method addBasicHeaders =
List.iter (fun (n,v) -> self#addHeader n v) (get_basic_headers ())
method contentType = self#header "Content-Type"
method setContentType t = self#replaceHeader "Content-Type" t
method contentEncoding = self#header "Content-Encoding"
method setContentEncoding e = self#replaceHeader "Content-Encoding" e
method date = self#header "Date"
method setDate d = self#replaceHeader "Date" d
method expires = self#header "Expires"
method setExpires t = self#replaceHeader "Expires" t
method server = self#header "Server"
method setServer s = self#replaceHeader "Server" s
method connection = self#header "Connection"
method setConnection s = self#replaceHeader "Connection" s
method private fstLineToString =
sprintf "%s %d %s" self#getRealVersion self#code self#reason
end
|
