Permalink
Browse files

pushed multi api

  • Loading branch information...
1 parent 1087e3f commit 06c0fc9aa7f0a79caf71dfb6914709a0a4976f56 @marcomaggi committed Sep 24, 2012
Showing with 522 additions and 26 deletions.
  1. +164 −4 doc/vicare-curl.texi
  2. +24 −5 lib/vicare/net/curl.sls
  3. +2 −0 src/vicare-curl-multi.c
  4. +332 −17 tests/demo-multi.sps
View
@@ -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
@@ -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
@@ -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 = \
Oops, something went wrong.

0 comments on commit 06c0fc9

Please sign in to comment.