2008/5/19 Edi Weitz <[EMAIL PROTECTED]>:
> On Mon, 19 May 2008 15:57:21 +0100, "Dave Lambert" <[EMAIL PROTECTED]> wrote:
>
>> I need to contact HTTPS servers through a proxy. I've managed to
>> get this to work by having the http-request function issue an HTTP
>> CONNECT commmand in order to tunnel SSL through the proxy: the patch
>> is below (against 0.11.5). On the downside, it only works for
>> Lispworks.
> Drakma's (limited) proxy functionality didn't work for you?
Drakma's HTTP proxy support is just great, but I also need to create an
HTTPS connection from behind a firewall. This patch adds just that
HTTPS functionality.
There was a previous request for this on the mailing list:
http://common-lisp.net/pipermail/drakma-devel/2007-November/000212.html
> Is this based on some standard or does it cater to one specific
> server?
The approach is standard: Use the HTTP CONNECT method to get a tunnel
through the proxy, and then send SSL on the same connection. It's
covered in HTTP 1.1:
http://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.9
I've tested it on my local proxy, and a couple of HTTPS end points.
> Whatever email app you used ruined the patch. Can you send it as an
> attachment or with another program?
That's a shame (it's Gmail). Patch attached this time.
Cheers,
Dave
diff --git a/request.lisp b/request.lisp
index f56a113..eb779d5 100755
--- a/request.lisp
+++ b/request.lisp
@@ -416,7 +416,8 @@ LispWorks 5.0 or higher."
(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 (eq :https (puri:uri-scheme uri))))
+ http-stream raw-http-stream must-close done)
(unwind-protect
(progn
(let ((host (or (and proxy (first proxy))
@@ -424,8 +425,8 @@ LispWorks 5.0 or higher."
(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
@@ -445,6 +446,7 @@ LispWorks 5.0 or higher."
#-:lispworks
(usocket:socket-stream
(usocket:socket-connect host port :element-type 'octet))))
+ (setq raw-http-stream http-stream)
(when (and use-ssl
;; don't attach SSL to existing streams
(not stream))
@@ -473,6 +475,24 @@ LispWorks 5.0 or higher."
(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)))
+ (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)
+ #+:lispworks
+ (comm:attach-ssl raw-http-stream :ssl-side :client))
(when (and (not parameters-used-p)
parameters)
(setf (uri-query uri)
_______________________________________________
drakma-devel mailing list
drakma-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
