A long time ago (Dec 2007) there was a patch [1] for drakma to implement
timeouts with sbcl. It was rejected with suggestion to post similar
patch into usocket library.
Totday, I start to learn lisp programing and I need http-request for my
small program. I took drakma for this. But it does not support timeouts on
sbcl. I use debian and it seems sbcl - is the best choice for me.
By googling I found a patch for drakma. I repplaied it for 1.2.3 drakma. It
seems to me, it still forth appling into main line of drakma. I did not
investigate
what happen with usocket patch and such long time shows - this patch needs
to be applied anyway :-)
1. http://common-lisp.net/pipermail/drakma-devel/2007-December/000601.html
--
Alexander Litvinov
commit 734c82f851296f8eb057f519fb78d4c667f99436
Author: Alexander Litvinov <l...@academsoft.ru>
Date: Fri Mar 25 07:58:05 2011 +0600
Support for connection-timeout on SBCL.
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.
URL: http://common-lisp.net/pipermail/drakma-devel/2007-December/000601.html
Author: Stanislaw Halik <sthalik at tehran.lain.pl>
diff --git a/request.lisp b/request.lisp
index 2715c26..5575bb8 100644
--- a/request.lisp
+++ b/request.lisp
@@ -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
@@ -200,8 +231,9 @@ headers of the chunked stream \(if any) as a second value."
force-binary
want-stream
stream
- #+:lispworks (connection-timeout 20)
+ #+(or :lispworks :sbcl) (connection-timeout 20)
#+:lispworks (read-timeout 20)
+ #+:sbcl (io-timeout 20)
#+(and :lispworks (not :lw-does-not-have-write-timeout))
(write-timeout 20 write-timeout-provided-p)
#+:openmcl
@@ -459,7 +491,10 @@ only available on CCL 1.2 and later."
#-:lw-does-not-have-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
_______________________________________________
drakma-devel mailing list
drakma-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
