drakma-devel

Download

drakma-devel@common-lisp.net

September 2009

2 participants
2 discussions

[drakma-devel] [patch] timeouts, take two
by Stanislaw Halik 19 Oct '09

19 Oct '09

Hey Edi, I made a new patch that uses TRIVIAL-TIMEOUT instead of usocket WAIT-FOR-INPUT. Results are great, it yields no slowdown at all when downloading a 10MB zero-filled file. Patch follows. I can't attach files due to posting to Gmane through tin(1) so it's included in the message body. If it gets mangled in the transmission, it's alternatively available at http://tehran.lain.pl/stuff/20090827-drakma-timeout-gray-stream-take2.diff diff -rN -u old-drakma/drakma.asd new-drakma/drakma.asd --- old-drakma/drakma.asd 2009-08-27 05:59:20.000000000 +0200 +++ new-drakma/drakma.asd 2009-08-27 05:59:20.000000000 +0200 @@ -53,10 +53,13 @@ (:file "util") (:file "read") (:file "cookies") + #-lispworks (:file "timeouts") (:file "request")) :depends-on (:puri :cl-base64 :chunga :flexi-streams + #-lispworks #:trivial-timeout + #-lispworks #:trivial-gray-streams #-:lispworks :usocket #-(or :lispworks :allegro) :cl+ssl)) diff -rN -u old-drakma/request.lisp new-drakma/request.lisp --- old-drakma/request.lisp 2009-08-27 05:59:20.000000000 +0200 +++ new-drakma/request.lisp 2009-08-27 05:59:20.000000000 +0200 @@ -200,9 +200,11 @@ force-binary want-stream stream - #+:lispworks (connection-timeout 20) - #+:lispworks (read-timeout 20) - #+(and :lispworks (not :lw-does-not-have-write-timeout)) + (connection-timeout 20) + (read-timeout 20) + #+(or (not :lispworks) + (and :lispworks + (not :lw-does-not-have-write-timeout))) (write-timeout 20 write-timeout-provided-p) #+openmcl deadline) @@ -385,6 +387,7 @@ time units. If the server fails to respond until that time, a COMMUNICATION-DEADLINE-EXPIRED condition is signalled. DEADLINE is only available on CCL 1.2 and later." + #-lispworks (declare (ignore write-timeout-provided-p)) (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq) (parameter-error "Don't know how to handle protocol ~S." protocol)) (setq uri (cond ((uri-p uri) (copy-uri uri)) @@ -450,12 +453,16 @@ :write-timeout write-timeout :errorp t) #-:lispworks - (usocket:socket-stream - (usocket:socket-connect host port - :element-type 'octet - #+openmcl #+openmcl - :deadline deadline - :nodelay t)))) + (let ((sock (trivial-timeout:with-timeout (connection-timeout) + (usocket:socket-connect host port + :element-type 'octet + #+openmcl #+openmcl + :deadline deadline + :nodelay t)))) + (if (or read-timeout write-timeout) + (usocket-timeout:timeout-stream-for-socket + sock :read-timeout read-timeout :write-timeout write-timeout) + (usocket:socket-stream sock))))) #+openmcl (when deadline ;; it is correct to set the deadline here even though diff -rN -u old-drakma/timeouts.lisp new-drakma/timeouts.lisp --- old-drakma/timeouts.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-drakma/timeouts.lisp 2009-08-27 05:59:20.000000000 +0200 @@ -0,0 +1,62 @@ +(defpackage #:usocket-timeout + (:use #:cl #:usocket #:trivial-timeout #:trivial-gray-streams) + (:shadowing-import-from #:trivial-timeout #:timeout-error) + (:export #:timeout-stream-for-socket)) + +(in-package #:usocket-timeout) + + +(defclass timeout-mixin () + ((socket-of :initarg :socket + :reader socket-of))) + +(defclass timeout-input-stream (trivial-gray-stream-mixin + fundamental-binary-input-stream + timeout-mixin) + ((read-timeout :initform nil + :initarg :read-timeout + :reader read-timeout-of))) + +(defmethod stream-read-sequence ((stream timeout-input-stream) + sequence start end &key) + (with-timeout ((read-timeout-of stream)) + (read-sequence sequence (socket-of stream) :start start :end end))) + +(defmethod stream-read-byte ((stream timeout-input-stream)) + (with-timeout ((read-timeout-of stream)) + (read-byte (socket-of stream)))) + + +(defclass timeout-output-stream (trivial-gray-stream-mixin + fundamental-binary-output-stream + timeout-mixin) + ((write-timeout :initform nil + :initarg :write-timeout + :reader write-timeout-of))) + +(defmethod stream-finish-output ((stream timeout-output-stream)) + (finish-output (socket-of stream))) + +(defmethod stream-write-sequence ((stream timeout-output-stream) + sequence start end &key) + (with-timeout ((write-timeout-of stream)) + (write-sequence sequence (socket-of stream) + :start (or start 0) + :end end))) + +(defmethod stream-write-byte ((stream timeout-output-stream) integer) + (with-timeout ((write-timeout-of stream)) + (write-byte integer (socket-of stream)))) + + +(defclass usocket-timeout-stream (timeout-input-stream timeout-output-stream) + ()) + +(defun timeout-stream-for-socket (socket &key timeout + (read-timeout timeout) + (write-timeout timeout)) + (make-instance 'usocket-timeout-stream + :socket (socket-stream socket) + :read-timeout read-timeout + :write-timeout write-timeout)) +

2 2

[drakma-devel] drakma:get-cookies fails to parse cookies with commas in values
by Andrei Stebakov 07 Oct '09

07 Oct '09

One of the web sites started to give me cookies with commas and drakma:get-cookies just crashes on those requests. I distilled my case into a small example like this: (drakma::get-cookies '((:CONTENT-TYPE . "text/html; charset=utf-8") (:LOCATION . "http://www.test") (:SERVER . "Microsoft-IIS/7.0") (:CONTENT-LENGTH . "46") (:DATE . "Sat, 12 Sep 2009 14:58:04 GMT") (:CONNECTION . "close") (:SET-COOKIE . "domain=test.com; expires=Thu, 12-Sep-2109 14:58:04 GMT; session=6,Direct,placeholder,test.com;") (:CACHE-CONTROL . "private")) (puri:parse-uri "http://www.test.com")) It'll throw an exception trying to parse "session=6,Direct,placeholder, test.com" pair and will complain about the commas. I tried to capture the same page with FF Live Http Headers and it has no problems with that. Do you think we could change drakma to be able to digest it as well? Thank you, Andrei

2 5