[Pkg-ocaml-maint-commits] [ocurl] 09/23: Imported Upstream version 0.7.1
Stéphane Glondu
glondu at moszumanska.debian.org
Tue Feb 23 10:20:24 UTC 2016
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository ocurl.
commit 2abe9245e2b9a47a1b615d02b15e00cde3996aef
Author: Stephane Glondu <steph at glondu.net>
Date: Tue Feb 23 10:41:50 2016 +0100
Imported Upstream version 0.7.1
---
.gitignore | 1 +
CHANGES.txt | 7 ++
configure | 18 +++---
configure.in | 2 +-
curl-helper.c | 162 +++++++++++++++++++++-------------------------
curl.ml | 9 ++-
curl.mli | 3 +
curl_lwt.ml | 7 +-
examples/Makefile.in | 24 ++++---
examples/test_lwt.ml | 34 ++++++----
examples/test_lwt_unit.ml | 35 ++++++++++
11 files changed, 179 insertions(+), 123 deletions(-)
diff --git a/.gitignore b/.gitignore
index 5489ec0..f46c429 100644
--- a/.gitignore
+++ b/.gitignore
@@ -19,4 +19,5 @@ examples/ocurl
examples/ocurl_test_threads
examples/test_cb_exn
examples/test_lwt
+examples/test_lwt_unit
/doc
diff --git a/CHANGES.txt b/CHANGES.txt
index b87370d..57ab9c7 100644
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,3 +1,10 @@
+0.7.1 - 12 May 2014
+
+ * Multi: win32 support (arirux)
+ + Multi.remove
+ * lwt: handle Lwt.cancel
+ * lwt: fix set_errorbuffer
+
0.7.0 - 8 Mar 2014
* Curl_lwt: basic Lwt interface
diff --git a/configure b/configure
index 6c2a339..823e440 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for ocurl 0.7.0.
+# Generated by GNU Autoconf 2.69 for ocurl 0.7.1.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
@@ -577,8 +577,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='ocurl'
PACKAGE_TARNAME='ocurl'
-PACKAGE_VERSION='0.7.0'
-PACKAGE_STRING='ocurl 0.7.0'
+PACKAGE_VERSION='0.7.1'
+PACKAGE_STRING='ocurl 0.7.1'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -1242,7 +1242,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures ocurl 0.7.0 to adapt to many kinds of systems.
+\`configure' configures ocurl 0.7.1 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1303,7 +1303,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of ocurl 0.7.0:";;
+ short | recursive ) echo "Configuration of ocurl 0.7.1:";;
esac
cat <<\_ACEOF
@@ -1383,7 +1383,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-ocurl configure 0.7.0
+ocurl configure 0.7.1
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1681,7 +1681,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by ocurl $as_me 0.7.0, which was
+It was created by ocurl $as_me 0.7.1, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -8520,7 +8520,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by ocurl $as_me 0.7.0, which was
+This file was extended by ocurl $as_me 0.7.1, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -8582,7 +8582,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-ocurl config.status 0.7.0
+ocurl config.status 0.7.1
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/configure.in b/configure.in
index 89efcc2..8a5024d 100644
--- a/configure.in
+++ b/configure.in
@@ -2,7 +2,7 @@ dnl
dnl ocurl autoconf input
dnl
-AC_INIT(ocurl,0.7.0)
+AC_INIT(ocurl,0.7.1)
AC_PROG_CC()
diff --git a/curl-helper.c b/curl-helper.c
index 54ca9d1..36c75d5 100644
--- a/curl-helper.c
+++ b/curl-helper.c
@@ -17,6 +17,7 @@
#include <caml/mlvalues.h>
#include <caml/callback.h>
#include <caml/fail.h>
+#include <caml/unixsupport.h>
#include <caml/custom.h>
#ifdef HAVE_CONFIG_H
@@ -1160,15 +1161,15 @@ static void resetOcamlValues(Connection* connection)
Store_field(connection->ocamlValues, i, Val_unit);
}
-static Connection *newConnection(void)
+static Connection* allocConnection(CURL* h)
{
- Connection *connection;
+ Connection* connection = (Connection *)malloc(sizeof(Connection));
- connection = (Connection *)malloc(sizeof(Connection));
+ connection->ocamlValues = caml_alloc(OcamlValuesSize, 0);
+ resetOcamlValues(connection);
+ register_global_root(&connection->ocamlValues);
- enter_blocking_section();
- connection->connection = curl_easy_init();
- leave_blocking_section();
+ connection->connection = h;
connection->next = NULL;
connection->prev = NULL;
@@ -1185,10 +1186,6 @@ static Connection *newConnection(void)
connectionList.head = connection;
}
- connection->ocamlValues = caml_alloc(OcamlValuesSize, 0);
- resetOcamlValues(connection);
- register_global_root(&connection->ocamlValues);
-
connection->refcount = 0;
connection->url = NULL;
@@ -1240,34 +1237,27 @@ static Connection *newConnection(void)
return connection;
}
-static Connection *duplicateConnection(Connection *original)
+static Connection *newConnection(void)
{
- Connection *connection;
+ CURL* h;
- connection = (Connection *)malloc(sizeof(Connection));
+ caml_enter_blocking_section();
+ h = curl_easy_init();
+ caml_leave_blocking_section();
- enter_blocking_section();
- connection->connection = curl_easy_duphandle(original->connection);
- leave_blocking_section();
+ return allocConnection(h);
+}
- connection->next = NULL;
- connection->prev = NULL;
+static Connection *duplicateConnection(Connection *original)
+{
+ Connection *connection;
+ CURL* h;
- if (connectionList.tail == NULL)
- {
- connectionList.tail = connection;
- connectionList.head = connection;
- }
- else
- {
- connection->prev = connectionList.head;
- connectionList.head->next = connection;
- connectionList.head = connection;
- }
+ caml_enter_blocking_section();
+ h = curl_easy_duphandle(original->connection);
+ caml_leave_blocking_section();
- connection->ocamlValues = alloc(OcamlValuesSize, 0);
- resetOcamlValues(connection);
- register_global_root(&connection->ocamlValues);
+ connection = allocConnection(h);
Store_field(connection->ocamlValues, OcamlWriteCallback,
Field(original->ocamlValues, OcamlWriteCallback));
@@ -1296,53 +1286,6 @@ static Connection *duplicateConnection(Connection *original)
Store_field(connection->ocamlValues, OcamlSeekFunctionCallback,
Field(original->ocamlValues, OcamlSeekFunctionCallback));
- connection->refcount = 0;
-
- connection->url = NULL;
- connection->proxy = NULL;
- connection->userPwd = NULL;
- connection->proxyUserPwd = NULL;
- connection->range = NULL;
- connection->errorBuffer = NULL;
- connection->postFields = NULL;
- connection->postFieldSize = -1;
- connection->referer = NULL;
- connection->userAgent = NULL;
- connection->ftpPort = NULL;
- connection->cookie = NULL;
- connection->httpHeader = NULL;
- connection->httpPostFirst = NULL;
- connection->httpPostLast = NULL;
- connection->httpPostStrings = NULL;
- connection->sslCert = NULL;
- connection->sslCertType = NULL;
- connection->sslCertPasswd = NULL;
- connection->sslKey = NULL;
- connection->sslKeyType = NULL;
- connection->sslKeyPasswd = NULL;
- connection->sslEngine = NULL;
- connection->quote = NULL;
- connection->postQuote = NULL;
- connection->cookieFile = NULL;
- connection->customRequest = NULL;
- connection->interface_ = NULL;
- connection->caInfo = NULL;
- connection->caPath = NULL;
- connection->randomFile = NULL;
- connection->egdSocket = NULL;
- connection->cookieJar = NULL;
- connection->sslCipherList = NULL;
- connection->private = NULL;
- connection->http200Aliases = NULL;
- connection->netrcFile = NULL;
- connection->ftpaccount = NULL;
- connection->cookielist = NULL;
- connection->sshPublicKeyFile = NULL;
- connection->sshPrivateKeyFile = NULL;
- connection->copyPostFields = NULL;
- connection->resolve = NULL;
- connection->dns_servers = NULL;
-
if (Field(original->ocamlValues, OcamlURL) != Val_unit)
handleURL(connection, Field(original->ocamlValues,
OcamlURL));
@@ -6409,6 +6352,7 @@ CAMLprim value caml_curlm_remove_finished(value v_multi)
CURL* handle;
CURLM* multi_handle;
CURLcode result;
+ Connection* conn = NULL;
multi_handle = CURLM_val(v_multi);
@@ -6422,8 +6366,13 @@ CAMLprim value caml_curlm_remove_finished(value v_multi)
}
else
{
+ conn = findConnection(handle);
+ if (conn->errorBuffer != NULL)
+ {
+ Store_field(Field(conn->ocamlValues, OcamlErrorBuffer), 0, caml_copy_string(conn->errorBuffer));
+ }
/* NB: same handle, but different block */
- v_easy = caml_curl_alloc(findConnection(handle));
+ v_easy = caml_curl_alloc(conn);
v_tuple = caml_alloc(2, 0);
Store_field(v_tuple,0,v_easy);
Store_field(v_tuple,1,Val_int(result)); /* CURLcode */
@@ -6491,6 +6440,24 @@ CAMLprim value caml_curl_multi_add_handle(value v_multi, value v_easy)
CAMLreturn(Val_unit);
}
+CAMLprim value caml_curl_multi_remove_handle(value v_multi, value v_easy)
+{
+ CAMLparam2(v_multi,v_easy);
+ CURLM* multi = CURLM_val(v_multi);
+ CURL* easy = Connection_val(v_easy)->connection;
+
+ /* may invoke callbacks so need to be consistent with locks */
+ caml_enter_blocking_section();
+ if (CURLM_OK != curl_multi_remove_handle(multi, easy))
+ {
+ caml_leave_blocking_section();
+ failwith("caml_curl_multi_remove_handle");
+ }
+ caml_leave_blocking_section();
+
+ CAMLreturn(Val_unit);
+}
+
CAMLprim value caml_curl_multi_perform_all(value v_multi)
{
CAMLparam1(v_multi);
@@ -6515,9 +6482,21 @@ CAMLprim value helper_curl_easy_strerror(value v_code)
* Based on curl hiperfifo.c example
*/
-/* FIXME win32unix */
-#define Socket_val(v) Int_val(v)
+#ifdef _WIN32
+#ifndef Val_socket
+#define Val_socket(v) win_alloc_socket(v)
+#endif
+#ifndef Socket_val
+#error Socket_val not defined in unixsupport.h
+#endif
+#else /* _WIN32 */
+#ifndef Socket_val
+#define Socket_val(v) Long_val(v)
+#endif
+#ifndef Val_socket
#define Val_socket(v) Val_int(v)
+#endif
+#endif /* _WIN32 */
static void raise_error(char const* msg)
{
@@ -6557,9 +6536,18 @@ CAMLprim value caml_curl_multi_socket_action(value v_multi, value v_fd, value v_
CURLM* h = CURLM_val(v_multi);
int still_running = 0;
CURLMcode rc = CURLM_OK;
- int socket = Socket_val(v_fd);
+ curl_socket_t socket;
int kind = 0;
+ if (Val_none == v_fd)
+ {
+ socket = CURL_SOCKET_TIMEOUT;
+ }
+ else
+ {
+ socket = Socket_val(Field(v_fd, 0));
+ }
+
switch (Int_val(v_kind))
{
case 0 : break;
@@ -6570,7 +6558,7 @@ CAMLprim value caml_curl_multi_socket_action(value v_multi, value v_fd, value v_
raise_error("caml_curl_multi_socket_action");
}
-/* fprintf(stdout,"fd %u kind %u\n",Socket_val(v_fd), kind); fflush(stdout); */
+/* fprintf(stdout,"fd %u kind %u\n",socket, kind); fflush(stdout); */
caml_enter_blocking_section();
do {
@@ -6604,7 +6592,7 @@ CAMLprim value caml_curl_multi_socket_all(value v_multi)
static int curlm_sock_cb_nolock(CURL *e, curl_socket_t sock, int what, ml_multi_handle* multi, void *sockp)
{
CAMLparam0();
- CAMLlocal1(v_what);
+ CAMLlocal2(v_what,csock);
(void)e;
(void)sockp; /* not used */
@@ -6621,9 +6609,9 @@ static int curlm_sock_cb_nolock(CURL *e, curl_socket_t sock, int what, ml_multi_
fflush(stderr);
raise_error("curlm_sock_cb"); /* FIXME exception from callback */
}
-
+ csock=Val_socket(sock);
caml_callback2(Field(multi->values,curlmopt_socket_function),
- Val_socket(sock), v_what);
+ csock, v_what);
CAMLreturn(0);
}
diff --git a/curl.ml b/curl.ml
index 54c3451..026a80a 100644
--- a/curl.ml
+++ b/curl.ml
@@ -1298,6 +1298,7 @@ module Multi = struct
external add : mt -> t -> unit = "caml_curl_multi_add_handle"
external perform : mt -> int = "caml_curl_multi_perform_all"
external wait : mt -> bool = "caml_curlm_wait_data"
+ external remove : mt -> t -> unit = "caml_curl_multi_remove_handle"
external remove_finished : mt -> (t * curlCode) option = "caml_curlm_remove_finished"
external cleanup : mt -> unit = "caml_curl_multi_cleanup"
@@ -1310,12 +1311,10 @@ module Multi = struct
external set_socket_function : mt -> (Unix.file_descr -> poll -> unit) -> unit = "caml_curl_multi_socketfunction"
external set_timer_function : mt -> (int -> unit) -> unit = "caml_curl_multi_timerfunction"
external action_all : mt -> int = "caml_curl_multi_socket_all"
- external action : mt -> Unix.file_descr -> fd_status -> int = "caml_curl_multi_socket_action"
+ external socket_action : mt -> Unix.file_descr option -> fd_status -> int = "caml_curl_multi_socket_action"
- let action_timeout mt =
- (* FIXME win32unix *)
- let curl_socket_timeout = (Obj.magic (-1) : Unix.file_descr) in
- ignore (action mt curl_socket_timeout EV_AUTO)
+ let action_timeout mt = ignore (socket_action mt None EV_AUTO)
+ let action mt fd status = socket_action mt (Some fd) status
external timeout : mt -> int = "caml_curl_multi_timeout"
diff --git a/curl.mli b/curl.mli
index f7b5817..9b704f2 100644
--- a/curl.mli
+++ b/curl.mli
@@ -874,6 +874,9 @@ module Multi : sig
(** add handle to multi stack *)
val add : mt -> t -> unit
+ (** remove handle from multi stack (effectively halting the transfer) *)
+ val remove : mt -> t -> unit
+
(** perform pending data transfers (if any) on all handles currently in multi stack
@return the number of handles that still transfer data *)
val perform : mt -> int
diff --git a/curl_lwt.ml b/curl_lwt.ml
index 2f416a2..c02ac04 100644
--- a/curl_lwt.ml
+++ b/curl_lwt.ml
@@ -91,6 +91,11 @@ let global = lazy (create ())
let perform h =
let t = Lazy.force global in
let (waiter,wakener) = Lwt.wait () in
- M.add t.mt h;
+ let waiter = Lwt.protected waiter in
+ Lwt.on_cancel waiter (fun () ->
+ Curl.Multi.remove t.mt h;
+ Hashtbl.remove t.wakeners h;
+ );
Hashtbl.add t.wakeners h wakener;
+ M.add t.mt h;
waiter
diff --git a/examples/Makefile.in b/examples/Makefile.in
index 7f90424..f0c4beb 100644
--- a/examples/Makefile.in
+++ b/examples/Makefile.in
@@ -18,28 +18,36 @@ OCURLOPTLIB = curl.cmxa unix.cmxa threads.cmxa
TARGETS = ocurl oput ominimal ossl ocurl_test_threads opar test_cb_exn
ifneq (@OCAML_PKG_lwt@,no)
-TARGETS += test_lwt
+TARGETS += test_lwt test_lwt_unit
endif
ifeq (@OCAMLBEST@,opt)
TARGETS += ocurl.opt oput.opt ominimal.opt ossl.opt ocurl_test_threads.opt opar.opt test_cb_exn.opt
ifneq (@OCAML_PKG_lwt@,no)
-TARGETS += test_lwt.opt
+TARGETS += test_lwt.opt test_lwt_unit.opt
endif
endif
all: $(TARGETS)
-test_lwt: test_lwt.ml
- $(FINDLIB) c -custom -linkpkg -package lwt.unix $(LFLAGS) curl.cma curl_lwt.cmo $< -o $@
+FINDLIB_LWT_FLAGS=-linkpkg -syntax camlp4o -package lwt.unix,lwt.syntax
-test_lwt.opt: test_lwt.ml
- $(FINDLIB) opt -linkpkg -package lwt.unix $(LFLAGS) curl.cmxa curl_lwt.cmx $< -o $@
+test_lwt: ../curl.cma ../curl_lwt.cmo test_lwt.ml
+ $(FINDLIB) c -custom $(FINDLIB_LWT_FLAGS) $(LFLAGS) $^ -o $@
-%: %.cmo
+test_lwt.opt: ../curl.cmxa ../curl_lwt.cmx test_lwt.ml
+ $(FINDLIB) opt $(FINDLIB_LWT_FLAGS) $(LFLAGS) $^ -o $@
+
+test_lwt_unit: ../curl.cma ../curl_lwt.cmo test_lwt_unit.ml
+ $(FINDLIB) c -custom $(FINDLIB_LWT_FLAGS) $(LFLAGS) $^ -o $@
+
+test_lwt_unit.opt: ../curl.cmxa ../curl_lwt.cmx test_lwt_unit.ml
+ $(FINDLIB) opt $(FINDLIB_LWT_FLAGS) $(LFLAGS) $^ -o $@
+
+%: %.cmo ../curl.cma
$(OCBYTE) -custom $(LFLAGS) $(OCURLLIB) $< -o $@
-%.opt: %.cmx
+%.opt: %.cmx ../curl.cmxa
$(OCOPT) $(LFLAGS) $(OCURLOPTLIB) $< -o $@
.ml.cmx:
diff --git a/examples/test_lwt.ml b/examples/test_lwt.ml
index 0db7185..acfb563 100644
--- a/examples/test_lwt.ml
+++ b/examples/test_lwt.ml
@@ -5,6 +5,8 @@ open Printf
let (@@) f x = f x
let (|>) x f = f x
+let printfn fmt = ksprintf print_endline fmt
+
let curl_setup_simple h =
let open Curl in
set_useragent h "Curl_lwt";
@@ -18,7 +20,7 @@ let curl_setup_simple h =
let log_curl h code =
let open Curl in
let url = get_effectiveurl h in
- print_endline @@ sprintf "%3d %.2f %g URL: %s (%s)%s"
+ printfn "%3d %.2f %g URL: %s (%s)%s"
(get_httpcode h)
(get_totaltime h)
(get_sizedownload h)
@@ -35,14 +37,19 @@ let get url =
let h = Curl.init () in
Curl.set_url h url;
curl_setup_simple h;
-(* lwt (code,body) = download h in *)
- Lwt.bind (download h) @@ fun (code,_body) ->
- log_curl h code;
- (* do something with body *)
- Curl.cleanup h;
- Lwt.return ()
-
-let run () =
+ try_lwt (* e.g. Canceled *)
+ lwt (code,_body) = download h in
+ log_curl h code;
+ Lwt.return ()
+ (* do something with body *)
+ with exn ->
+ printfn "EXN %s URL: %s" (Printexc.to_string exn) url;
+ Lwt.fail exn
+ finally
+ Curl.cleanup h;
+ Lwt.return ()
+
+let urls =
[
"www.google.com";
"ya.ru";
@@ -51,8 +58,11 @@ let run () =
"www.mozart-oz.org";
"forge.ocamlcore.org";
]
- |> List.map get
- |> Lwt.join
let () =
- Lwt_main.run @@ run ()
+ printfn "Launch %d transfers" (List.length urls);
+ let tasks = List.map get urls in
+ Lwt_main.run @@ Lwt.pick [
+ Lwt_unix.sleep 0.75 >> Lwt.choose tasks >> Lwt.return (print_endline "Cancel remaining transfers");
+ Lwt.join tasks
+ ]
diff --git a/examples/test_lwt_unit.ml b/examples/test_lwt_unit.ml
new file mode 100644
index 0000000..e2df03f
--- /dev/null
+++ b/examples/test_lwt_unit.ml
@@ -0,0 +1,35 @@
+(* Copyright (c) 2014, Thomas Leonard, <talex5 at gmail.com> *)
+
+open Curl
+open Printf
+
+let verbose = false
+
+let (|>) x f = f x
+let printfn fmt = ksprintf print_endline fmt
+
+let setup buf =
+ let h = init () in
+ set_url h "http://localhost:1/missing.png";
+ set_errorbuffer h buf;
+ h
+
+let () =
+ let buf1 = ref "" in
+ let h = setup buf1 in
+ (* easy *)
+ let () = try
+ perform h
+ with CurlException (code,_,_) ->
+ if verbose then printfn "Sync errors: %s <%s>" (strerror code) !buf1
+ in
+ (* lwt *)
+ let buf2 = ref "" in
+ let h = setup buf2 in
+ let code = Curl_lwt.perform h |> Lwt_main.run in
+ if verbose then printfn "Lwt errors: %s <%s>" (strerror code) !buf2;
+
+ if buf1 <> buf2 then
+ (printfn "FAILED: %S <> %S" !buf1 !buf2; exit 1)
+ else
+ (printfn "OK"; exit 0)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocurl.git
More information about the Pkg-ocaml-maint-commits
mailing list