[drakma-devel] https through a proxy

[Bill St. Clair]

I have an application where I need to do https requests through a proxy
server. It hangs in Drakma 1.1.0. I found the fix, for Lispworks only,
at
http://www.mail-archive.com/drakma-devel@common-lisp.net/msg00200.html .
I guess Edi didn't integrate it yet. I made it work in CCL 1.5, meaning
it will probably work everywhere, but I did't test Allegro. My fix is a
little ugly, as I'm setting a slot with no writer inside of the chunga
stream, but it works for me. Patch below.

-Bill St. Clair
wws at clozure.com

====

diff -rN old-drakma/request.lisp new-drakma/request.lisp
429c429,430
<     (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)
437,438c438,440
<                   (use-ssl (or force-ssl
<                                (eq (uri-scheme uri) :https))))
---
>                    (use-ssl (and (not proxying-https?)
>                                  (or force-ssl
>                                      (eq (uri-scheme uri) :https)))))
470a473
>               (setq raw-http-stream http-stream)
498a502,528
>               (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)
>                 #-lispworks
>                 (setf (slot-value (flexi-stream-stream http-stream)
'chunga::real-stream) ;evil
>                       #+:allegro
>                       (socket:make-ssl-client-stream raw-http-stream)
>                       #-:allegro
>                       (let ((s raw-http-stream))
>                         (cl+ssl:make-ssl-client-stream
>                          (cl+ssl:stream-fd s)
>                          :close-callback (lambda () (close s))))))
513c543
<                                (cond (proxy (render-uri uri nil))
---
>                                (cond ((and proxy (not
proxying-https?)) (render-uri uri nil))