On 5/8/10 12:00PM, drakma-devel-requ...@common-lisp.net wrote:
> Date: Fri, 7 May 2010 21:43:17 +0200
> From: Edi Weitz <e...@agharta.de>
> Subject: Re: [drakma-devel] https through a proxy
> To: General interest list for Drakma and Chunga
> <drakma-devel@common-lisp.net>
> Thanks for the patch. I can't really read it because your email
> client broke it, but I think I get the idea. Yes, I didn't integrate
> the old patch and IIRC I didn't do it because it was a LW-only
> solution. Obviously, I don't like the new solution either because it
> uses unexported symbols (and you can't change the underlying stream
> for a reason).
>
> As far as I understand, all this happens while the headers are still
> sent and while chunking isn't really needed. I haven't really thought
> about the details, but maybe it would be possible to change the order
> of how and when the streams are wrapped and use only exported
> functionality. In the worst case, one could "unwrap" the stream,
> attach SSL, and then "rewrap" it. Of course, the easiest solution
> would be if CL+SSL and AllegroCL had something similar to LispWorks'
> comm:attach-ssl.
>
> Anyway, if someone wants to work on a "clean" solution to this
> problem, I'll happily review it.
I cleaned up my patch. It now contains no double-colons. It ends up
wrapping with the flexi-stream and chunking-stream twice in the https
through a proxy case, as not wrapping didn't work (it may work to wrap
the proxy communication with only a flexi-stream, but I didn't try
that). I also fixed a bug that caused it to include on the first (GET)
line to the server the entire URI instead of only the path part of it
when a request through a proxy with keep-alive gets redirected. Patch
attached.
-Bill
diff -rN -u old-drakma/request.lisp new-drakma/request.lisp
--- old-drakma/request.lisp 2010-05-08 16:30:34.000000000 -0400
+++ new-drakma/request.lisp 2010-05-08 16:30:34.000000000 -0400
@@ -426,7 +426,8 @@
(t
(setq content (alist-to-url-encoded-string parameters
external-format-out)
content-type "application/x-www-form-urlencoded")))))
- (let (http-stream must-close done)
+ (let ((proxying-https? (and proxy (not stream) (eq :https (puri:uri-scheme
uri))))
+ http-stream raw-http-stream must-close done)
(unwind-protect
(progn
(let ((host (or (and proxy (first proxy))
@@ -434,8 +435,9 @@
(port (cond (proxy (second proxy))
((uri-port uri))
(t (default-port uri))))
- (use-ssl (or force-ssl
- (eq (uri-scheme uri) :https))))
+ (use-ssl (and (not proxying-https?)
+ (or force-ssl
+ (eq (uri-scheme uri) :https)))))
#+(and :lispworks5.0 :mswindows
(not :lw-does-not-have-write-timeout))
(when use-ssl
@@ -459,7 +461,8 @@
:element-type
'octet
#+:openmcl
:deadline
#+:openmcl
deadline
- :nodelay t))))
+ :nodelay t)))
+ raw-http-stream http-stream)
#+:openmcl
(when deadline
;; it is correct to set the deadline here even though
@@ -468,34 +471,55 @@
;; user and the user may want to adjust the deadline
;; for every request.
(setf (ccl:stream-deadline http-stream) deadline))
- (when (and use-ssl
- ;; don't attach SSL to existing streams
- (not stream))
- #+:lispworks
- (comm:attach-ssl http-stream :ssl-side :client)
- #-:lispworks
- (setq http-stream
- #+:allegro
- (socket:make-ssl-client-stream http-stream)
- #-:allegro
- (let ((s http-stream))
- (cl+ssl:make-ssl-client-stream
- (cl+ssl:stream-fd s)
- :close-callback (lambda () (close s)))))))
- (cond (stream
- (setf (flexi-stream-element-type http-stream)
- #+:lispworks 'lw:simple-char #-:lispworks 'character
- (flexi-stream-external-format http-stream) +latin-1+))
- (t
- (setq http-stream
- (make-flexi-stream (make-chunked-stream http-stream)
- :external-format +latin-1+))))
(labels ((write-http-line (fmt &rest args)
(when *header-stream*
(format *header-stream* "~?~%" fmt args))
(format http-stream "~?~C~C" fmt args #\Return
#\Linefeed))
(write-header (name value-fmt &rest value-args)
- (write-http-line "~A: ~?" name value-fmt value-args)))
+ (write-http-line "~A: ~?" name value-fmt value-args))
+ (make-ssl-stream (http-stream)
+ #+:lispworks
+ (progn
+ (comm:attach-ssl http-stream :ssl-side :client)
+ http-stream)
+ #-:lispworks
+ #+:allegro
+ (socket:make-ssl-client-stream http-stream)
+ #-:allegro
+ (let ((s http-stream))
+ (cl+ssl:make-ssl-client-stream
+ (cl+ssl:stream-fd s)
+ :close-callback (lambda () (close s)))))
+ (wrap-stream (http-stream)
+ (make-flexi-stream (make-chunked-stream http-stream)
+ :external-format +latin-1+)))
+ (when (and use-ssl
+ ;; don't attach SSL to existing streams
+ (not stream))
+ (setq http-stream (make-ssl-stream http-stream)))
+ (cond (stream
+ (setf (flexi-stream-element-type http-stream)
+ #+:lispworks 'lw:simple-char #-:lispworks 'character
+ (flexi-stream-external-format http-stream)
+latin-1+))
+ (t
+ (setq http-stream (wrap-stream http-stream))))
+ (when proxying-https?
+ ;; Setup a tunnel through the proxy server to the
+ ;; final destination.
+ (write-http-line "CONNECT ~A:~A HTTP/1.1" (puri:uri-host uri)
+ (or (puri:uri-port uri) 443))
+ (write-http-line "Host: ~A:~A" (puri:uri-host uri)
+ (or (puri:uri-port uri) 443))
+ (write-http-line "")
+ (force-output http-stream)
+ ;; Check we get a 200 response before proceeding.
+ (let ((line (read-status-line http-stream *header-stream*)))
+ (unless (eq (second line) 200)
+ (error "Unable to establish HTTPS tunnel through proxy.")))
+ ;; Got a connection. We have to read a blank line,
+ ;; turn on SSL, and then we can transmit.
+ (read-line* http-stream)
+ (setq http-stream (wrap-stream (make-ssl-stream
raw-http-stream))))
(when (and (not parameters-used-p)
parameters)
(setf (uri-query uri)
@@ -510,7 +534,7 @@
(uri-query uri) nil))
(write-http-line "~A ~A ~A"
(string-upcase method)
- (cond (proxy (render-uri uri nil))
+ (cond ((and proxy (not stream) (not
proxying-https?)) (render-uri uri nil))
(t (format nil "~...@[?~a~]"
(or (uri-path uri) "/")
(uri-query uri))))
@@ -695,7 +719,7 @@
status-text))))))
(when (eq content :continuation)
(return-from http-request #'finish-request))
- (finish-request content))))
+ (finish-request content)))))
;; the cleanup form of the UNWIND-PROTECT above
(when (and http-stream
(or (not done)
_______________________________________________
drakma-devel mailing list
drakma-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
