I've updated the patch to support the IO-TIMEOUT keyword argument. It's
not possible to non-intrusively support read- and write-timeouts
separately to bring the API in congruency with LispWorks.
The resolver error gets changed to SIMPLE-ERROR because it's not an
ERROR, but a CONDITION (signalled with ERROR, though).
I've stress-tested the patch, running 30 threads doing HTTP-REQUEST.
My rationale for including the patch - it doesn't change the program
logic much, and except for the function definition and socket connection
there's no special-casing for SBCL.
The timeout option is crucial for me: my typical usage is running
concurrent threads accessing URLs posted in spam to make the senders
think I'm a used accessing the page, in turn sending more spam,
addresses of which land in my spamtrap. Some of the URLs point to broken
httpds, leaving an open connection without sending any replies. This
leads to unfinished requests using threads and hanging for days.
If you feel like maintaing a piece of code for SBCL, by all means please
do so. I think other SBCL users might benefit from it.
--
/\
/ Jabber ID :: [EMAIL PROTECTED]
\ \/ Unix stuff :: http://tehran.lain.pl
\/\ Yet Another RBL :: http://rbl.lain.pl
diff -ur drakma-0.11.1-old/request.lisp drakma-0.11.1-new/request.lisp
--- drakma-0.11.1-old/request.lisp 2007-10-11 10:45:47.000000000 +0200
+++ drakma-0.11.1-new/request.lisp 2007-12-23 04:49:33.000000000 +0100
@@ -29,6 +29,37 @@
(in-package :drakma)
+#+sbcl
+(require '#:sb-bsd-sockets)
+#+:sbcl
+(defun sbcl-connect-with-timeout (host port connection-timeout io-timeout &key (element-type 'character))
+ (let* ((sock (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
+ (octet-addr
+ (handler-case
+ (sb-bsd-sockets:host-ent-address (sb-bsd-sockets:get-host-by-name host))
+ (sb-bsd-sockets:host-not-found-error (e)
+ (error "Can't resolve ~a: ~a" host e))))
+ (fd (sb-bsd-sockets:socket-file-descriptor sock)))
+ (setf (sb-bsd-sockets:non-blocking-mode sock) t)
+ (handler-case
+ (sb-bsd-sockets:socket-connect sock octet-addr port)
+ (sb-bsd-sockets:socket-error (c)
+ (unless (= (sb-bsd-sockets::socket-error-errno c) sb-posix:einprogress)
+ (error c))))
+ (setf (sb-bsd-sockets:non-blocking-mode sock) nil)
+ (loop
+ (if (sb-sys:wait-until-fd-usable fd :output connection-timeout)
+ (return)
+ (unless (= sb-posix::eintr (sb-alien:get-errno))
+ (sb-bsd-sockets:socket-error "open"))))
+ (sb-bsd-sockets::socket-make-stream
+ sock
+ :input t
+ :output t
+ :timeout io-timeout
+ :buffering :full
+ :element-type element-type)))
+
(defun determine-body-format (headers external-format-in)
"The default function used by Drakma to determine how the content
body is to be read. See the docstring of *BODY-FORMAT-FUNCTION* for
@@ -193,9 +224,10 @@
force-binary
want-stream
stream
- #+:lispworks (connection-timeout 20)
+ #+(or :lispworks :sbcl) (connection-timeout 20)
#+:lispworks (read-timeout 20)
- #+:lispworks5.0 (write-timeout 20))
+ #+:lispworks5.0 (write-timeout 20)
+ #+:sbcl (io-timeout 20))
"Sends an HTTP request to a web server and returns its reply. URI
is where the request is sent to, and it is either a string denoting a
uniform resource identifier or a PURI:URI object. The scheme of URI
@@ -427,7 +459,10 @@
#+:lispworks5.0 #+:lispworks5.0
:write-timeout write-timeout
:errorp t)
- #-:lispworks
+ #+:sbcl
+ (sbcl-connect-with-timeout host port connection-timeout io-timeout
+ :element-type '(unsigned-byte 8))
+ #-(or :lispworks sbcl)
(usocket:socket-stream
(usocket:socket-connect host port
:element-type 'octet)))))
Only in drakma-0.11.1-new: request.lisp.orig
_______________________________________________
drakma-devel mailing list
drakma-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
