Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

pushed multi api

  • Loading branch information...
commit 06c0fc9aa7f0a79caf71dfb6914709a0a4976f56 1 parent 1087e3f
@marcomaggi authored
View
168 doc/vicare-curl.texi
@@ -1066,6 +1066,7 @@ error code; if @var{code} is invalid, return @false{}.
@menu
+* plain multi examples:: Some simple usage examples.
* plain multi struct:: Multi operations handle.
* plain multi init:: Multi initialisation and finalisation.
* plain multi easy:: Adding and removing easy handles.
@@ -1078,6 +1079,165 @@ error code; if @var{code} is invalid, return @false{}.
@end menu
@c page
+@node plain multi examples
+@subsection Some simple usage examples
+
+
+The following example downloads the page at @url{http://google.com/}
+using @func{curl-multi-perform}, @func{curl-multi-fdset} and
+@func{curl-multi-timeout}:
+
+@smallexample
+#!r6rs
+(import (vicare)
+ (vicare net curl)
+ (vicare net curl constants)
+ (prefix (vicare ffi) ffi.)
+ (prefix (vicare posix) px.)
+ (vicare syntactic-extensions))
+
+(define-inline (%pretty-print ?thing)
+ (pretty-print ?thing (current-error-port)))
+
+(define (write-func buffer size nitems outstream)
+ (let ((nbytes (* size nitems)))
+ (guard (E (else (check-pretty-print E) nbytes))
+ (fprintf (current-error-port) "Google's Home page:\n~a\n"
+ (utf8->string (cstring->bytevector buffer nbytes))))
+ nbytes))
+
+(define (%curl-multi-perform multi)
+ (let loop ()
+ (let-values (((code still-running)
+ (curl-multi-perform multi)))
+ (if (= code CURLM_CALL_MULTI_PERFORM)
+ (loop)
+ (values code still-running)))))
+
+(let ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (rfdset (px.make-fd-set-pointer))
+ (wfdset (px.make-fd-set-pointer))
+ (write-cb (make-curl-write-callback write-func)))
+ (unwind-protect
+ (begin
+ (curl-easy-setopt easy CURLOPT_URL "http://google.com/")
+ (curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
+ (curl-easy-setopt easy CURLOPT_WRITEDATA #f)
+ (curl-multi-add-handle multi easy)
+ (let loop ()
+ (let-values (((code still-running)
+ (%curl-multi-perform multi)))
+ (unless (zero? still-running)
+ (let-values (((code milliseconds)
+ (curl-multi-timeout multi)))
+ (when (and (= code CURLM_OK)
+ (<= 0 milliseconds))
+ (px.FD_ZERO rfdset)
+ (px.FD_ZERO wfdset)
+ (let-values (((code max-fd)
+ (curl-multi-fdset multi
+ rfdset wfdset #f))
+ ((secs nsecs)
+ (div-and-mod milliseconds 1000)))
+ (when (= code CURLM_OK)
+ (px.select-from-sets (+ 1 max-fd)
+ rfdset wfdset #f secs nsecs)
+ (loop))))))))
+ (let-values (((msg nmsgs)
+ (curl-multi-info-read multi)))
+ (when msg
+ (%pretty-print
+ (curl-constant-msg->symbol (curl-msg.msg msg))))))
+ ;;Close handles before releasing the callbacks!!!
+ (curl-multi-cleanup multi)
+ (curl-easy-cleanup easy)
+ (ffi.free-c-callback write-cb)
+ (free rfdset)
+ (free wfdset)))
+@end smallexample
+
+The following example downloads the page at @url{http://google.com/}
+using @func{curl-multi-perform}, @func{curl-multi-fdset} and the multi
+timer callback:
+
+@smallexample
+#!r6rs
+(import (vicare)
+ (vicare net curl)
+ (vicare net curl constants)
+ (prefix (vicare ffi) ffi.)
+ (prefix (vicare posix) px.)
+ (vicare syntactic-extensions))
+
+(define-inline (%pretty-print ?thing)
+ (pretty-print ?thing (current-error-port)))
+
+(define (write-func buffer size nitems outstream)
+ (let ((nbytes (* size nitems)))
+ (guard (E (else (check-pretty-print E) nbytes))
+ (fprintf (current-error-port) "Google's Home page:\n~a\n"
+ (utf8->string (cstring->bytevector buffer nbytes))))
+ nbytes))
+
+(define (%curl-multi-perform multi)
+ (let loop ()
+ (let-values (((code still-running)
+ (curl-multi-perform multi)))
+ (if (= code CURLM_CALL_MULTI_PERFORM)
+ (loop)
+ (values code still-running)))))
+
+(let* ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (milliseconds -1)
+ (rfdset (px.make-fd-set-pointer))
+ (wfdset (px.make-fd-set-pointer))
+ (write-cb (make-curl-write-callback write-func))
+ (timer-cb (make-curl-multi-timer-callback
+ (lambda (multi ms custom-data)
+ (set! milliseconds ms)
+ 0))))
+ (unwind-protect
+ (begin
+ (curl-easy-setopt easy CURLOPT_URL "http://google.com/")
+ (curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
+ (curl-easy-setopt easy CURLOPT_WRITEDATA #f)
+ (curl-multi-setopt multi CURLMOPT_TIMERFUNCTION timer-cb)
+ (curl-multi-setopt multi CURLMOPT_TIMERDATA #f)
+ (curl-multi-add-handle multi easy)
+ (let loop ()
+ (let-values (((code still-running)
+ (%curl-multi-perform multi)))
+ (when (and (not (zero? still-running))
+ (<= 0 milliseconds))
+ (px.FD_ZERO rfdset)
+ (px.FD_ZERO wfdset)
+ (let-values (((code max-fd)
+ (curl-multi-fdset multi
+ rfdset wfdset #f))
+ ((secs nsecs)
+ (div-and-mod milliseconds 1000)))
+ (when (= code CURLM_OK)
+ (px.select-from-sets (+ 1 max-fd)
+ rfdset wfdset #f secs nsecs)
+ (loop))))))
+ (let-values (((msg nmsgs)
+ (curl-multi-info-read multi)))
+ (when msg
+ (%pretty-print
+ (curl-constant-msg->symbol (curl-msg.msg msg)))))
+ #t)
+ ;;Close handles before releasing the callbacks!!!
+ (curl-multi-cleanup multi)
+ (curl-easy-cleanup easy)
+ (ffi.free-c-callback write-cb)
+ (ffi.free-c-callback timer-cb)
+ (free rfdset)
+ (free wfdset)))
+@end smallexample
+
+@c page
@node plain multi struct
@subsection Multi operations handle
@@ -1431,10 +1591,10 @@ descriptors are set.
@curlman{curl_multi_fdset}.
@var{read-fds}, @var{write-fds}, @var{exc-fds} must be @false{} or
-bytevectors, pointer objects or @code{memory-block} holding or
-referencing C language structures of type @code{fd_set}, ready to
-receive socket descriptors registration; when @false{} an empty
-@code{fd_set} is internally allocated and used.
+pointer objects or @code{memory-block} holding or referencing C language
+structures of type @code{fd_set}, ready to receive socket descriptors
+registration; when @false{} an empty @code{fd_set} is internally
+allocated and used.
@end defun
View
29 lib/vicare/net/curl.sls
@@ -315,6 +315,25 @@
;;; --------------------------------------------------------------------
+(define-argument-validation (general-sticky-buffer who obj)
+ ;;A general "sticky" buffer is a block of memory that is NOT moved
+ ;;around by the garbage collector.
+ ;;
+ (or (pointer? obj)
+ (memory-block? obj))
+ (assertion-violation who
+ "expected pointer or memory-block as general sticky buffer argument" obj))
+
+(define-argument-validation (general-sticky-buffer/false who obj)
+ (or (not obj)
+ (pointer? obj)
+ (memory-block? obj))
+ (assertion-violation who
+ "expected false or pointer or memory-block as general sticky buffer argument"
+ obj))
+
+;;; --------------------------------------------------------------------
+
(define-argument-validation (general-data who obj)
(or (bytevector? obj)
(pointer? obj)
@@ -372,8 +391,8 @@
(define-argument-validation (action-socket-descriptor who obj)
(and (fixnum? obj)
- (unsafe.fx= obj CURL_SOCKET_TIMEOUT)
- (unsafe.fx<= 0 obj))
+ (or (unsafe.fx= obj CURL_SOCKET_TIMEOUT)
+ (unsafe.fx<= 0 obj)))
(assertion-violation who
"expected CURL_SOCKET_TIMEOUT or non-negative fixnum as socket descriptor argument"
obj))
@@ -1573,9 +1592,9 @@
(define who 'curl-multi-fdset)
(with-arguments-validation (who)
((curl-multi/alive multi)
- (general-buffer/false read-fds)
- (general-buffer/false write-fds)
- (general-buffer/false exc-fds))
+ (general-sticky-buffer/false read-fds)
+ (general-sticky-buffer/false write-fds)
+ (general-sticky-buffer/false exc-fds))
(let ((rv (capi.curl-multi-fdset multi read-fds write-fds exc-fds)))
(values (unsafe.car rv)
(unsafe.cdr rv)))))
View
2  src/vicare-curl-multi.c
@@ -193,6 +193,8 @@ ikrt_curl_multi_fdset (ikptr s_multi,
{
#ifdef HAVE_CURL_MULTI_FDSET
CURLM * multi = IK_CURL_MULTI(s_multi);
+ /* These fd_sets must be pointers or memory-blocks, not
+ bytevectors. */
fd_set * read_fds = \
IK_VOIDP_FROM_BYTEVECTOR_OR_POINTER_OR_MBLOCK_OR_FALSE(s_read_fds);
fd_set * write_fds = \
View
349 tests/demo-multi.sps
@@ -31,7 +31,9 @@
(vicare net curl constants)
(vicare net curl features)
(prefix (vicare ffi) ffi.)
+ (prefix (vicare posix) px.)
(vicare syntactic-extensions)
+ (vicare platform-constants)
(vicare checks))
(check-set-mode! 'report-failed)
@@ -71,44 +73,357 @@
(parametrise ((check-test-name 'perform))
+ (check ;ugly perform, no redirection
+ (let ()
+ (define (write-func buffer size nitems outstream)
+ (let ((nbytes (* size nitems)))
+;;; (check-pretty-print (list 'enter size nitems nbytes))
+ (guard (E (else (check-pretty-print E) nbytes))
+ (fprintf (current-error-port) "Google's Home page:\n~a\n"
+ (utf8->string (cstring->bytevector buffer nbytes))))
+;;; (check-pretty-print (list 'leave size nitems nbytes))
+ nbytes))
+ (let ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (write-cb (make-curl-write-callback write-func))
+ (debug-cb (make-curl-debug-callback debug-func)))
+ (unwind-protect
+ (begin
+ (curl-easy-setopt easy CURLOPT_URL "http://google.com/")
+ (curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
+ (curl-easy-setopt easy CURLOPT_WRITEDATA #f)
+ #;(curl-easy-setopt easy CURLOPT_VERBOSE #t)
+ #;(curl-easy-setopt easy CURLOPT_DEBUGFUNCTION debug-cb)
+ #;(curl-easy-setopt easy CURLOPT_DEBUGDATA #f)
+ (curl-multi-add-handle multi easy)
+ (let loop ()
+ (let-values (((code running)
+ (curl-multi-perform multi)))
+ (when (or (= code CURLM_CALL_MULTI_PERFORM)
+ (not (zero? running)))
+ (loop))))
+ (let-values (((msg nmsgs)
+ (curl-multi-info-read multi)))
+ (when msg
+ (%pretty-print (curl-constant-msg->symbol (curl-msg.msg msg)))))
+ #t)
+ (curl-multi-cleanup multi)
+ ;;Close the connection before releasing the callbacks!!!
+ (curl-easy-cleanup easy)
+ (ffi.free-c-callback write-cb)
+ (ffi.free-c-callback debug-cb))))
+ => #t)
+
+;;; --------------------------------------------------------------------
+
+ (check ;better perform, no redirection
+ (let ()
+ (define (write-func buffer size nitems outstream)
+ (let ((nbytes (* size nitems)))
+ (guard (E (else (check-pretty-print E) nbytes))
+ (fprintf (current-error-port) "Google's Home page:\n~a\n"
+ (utf8->string (cstring->bytevector buffer nbytes))))
+ nbytes))
+ (define (%curl-multi-perform multi)
+ (let loop ()
+ (let-values (((code still-running)
+ (curl-multi-perform multi)))
+ (if (= code CURLM_CALL_MULTI_PERFORM)
+ (loop)
+ (values code still-running)))))
+ (let ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (rfdset (px.make-fd-set-pointer))
+ (wfdset (px.make-fd-set-pointer))
+ (write-cb (make-curl-write-callback write-func)))
+ (unwind-protect
+ (begin
+ (curl-easy-setopt easy CURLOPT_URL "http://google.com/")
+ (curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
+ (curl-easy-setopt easy CURLOPT_WRITEDATA #f)
+ (curl-multi-add-handle multi easy)
+ (let loop ()
+ (let-values (((code still-running)
+ (%curl-multi-perform multi)))
+ (unless (zero? still-running)
+ (let-values (((code milliseconds)
+ (curl-multi-timeout multi)))
+ (when (and (= code CURLM_OK)
+ (<= 0 milliseconds))
+ (px.FD_ZERO rfdset)
+ (px.FD_ZERO wfdset)
+ (let-values (((code max-fd)
+ (curl-multi-fdset multi rfdset wfdset #f))
+ ((secs nsecs)
+ (div-and-mod milliseconds 1000)))
+ (when (= code CURLM_OK)
+ (px.select-from-sets (+ 1 max-fd) rfdset wfdset #f secs nsecs)
+ (loop))))))))
+ (let-values (((msg nmsgs)
+ (curl-multi-info-read multi)))
+ (when msg
+ (%pretty-print (curl-constant-msg->symbol (curl-msg.msg msg)))))
+ #t)
+ ;;Close handles before releasing the callbacks!!!
+ (curl-multi-cleanup multi)
+ (curl-easy-cleanup easy)
+ (ffi.free-c-callback write-cb)
+ (free rfdset)
+ (free wfdset))))
+ => #t)
+
+;;; --------------------------------------------------------------------
+
+ (check ;better perform, timeout callback, no redirection
+ (let ()
+ (define (write-func buffer size nitems outstream)
+ (let ((nbytes (* size nitems)))
+ (guard (E (else (check-pretty-print E) nbytes))
+ (fprintf (current-error-port) "Google's Home page:\n~a\n"
+ (utf8->string (cstring->bytevector buffer nbytes))))
+ nbytes))
+ (define (%curl-multi-perform multi)
+ (let loop ()
+ (let-values (((code still-running)
+ (curl-multi-perform multi)))
+ (if (= code CURLM_CALL_MULTI_PERFORM)
+ (loop)
+ (values code still-running)))))
+ (let* ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (milliseconds -1)
+ (rfdset (px.make-fd-set-pointer))
+ (wfdset (px.make-fd-set-pointer))
+ (write-cb (make-curl-write-callback write-func))
+ (timer-cb (make-curl-multi-timer-callback
+ (lambda (multi ms custom-data)
+ (set! milliseconds ms)
+ 0))))
+ (unwind-protect
+ (begin
+ (curl-easy-setopt easy CURLOPT_URL "http://google.com/")
+ (curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
+ (curl-easy-setopt easy CURLOPT_WRITEDATA #f)
+ (curl-multi-setopt multi CURLMOPT_TIMERFUNCTION timer-cb)
+ (curl-multi-setopt multi CURLMOPT_TIMERDATA #f)
+ (curl-multi-add-handle multi easy)
+ (let loop ()
+ (let-values (((code still-running)
+ (%curl-multi-perform multi)))
+ (when (and (not (zero? still-running))
+ (<= 0 milliseconds))
+ (px.FD_ZERO rfdset)
+ (px.FD_ZERO wfdset)
+ (let-values (((code max-fd)
+ (curl-multi-fdset multi rfdset wfdset #f))
+ ((secs nsecs)
+ (div-and-mod milliseconds 1000)))
+ (when (= code CURLM_OK)
+ (px.select-from-sets (+ 1 max-fd) rfdset wfdset #f secs nsecs)
+ (loop))))))
+ (let-values (((msg nmsgs)
+ (curl-multi-info-read multi)))
+ (when msg
+ (%pretty-print (curl-constant-msg->symbol (curl-msg.msg msg)))))
+ #t)
+ ;;Close handles before releasing the callbacks!!!
+ (curl-multi-cleanup multi)
+ (curl-easy-cleanup easy)
+ (ffi.free-c-callback write-cb)
+ (ffi.free-c-callback timer-cb)
+ (free rfdset)
+ (free wfdset))))
+ => #t)
+
+ (collect))
+
+
+(parametrise ((check-test-name 'sockets))
+
+ (define-struct pending-socks
+ (rd-requests
+ ;Null or a list of socket descriptors for which reading
+ ;is requested.
+ wr-requests
+ ;Null or a list of socket descriptors for which writing
+ ;is requested.
+ rw-requests
+ ;Null or a list of socket descriptors for which reading
+ ;or writing is requested.
+ ))
+
+ (define (%make-pending-socks)
+ (make-pending-socks '() '() '()))
+
+ (define (pending-socks-remove! ps sock-fd)
+ (pending-socks-remove-from-rd-requests! ps sock-fd)
+ (pending-socks-remove-from-wr-requests! ps sock-fd)
+ (pending-socks-remove-from-rw-requests! ps sock-fd))
+
+ (define (pending-socks-remove-from-rd-requests! ps sock-fd)
+ (set-pending-socks-rd-requests! ps (remq sock-fd (pending-socks-rd-requests ps))))
+
+ (define (pending-socks-remove-from-wr-requests! ps sock-fd)
+ (set-pending-socks-wr-requests! ps (remq sock-fd (pending-socks-wr-requests ps))))
+
+ (define (pending-socks-remove-from-rw-requests! ps sock-fd)
+ (set-pending-socks-rw-requests! ps (remq sock-fd (pending-socks-rw-requests ps))))
+
+ (define (pending-socks-rd-request! ps sock-fd)
+ (set-pending-socks-rd-requests! ps (cons sock-fd (pending-socks-rd-requests ps))))
+
+ (define (pending-socks-wr-request! ps sock-fd)
+ (set-pending-socks-wr-requests! ps (cons sock-fd (pending-socks-wr-requests ps))))
+
+ (define (pending-socks-rw-request! ps sock-fd)
+ (set-pending-socks-rw-requests!
+ ps (cons sock-fd (pending-socks-rw-requests ps))))
+
+ #;(define (pending-socks-clean-rd-requests! ps)
+ (set-pending-socks-rd-requests! ps '()))
+
+ #;(define (pending-socks-clean-wr-requests! ps)
+ (set-pending-socks-wr-requests! ps '()))
+
+ #;(define (pending-socks-clean-rw-requests! ps)
+ (set-pending-socks-rw-requests! ps '()))
+
+ (define (%curl-multi-socket-action multi sock-fd events)
+ (let loop ()
+ (let-values (((code still-running)
+ (curl-multi-socket-action multi sock-fd events)))
+ (if (= code CURLM_CALL_MULTI_PERFORM)
+ (loop)
+ (values code still-running)))))
+
(define (write-func buffer size nitems outstream)
(let ((nbytes (* size nitems)))
-;;; (check-pretty-print (list 'enter size nitems nbytes))
(guard (E (else (check-pretty-print E) nbytes))
(fprintf (current-error-port) "Google's Home page:\n~a\n"
(utf8->string (cstring->bytevector buffer nbytes))))
-;;; (check-pretty-print (list 'leave size nitems nbytes))
nbytes))
- (check ;no redirection
- (let ((multi (curl-multi-init))
- (easy (curl-easy-init))
- (write-cb (make-curl-write-callback write-func))
- (debug-cb (make-curl-debug-callback debug-func)))
+ (define (socket-func easy sock-fd poll-type callback-data sock-fd-data)
+ (define ps
+ (retrieve-to-avoid-collecting callback-data))
+ (case-integers poll-type
+ ((CURL_POLL_NONE)
+ (void))
+ ((CURL_POLL_IN)
+;;; (check-pretty-print (list 'poll-in sock-fd))
+ (pending-socks-rd-request! ps sock-fd))
+ ((CURL_POLL_OUT)
+;;; (check-pretty-print (list 'poll-out sock-fd))
+ (pending-socks-wr-request! ps sock-fd))
+ ((CURL_POLL_INOUT)
+;;; (check-pretty-print (list 'poll-inout sock-fd))
+ (pending-socks-rw-request! ps sock-fd))
+ ((CURL_POLL_REMOVE)
+;;; (check-pretty-print (list 'poll-remove sock-fd))
+ (pending-socks-remove! ps sock-fd))))
+
+ (define (timer-func multi milliseconds timeout-pointer)
+ (replace-to-avoid-collecting timeout-pointer milliseconds)
+ 0)
+
+ (module (%select)
+ (define (%select rd-requests wr-requests rw-requests milliseconds)
+ ;;Perform a SELECT call for the requested sockets; use the given
+ ;;milliseconds as timeout. Return two values: null or a list of
+ ;;socket descriptors ready for reading; null or a list of socket
+ ;;descriptors ready for writing.
+ ;;
+ (let ((fdsets (px.make-fd-set-bytevector 3)))
+ (%set-requests rd-requests fdsets 0)
+ (%set-requests wr-requests fdsets 1)
+ (%set-requests rw-requests fdsets 0)
+ (%set-requests rw-requests fdsets 1)
+ (cond ((let-values (((secs nsecs)
+ (div-and-mod milliseconds 1000)))
+ (px.select-from-sets-array FD_SETSIZE fdsets secs nsecs))
+ => (lambda (fdsets)
+ (values (%filter-ready (append rd-requests rw-requests)
+ fdsets 0)
+ (%filter-ready (append wr-requests rw-requests)
+ fdsets 1))))
+ (else ;expired timeout
+ (values '() '())))))
+
+ (define (%filter-ready requests fdsets idx)
+ ;;Filter from REQUESTS the socket descriptors which are ready in
+ ;;FDSETS at fd_set index IDX; return the list of ready sockets.
+ ;;
+ (let loop ((ready '())
+ (requests requests))
+ (if (null? requests)
+ ready
+ (let ((sock-fd (car requests)))
+ (if (px.FD_ISSET sock-fd fdsets idx)
+ (loop (cons sock-fd ready) (cdr requests))
+ (loop ready (cdr requests)))))))
+
+ (define (%set-requests requests fdsets idx)
+ ;;Set the socket descriptors from REQUESTS in FDSETS and fd_set
+ ;;index IDX; return unspecified values.
+ ;;
+ (for-each (lambda (sock-fd)
+ (px.FD_SET sock-fd fdsets idx))
+ requests))
+
+ #| end of module |# )
+
+;;; --------------------------------------------------------------------
+
+ (check ;socket action, no redirection
+ (let* ((multi (curl-multi-init))
+ (easy (curl-easy-init))
+ (write-cb (make-curl-write-callback write-func))
+ (socket-cb (make-curl-socket-callback socket-func))
+ (timer-cb (make-curl-multi-timer-callback timer-func))
+ (timeout-pointer (register-to-avoid-collecting -1))
+ (pending-socks (%make-pending-socks))
+ (pending-socks-pointer (register-to-avoid-collecting pending-socks)))
(unwind-protect
(begin
(curl-easy-setopt easy CURLOPT_URL "http://google.com/")
(curl-easy-setopt easy CURLOPT_WRITEFUNCTION write-cb)
(curl-easy-setopt easy CURLOPT_WRITEDATA #f)
- #;(curl-easy-setopt easy CURLOPT_VERBOSE #t)
- #;(curl-easy-setopt easy CURLOPT_DEBUGFUNCTION debug-cb)
- #;(curl-easy-setopt easy CURLOPT_DEBUGDATA #f)
+ (curl-multi-setopt multi CURLMOPT_TIMERFUNCTION timer-cb)
+ (curl-multi-setopt multi CURLMOPT_TIMERDATA timeout-pointer)
+ (curl-multi-setopt multi CURLMOPT_SOCKETFUNCTION socket-cb)
+ (curl-multi-setopt multi CURLMOPT_SOCKETDATA pending-socks-pointer)
(curl-multi-add-handle multi easy)
- (let loop ((running 0))
- (let-values (((code running) (curl-multi-perform multi)))
- (when (or (= code CURLM_CALL_MULTI_PERFORM)
- (not (zero? running)))
- (loop running))))
+ (let loop ()
+ (let-values (((code still-running)
+ (%curl-multi-socket-action multi CURL_SOCKET_TIMEOUT 0)))
+ (when (and (= code CURLM_OK)
+ (not (zero? still-running)))
+ (let-values
+ (((read-ready write-ready)
+ (%select (pending-socks-rd-requests pending-socks)
+ (pending-socks-wr-requests pending-socks)
+ (pending-socks-rw-requests pending-socks)
+ (retrieve-to-avoid-collecting timeout-pointer))))
+ (for-each
+ (lambda (sock-fd)
+ (%curl-multi-socket-action multi sock-fd CURL_CSELECT_IN))
+ read-ready)
+ (for-each
+ (lambda (sock-fd)
+ (%curl-multi-socket-action multi sock-fd CURL_CSELECT_OUT))
+ write-ready)
+ (loop)))))
(let-values (((msg nmsgs)
(curl-multi-info-read multi)))
(when msg
(%pretty-print (curl-constant-msg->symbol (curl-msg.msg msg)))))
#t)
+ ;;Close handles before releasing the callbacks!!!
(curl-multi-cleanup multi)
- ;;Close the connection before releasing the callbacks!!!
(curl-easy-cleanup easy)
(ffi.free-c-callback write-cb)
- (ffi.free-c-callback debug-cb)))
+ (ffi.free-c-callback timer-cb)
+ (forget-to-avoid-collecting pending-socks-pointer)))
=> #t)
(collect))
Please sign in to comment.
Something went wrong with that request. Please try again.