examples/test_lwt.ml

   1 (** curl lwt example *)
   2
   3 open Printf
   4
   5 let (@@) f x = f x
   6 let (|>) x f = f x
   7
   8 let printfn fmt = ksprintf print_endline fmt
   9
  10 let curl_setup_simple h =
  11   let open Curl in
  12   set_useragent h "Curl_lwt";
  13   set_nosignal h true;
  14   set_connecttimeout h 5;
  15   set_timeout h 10;
  16   set_followlocation h false;
  17   set_maxredirs h 1;
  18   set_ipresolve h IPRESOLVE_V4;
  19   set_encoding h CURL_ENCODING_ANY
  20
  21 let curl_setup_tcp h =
  22   let open Curl in
  23   set_tcpkeepalive h true;
  24   set_tcpkeepidle h 10;
  25   set_tcpkeepintvl h 10
  26
  27 let log_curl h code =
  28   let open Curl in
  29   let url = get_effectiveurl h in
  30   printfn "%3d %.2f %5.0fB URL: %s (%s)%s"
  31     (get_httpcode h)
  32     (get_totaltime h)
  33     (get_sizedownload h)
  34     (if get_httpcode h / 100 = 3 then sprintf "%s -> %s" url (get_redirecturl h) else url)
  35     (get_contenttype h)
  36     (match code with CURLE_OK -> "" | _ -> sprintf " %s (%d)" (strerror code) (errno code))
  37
  38 let download h =
  39   let b = Buffer.create 16 in
  40   Curl.set_writefunction h (fun s -> Buffer.add_string b s; String.length s);
  41   Curl.set_prereqfunction h (fun conn_primary_ip conn_local_ip conn_primary_port conn_local_port ->
  42     printfn "Making request %s:%d -> %s:%d"
  43       conn_local_ip conn_local_port conn_primary_ip conn_primary_port;
  44     false);
  45   Lwt.bind (Curl_lwt.perform h) (fun code -> Lwt.return (code, Buffer.contents b))
  46
  47 let get url =
  48   let h = Curl.init () in
  49   Curl.set_url h url;
  50   curl_setup_simple h;
  51   curl_setup_tcp h;
  52   begin try%lwt (* e.g. Canceled *)
  53     let%lwt (code,_body) = download h in
  54     log_curl h code;
  55     Lwt.return ()
  56     (* do something with body *)
  57   with exn ->
  58     printfn "EXN %s URL: %s" (Printexc.to_string exn) url;
  59     Lwt.fail exn
  60   end[%lwt.finally Curl.cleanup h; Lwt.return ()]
  61
  62 let urls =
  63   [
  64     "http://www.forth.org.ru";
  65     "http://caml.inria.fr";
  66     "https://www.rust-lang.org";
  67     "https://ocaml.org";
  68     "http://elm-lang.org";
  69     "http://www.red-lang.org";
  70   ]
  71
  72 let wait_one tasks =
  73   let%lwt () = Lwt_unix.sleep 0.5 in
  74   let%lwt () = Lwt.choose tasks in
  75   print_endline "Cancel remaining transfers";
  76   Lwt.return ()
  77
  78 let () =
  79   printfn "Launch %d transfers" (List.length urls);
  80   let tasks = List.map get urls in
  81   Lwt_main.run @@ Lwt.pick [
  82     wait_one tasks;
  83     Lwt.join tasks
  84   ]