1 (** curl lwt example *)
8 let printfn fmt
= ksprintf print_endline fmt
10 let curl_setup_simple h
=
12 set_useragent h
"Curl_lwt";
14 set_connecttimeout h
5;
16 set_followlocation h
false;
18 set_ipresolve h IPRESOLVE_V4
;
19 set_encoding h CURL_ENCODING_ANY
23 let url = get_effectiveurl h
in
24 printfn "%3d %.2f %5.0fB URL: %s (%s)%s"
28 (if get_httpcode h
/ 100 = 3 then sprintf
"%s -> %s" url (get_redirecturl h
) else url)
30 (match code
with CURLE_OK
-> "" | _
-> sprintf
" %s (%d)" (strerror code
) (errno code
))
33 let b = Buffer.create
16 in
34 Curl.set_writefunction h
(fun s
-> Buffer.add_string
b s
; String.length s
);
35 Lwt.bind
(Curl_lwt.perform h
) (fun code
-> Lwt.return
(code
, Buffer.contents
b))
38 let h = Curl.init
() in
41 begin try%lwt
(* e.g. Canceled *)
42 let%lwt
(code
,_body
) = download h in
45 (* do something with body *)
47 printfn "EXN %s URL: %s" (Printexc.to_string exn
) url;
49 end[%lwt
.finally
Curl.cleanup
h; Lwt.return
()]
53 "http://www.forth.org.ru";
54 "http://caml.inria.fr";
55 "https://www.rust-lang.org";
57 "http://elm-lang.org";
58 "http://www.red-lang.org";
62 let%lwt
() = Lwt_unix.sleep
0.5 in
63 let%lwt
() = Lwt.choose tasks
in
64 print_endline
"Cancel remaining transfers";
68 printfn "Launch %d transfers" (List.length
urls);
69 let tasks = List.map
get urls in
70 Lwt_main.run
@@ Lwt.pick
[