source: projects/specs/trunk/e/emacs25/0001-Fix-url-https-over-proxy-implement.-Bug-11788.patch @ 11818

Revision 11818, 8.4 KB checked in by ara_t, 8 years ago (diff)

emacs25: fix https over proxy implement

  • etc/NEWS 

    From 172363d31b3ad5f45da44aa09652d0e0779ef5f2 Mon Sep 17 00:00:00 2001
From: Tao Fang <fangtao0901@gmail.com>
Date: Tue, 22 Mar 2016 22:39:51 +0800
Subject: [PATCH] Fix url https over proxy implement. (Bug#11788)

* lisp/url/url-http.el: Fix url https over proxy implement. (Bug#11788)

* etc/NEWS: Mention this.
---
 etc/NEWS             |   3 ++
 lisp/url/url-http.el | 105 ++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 94 insertions(+), 14 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4414625..7d2cc92 100644
    a b plist will contain a :peer element that has the output of 
    11931193programmatically delete all cookies, or cookies from a specific 
    11941194domain. 
    11951195 
     1196+++ 
     1197*** The URL package now support https over proxy. 
     1198 
    11961199** Tramp 
    11971200 
    11981201+++ 

  • lisp/url/url-http.el 

    diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 33f6d11..4f180ed 100644
    a b request.") 
    197197        ;; `url-open-stream' needs a buffer in which to do things 
    198198        ;; like authentication.  But we use another buffer afterwards. 
    199199        (unwind-protect 
    200             (let ((proc (url-open-stream host buf host port gateway-method))) 
     200            (let ((proc (url-open-stream host buf 
     201                                         (if url-using-proxy 
     202                                             (url-host url-using-proxy) 
     203                                           host) 
     204                                         (if url-using-proxy 
     205                                             (url-port url-using-proxy) 
     206                                           port) 
     207                                         gateway-method))) 
    201208              ;; url-open-stream might return nil. 
    202209              (when (processp proc) 
    203210                ;; Drop the temp buffer link before killing the buffer. 
    … … should be shown to the user." 
    925932               (erase-buffer) 
    926933               (let ((url-request-method url-http-method) 
    927934                     (url-request-extra-headers url-http-extra-headers) 
    928                      (url-request-data url-http-data)) 
     935                     (url-request-data url-http-data) 
     936                     (url-using-proxy (url-find-proxy-for-url 
     937                                       url-current-object 
     938                                       (url-host url-current-object)))) 
     939                 (when url-using-proxy 
     940                   (setq url-using-proxy 
     941                         (url-generic-parse-url url-using-proxy))) 
    929942                 (url-http url-current-object url-callback-function 
    930943                           url-callback-arguments (current-buffer))))) 
    931944            ((url-http-parse-headers) 
    … … The return value of this function is the retrieval buffer." 
    12091222         (nsm-noninteractive (or url-request-noninteractive 
    12101223                                 (and (boundp 'url-http-noninteractive) 
    12111224                                      url-http-noninteractive))) 
    1212          (connection (url-http-find-free-connection host port gateway-method)) 
     1225         (connection (url-http-find-free-connection (url-host url) 
     1226                                                    (url-port url) 
     1227                                                    gateway-method)) 
    12131228         (mime-accept-string url-mime-accept-string) 
    12141229         (buffer (or retry-buffer 
    12151230                     (generate-new-buffer 
    1216                       (format " *http %s:%d*" host port))))) 
     1231                      (format " *http %s:%d*" (url-host url) (url-port url)))))) 
    12171232    (if (not connection) 
    12181233        ;; Failed to open the connection for some reason 
    12191234        (progn 
    12201235          (kill-buffer buffer) 
    12211236          (setq buffer nil) 
    1222           (error "Could not create connection to %s:%d" host port)) 
     1237          (error "Could not create connection to %s:%d" (url-host url) 
     1238                 (url-port url))) 
    12231239      (with-current-buffer buffer 
    12241240        (mm-disable-multibyte) 
    12251241        (setq url-current-object url 
    … … The return value of this function is the retrieval buffer." 
    12751291           (set-process-sentinel connection 'url-http-async-sentinel)) 
    12761292          (`failed 
    12771293           ;; Asynchronous connection failed 
    1278            (error "Could not create connection to %s:%d" host port)) 
     1294           (error "Could not create connection to %s:%d" (url-host url) 
     1295                  (url-port url))) 
    12791296          (_ 
    1280            (set-process-sentinel connection 
    1281                                  'url-http-end-of-document-sentinel) 
    1282            (process-send-string connection (url-http-create-request)))))) 
     1297           (if (and url-http-proxy (string= "https" 
     1298                                            (url-type url-current-object))) 
     1299               (url-https-proxy-connect connection) 
     1300             (set-process-sentinel connection 
     1301                                   'url-http-end-of-document-sentinel) 
     1302             (process-send-string connection (url-http-create-request))))))) 
    12831303    buffer)) 
    12841304 
     1305(defun url-https-proxy-connect (connection) 
     1306  (setq url-http-after-change-function 'url-https-proxy-after-change-function) 
     1307  (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" 
     1308                                                  "Host: %s\r\n" 
     1309                                                  "\r\n") 
     1310                                          (url-host url-current-object) 
     1311                                          (or (url-port url-current-object) 
     1312                                              url-https-default-port) 
     1313                                          (url-host url-current-object)))) 
     1314 
     1315(defun url-https-proxy-after-change-function (st nd length) 
     1316  (let* ((process-buffer (current-buffer)) 
     1317         (proc (get-buffer-process process-buffer))) 
     1318    (goto-char (point-min)) 
     1319    (when (re-search-forward "^\r?\n" nil t) 
     1320      (backward-char 1) 
     1321      ;; Saw the end of the headers 
     1322      (setq url-http-end-of-headers (set-marker (make-marker) (point))) 
     1323      (url-http-parse-response) 
     1324      (cond 
     1325       ((null url-http-response-status) 
     1326        ;; We got back a headerless malformed response from the 
     1327        ;; server. 
     1328        (url-http-activate-callback) 
     1329        (error "Malformed response from proxy, fail!")) 
     1330       ((= url-http-response-status 200) 
     1331        (if (gnutls-available-p) 
     1332            (condition-case e 
     1333                (let ((tls-connection (gnutls-negotiate 
     1334                                       :process proc 
     1335                                       :hostname (url-host url-current-object) 
     1336                                       :verify-error nil))) 
     1337                  ;; check certificate validity 
     1338                  (setq tls-connection 
     1339                        (nsm-verify-connection tls-connection 
     1340                                               (url-host url-current-object) 
     1341                                               (url-port url-current-object))) 
     1342                  (with-current-buffer process-buffer (erase-buffer)) 
     1343                  (set-process-buffer tls-connection process-buffer) 
     1344                  (setq url-http-after-change-function 
     1345                        'url-http-wait-for-headers-change-function) 
     1346                  (set-process-filter tls-connection 'url-http-generic-filter) 
     1347                  (process-send-string tls-connection 
     1348                                       (url-http-create-request))) 
     1349              (gnutls-error 
     1350               (url-http-activate-callback) 
     1351               (error "gnutls-error: %s" e)) 
     1352              (error 
     1353               (url-http-activate-callback) 
     1354               (error "error: %s" e))) 
     1355          (error "error: gnutls support needed!"))) 
     1356       (t 
     1357        (url-http-activate-callback) 
     1358        (message "error response: %d" url-http-response-status)))))) 
     1359 
    12851360(defun url-http-async-sentinel (proc why) 
    12861361  ;; We are performing an asynchronous connection, and a status change 
    12871362  ;; has occurred. 
    … … The return value of this function is the retrieval buffer." 
    12931368        (url-http-end-of-document-sentinel proc why)) 
    12941369       ((string= (substring why 0 4) "open") 
    12951370        (setq url-http-connection-opened t) 
    1296         (condition-case error 
    1297             (process-send-string proc (url-http-create-request)) 
    1298           (file-error 
    1299            (setq url-http-connection-opened nil) 
    1300            (message "HTTP error: %s" error)))) 
     1371        (if (and url-http-proxy (string= "https" (url-type url-current-object))) 
     1372            (url-https-proxy-connect proc) 
     1373          (condition-case error 
     1374              (process-send-string proc (url-http-create-request)) 
     1375            (file-error 
     1376             (setq url-http-connection-opened nil) 
     1377             (message "HTTP error: %s" error))))) 
    13011378       (t 
    13021379        (setf (car url-callback-arguments) 
    13031380              (nconc (list :error (list 'error 'connection-failed why 
Note: See TracBrowser for help on using the repository browser.