bug#11788: [babc40c4] still fails to implement HTTPS over HTTP proxy properly

[lo2net <fangtao0901@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 507 bytes --]


Hi all,
  I've wrote a patch to fix this, it works fine for me with gnutls
support enabled, so I thought it may be useful.

PS: If without gnutls support, it needs to be modified to use external
program with https via proxy support(e.g. openssl s_client post-May 2015 release version:
http://rt.openssl.org/Ticket/Display.html?id=2651) other than just throw an
error. But I think very few people will need this since this bug report
stayed with outstanding status for such a long time.

Here is the patch:

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-fix-url-https-over-proxy-implement.patch --]
[-- Type: text/x-diff, Size: 8408 bytes --]

From 50ad7c62ac8e34a43b8201702153fd6548d09a10 Mon Sep 17 00:00:00 2001
From: lo2net <fangtao0901@gmail.com>
Date: Fri, 24 Jul 2015 23:19:26 +0800
Subject: [PATCH] fix url https over proxy implement

---
 lisp/url/url-http.el | 106 ++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 92 insertions(+), 14 deletions(-)

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 6a7d8e2..2bcd0cf 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -207,7 +207,7 @@ request.")
 	;; `url-open-stream' needs a buffer in which to do things
 	;; like authentication.  But we use another buffer afterwards.
 	(unwind-protect
-	    (let ((proc (url-open-stream host buf host port gateway-method)))
+	    (let ((proc (url-open-stream host buf (if url-using-proxy (url-host url-using-proxy) host) (if url-using-proxy (url-port url-using-proxy) port) gateway-method)))
 	      ;; url-open-stream might return nil.
 	      (when (processp proc)
 		;; Drop the temp buffer link before killing the buffer.
@@ -912,6 +912,7 @@ should be shown to the user."
 ;; These unfortunately cannot be macros... please ignore them!
 (defun url-http-idle-sentinel (proc why)
   "Remove (now defunct) process PROC from the list of open connections."
+  (url-http-debug "url-http-idle-sentinel(%s %s)" proc why)
   (maphash (lambda (key val)
 		(if (memq proc val)
 		    (puthash key (delq proc val) url-http-open-connections)))
@@ -922,7 +923,7 @@ should be shown to the user."
   ;; and (ii) closed connection due to reusing a HTTP connection which
   ;; we believed was still alive, but which the server closed on us.
   ;; We handle case (ii) by calling `url-http' again.
