[drakma-devel] HTTPS through proxy

[Dave Lambert]

Hi,

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.

Cheers,
Dave


--- 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)