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
|
(* Bad request (a newline in the request URL - the server sees a HTTP 0.9
* request, but the HEAD method is not defined for HTTP 0.9).
* In the callback function, a second request is pushded onto the queue.
*)
open Http_client;;
let server = Sys.argv.(1) in
let exn_to_string x =
match x with
| Http_protocol any ->
"Http_protocol(" ^ Printexc.to_string any ^ ")"
| any ->
Printexc.to_string any
in
try
let p = new pipeline in
let opts = p # get_options in
p # set_options
{ opts with
verbose_connection = true;
verbose_status = true;
number_of_parallel_connections = 1;
};
let m1 = new head ("http://" ^ server ^ "/techdocs/corba/OMG-2.0/mailto:pubs@omg.org\n") in
let m2 = new get ("http://" ^ server ^ "/") in
p # add_with_callback
m1
(fun m ->
try
let _, _, _ = m # dest_status() in ()
with
any ->
print_endline ("Serious error: " ^
exn_to_string any);
flush stdout;
p # add m2;
);
let rec r() =
try
p # run()
with
Http_protocol x ->
print_endline ("Exception: " ^ Printexc.to_string x);
flush stdout;
r()
in
r();
print_string ("Reply:\n" ^ m2 # get_resp_body());
with
Assert_failure (where, first, last) ->
Printf.printf ("Assert failure: %s %d %d\n") where first last;
flush stdout;
()
| Http_protocol any ->
Printf.printf "Uncaught exception: Http_protocol(%s)\n" (Printexc.to_string any);
flush stdout;
()
| any ->
Printf.printf "Uncaught exception: %s\n" (Printexc.to_string any);
flush stdout;
()
;;
|