-  (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
+  (url-http-debug "url-http-end-of-document-sentinel(%s %s) in buffer (%s)" proc why
 		  (process-buffer proc))
   (url-http-idle-sentinel proc why)
   (when (buffer-name (process-buffer proc))
@@ -936,7 +937,11 @@ should be shown to the user."
 	       (erase-buffer)
                (let ((url-request-method url-http-method)
                      (url-request-extra-headers url-http-extra-headers)
-                     (url-request-data url-http-data))
+                     (url-request-data url-http-data)
+                     (url-using-proxy (url-find-proxy-for-url url-current-object (url-host url-current-object)))
+                     )
+                 (when url-using-proxy
+                     (setq url-using-proxy (url-generic-parse-url url-using-proxy)))
                  (url-http url-current-object url-callback-function
                            url-callback-arguments (current-buffer)))))
 	    ((url-http-parse-headers)
@@ -1217,16 +1222,16 @@ overriding the value of `url-gateway-method'."
 	 (nsm-noninteractive (or url-request-noninteractive
 				 (and (boundp 'url-http-noninteractive)
 				      url-http-noninteractive)))
-	 (connection (url-http-find-free-connection host port gateway-method))
+     (connection (url-http-find-free-connection (url-host url) (url-port url) gateway-method))
 	 (buffer (or retry-buffer
 		     (generate-new-buffer
-                      (format " *http %s:%d*" host port)))))
+                      (format " *http %s:%d*" (url-host url) (url-port url))))))
     (if (not connection)
 	;; Failed to open the connection for some reason
 	(progn
 	  (kill-buffer buffer)
 	  (setq buffer nil)
-	  (error "Could not create connection to %s:%d" host port))
+	  (error "Could not create connection to %s:%d" (url-host url) (url-port url)))
       (with-current-buffer buffer
 	(mm-disable-multibyte)
 	(setq url-current-object url
@@ -1274,22 +1279,91 @@ overriding the value of `url-gateway-method'."
 
 	(set-process-buffer connection buffer)
 	(set-process-filter connection 'url-http-generic-filter)
+
+    (url-http-debug "url-http() status: %s" (process-status connection))
+
 	(pcase (process-status connection)
           (`connect
            ;; Asynchronous connection
            (set-process-sentinel connection 'url-http-async-sentinel))
           (`failed
            ;; Asynchronous connection failed
-           (error "Could not create connection to %s:%d" host port))
+           (error "Could not create connection to %s:%d" (url-host url) (url-port url)))
           (_
+           (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+               (url-https-proxy-connect connection)
+
            (set-process-sentinel connection
                                  'url-http-end-of-document-sentinel)
-           (process-send-string connection (url-http-create-request))))))
-    buffer))
+           (process-send-string connection (url-http-create-request))
+             )
+           )
+          )
+    ))
+
+    buffer)
+  )
+(defun url-https-proxy-connect (connection)
+  ;; https proxy
+  (setq url-http-after-change-function 'url-https-proxy-after-change-function)
+  (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
+                                                  "Host: %s\r\n"
+                                                  "\r\n")
+                                          (url-host url-current-object) (or (url-port url-current-object) 443) (url-host url-current-object)))
+  )
+(defun url-https-proxy-after-change-function (st nd length)
+  (let* ((process-buffer (current-buffer))
+         (proc (get-buffer-process process-buffer))
+         )
+    (goto-char (point-min))
+    (when (re-search-forward "^\r?\n" nil t)
+      (backward-char 1)
+      ;; Saw the end of the headers
+      (setq url-http-end-of-headers (set-marker (make-marker) (point)))
+      (url-http-parse-response)
+      (cond
+       ((null url-http-response-status)
+        ;; We got back a headerless malformed response from the
+        ;; server.
+        (url-http-activate-callback)
+        (error "Malformed response from proxy, fail!"))
+       ((= url-http-response-status 200)
+        (if (gnutls-available-p)
+          (condition-case e
+              (let ((tls-connection (gnutls-negotiate
+                                     :process proc
+                                     :hostname (url-host url-current-object)
+                                     :verify-error nil)))
+                (with-current-buffer process-buffer
+                  (erase-buffer))
+                (set-process-buffer tls-connection process-buffer)
+                (setq url-http-after-change-function 'url-http-wait-for-headers-change-function)
+                (set-process-filter tls-connection 'url-http-generic-filter)
+                (process-send-string tls-connection (url-http-create-request))
+                )
+            (gnutls-error
+             (url-http-activate-callback)
+             (error "gnutls-error: %s" e))
+            (error
+             (url-http-activate-callback)
+             (error "error: %s" e))
+            )
+          (error "error: gnutls support needed!")
+          )
+        )
+       (t
+        ;; (setq url-http-connection-opened nil)
+        (url-http-activate-callback)
+        (error "error response: %d\n" url-http-response-status))
+       )
+      )
+    )
+  )
 
 (defun url-http-async-sentinel (proc why)
   ;; We are performing an asynchronous connection, and a status change
   ;; has occurred.
+  (url-http-debug "url-http-async-sentinel(%s %s)" proc why)
   (when (buffer-name (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (cond
@@ -1298,11 +1372,15 @@ overriding the value of `url-gateway-method'."
 	(url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
 	(setq url-http-connection-opened t)
-	(condition-case error
-	    (process-send-string proc (url-http-create-request))
-	  (file-error
-	   (setq url-http-connection-opened nil)
-	   (message "HTTP error: %s" error))))
+        (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+            (url-https-proxy-connect proc)
+          (condition-case error
+              (process-send-string proc (url-http-create-request))
+            (file-error
+             (setq url-http-connection-opened nil)
+             (message "HTTP error: %s" error)))
+          )
+        )
        (t
 	(setf (car url-callback-arguments)
 	      (nconc (list :error (list 'error 'connection-failed why
-- 
2.4.6


[-- Attachment #3: Type: text/plain, Size: 53 bytes --]


If anything goes wrong, please let me know, thanks!