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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
(* $Id: http_client_aux.ml 126 2004-05-25 20:56:41Z gerd $
* ----------------------------------------------------------------------
* Auxiliary functions: this version uses the xstr package and is
* multithreading-safe.
*)
open Xstr_match
open Xstr_split
let digits = mkset "0-9";;
let hex_digits = mkset "0-9a-fA-F";;
let space_tab = mkset " \t";;
let no_slash_no_colon = mknegset "/:";;
let no_slash_no_colon_no_at = mknegset "/:@";;
let no_space = mknegset " ";;
let no_space_no_tab = mknegset " \t";;
let no_cr_no_lf = mknegset "\n\r";;
let ms which re s =
try
match_string re s
with
Failure e as f ->
prerr_endline ("Failure in " ^ which);
raise f
;;
let match_query query =
let host = var "" in
let port = var "80" in
let path = var "" in
let query_re =
[ Literal "http://";
Record (host,
[ Anychar_from no_slash_no_colon;
Anystring_from no_slash_no_colon;
]);
Optional
[ Literal ":";
Record (port,
[ Anychar_from digits;
Anystring_from digits;
]);
];
Record (path,
[ Anystring_from no_space; ]);
] in
if match_string (* ms "query" *) query_re query then
String.lowercase(found_string_of_var host),
int_of_string(string_of_var port),
found_string_of_var path
else
raise Not_found
;;
let match_status status_line =
let version = var "" in
let code = var "" in
let message = var "" in
let status_re =
[ Record (version,
[ Anychar_from no_space_no_tab;
Anystring_from no_space_no_tab;
]);
Anychar_from space_tab;
Anystring_from space_tab;
Record (code,
[ Anychar_from digits;
Anychar_from digits;
Anychar_from digits;
]);
Optional
[ Anychar_from space_tab;
Anystring_from space_tab;
Record (message,
[ Anystring_from no_cr_no_lf;
]);
];
Optional
[ Literal "\r"; ];
] in
if match_string (* ms "status" *) status_re status_line then
found_string_of_var version,
int_of_string(found_string_of_var code),
( try found_string_of_var message with Not_found -> "" )
else
raise Not_found
;;
let match_header_line line =
let name = var "" in
let value = var "" in
let line_re =
[ Record(name,
[ Anychar_from no_space_no_tab;
Anystring_from no_space_no_tab;
]);
Anystring_from space_tab;
Literal ":";
Anystring_from space_tab;
Record(value,
[ Anystring; ]);
] in
if match_string (* ms "headerline" *) line_re line then
String.lowercase(found_string_of_var name),
found_string_of_var value
else
raise Not_found
;;
let match_hex hex =
let hexnum = var "" in
let hex_re =
[ Record (hexnum,
[ Anychar_from hex_digits;
Anystring_from hex_digits;
]);
Anystring;
] in
if match_string (* ms "hex" *) hex_re hex then
found_string_of_var hexnum
else
raise Not_found
;;
let match_ip ip =
let ipnum = var "" in
let ip_re =
[ Record (ipnum,
[ Anychar_from digits;
Anystring_from digits;
Literal ".";
Anychar_from digits;
Anystring_from digits;
Literal ".";
Anychar_from digits;
Anystring_from digits;
Literal ".";
Anychar_from digits;
Anystring_from digits;
]);
] in
if match_string (* ms "ip" *) ip_re ip then
ip
else
raise Not_found
;;
let match_http url =
let user = var "" in
let password = var "" in
let host = var "" in
let port = var "" in
let path = var "" in
let http_re =
[ Literal "http://";
Optional
[ Record (user,
[ Anychar_from no_slash_no_colon_no_at;
Anystring_from no_slash_no_colon_no_at;
]);
Optional
[ Literal ":";
Record (password,
[ Anychar_from no_slash_no_colon_no_at;
Anystring_from no_slash_no_colon_no_at;
]);
];
Literal "@";
];
Record (host,
[ Anychar_from no_slash_no_colon_no_at;
Anystring_from no_slash_no_colon_no_at;
]);
Optional
[ Literal ":";
Record (port,
[ Anychar_from digits;
Anystring_from digits;
]);
];
Optional
[ Record (path,
[ Literal "/";
Anystring;
]);
];
] in
if match_string (* ms "http" *) http_re url then begin
(try Some(found_string_of_var user) with Not_found -> None),
(try Some(found_string_of_var password) with Not_found -> None),
found_string_of_var host,
(try int_of_string(found_string_of_var port) with Not_found -> 80),
(try found_string_of_var path with Not_found -> "")
end
else raise Not_found
;;
let split_words_by_commas =
split_string " \t\r\n" true true [ "," ];;
module Mtx = Mutex;;
|
