From afc4f5625aa70b75a2b27c98993ac8bf69230dd9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Feb 2016 07:30:38 -0500 Subject: [PATCH] Remove url-http-ntlm-parse-header-NN.MM.el files * packages/url-http-ntlm/url-http-ntlm.el: Add advice around url-http-parse-headers, url-http-handle-authentication and url-retrieve-internal to clear HTTP Authorization header. * packages/url-http-ntlm/url-http-ntlm-parse-headers-24.1.el, packages/url-http-ntlm/url-http-ntlm-parse-headers-24.2.el, packages/url-http-ntlm/url-http-ntlm-parse-headers-24.3.el, packages/url-http-ntlm/url-http-ntlm-parse-headers-24.4.el, packages/url-http-ntlm/url-http-ntlm-parse-headers-24.5.el: Remove files. --- .../url-http-ntlm-parse-headers-24.1.el | 472 ----------------- .../url-http-ntlm-parse-headers-24.2.el | 472 ----------------- .../url-http-ntlm-parse-headers-24.3.el | 473 ----------------- .../url-http-ntlm-parse-headers-24.4.el | 474 ----------------- .../url-http-ntlm-parse-headers-24.5.el | 480 ------------------ packages/url-http-ntlm/url-http-ntlm.el | 22 +- 6 files changed, 19 insertions(+), 2374 deletions(-) delete mode 100644 packages/url-http-ntlm/url-http-ntlm-parse-headers-24.1.el delete mode 100644 packages/url-http-ntlm/url-http-ntlm-parse-headers-24.2.el delete mode 100644 packages/url-http-ntlm/url-http-ntlm-parse-headers-24.3.el delete mode 100644 packages/url-http-ntlm/url-http-ntlm-parse-headers-24.4.el delete mode 100644 packages/url-http-ntlm/url-http-ntlm-parse-headers-24.5.el diff --git a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.1.el b/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.1.el deleted file mode 100644 index 59b0f811b..000000000 --- a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.1.el +++ /dev/null @@ -1,472 +0,0 @@ -;;; url-http-ntlm-parse-headers-24.1.el --- Override url-http-parse-headers - -;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. - -;; Author: Bill Perry -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Override url-http-parse-headers to clear Authorization headers -;; from url-http-extra-headers prior to executing a redirect. The -;; only change is to apply this backward-compatible patch: -;; -;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el -;; index a472648..46a019c 100644 -;; --- a/lisp/url/url-http.el -;; +++ b/lisp/url/url-http.el -;; @@ -619,6 +619,15 @@ should be shown to the user." -;; ;; compute the redirection relative to the URL of the proxy. -;; (setq redirect-uri -;; (url-expand-file-name redirect-uri url-http-target-url))) -;; + ;; Do not automatically include an authorization header in the -;; + ;; redirect. If needed it will be regenerated by the relevant -;; + ;; auth scheme when the new request happens. -;; + (setq url-http-extra-headers -;; + (let (result) -;; + (dolist (header url-http-extra-headers) -;; + (if (not (equal (car header) "Authorization")) -;; + (push header result))) -;; + (nreverse result))) -;; (let ((url-request-method url-http-method) -;; (url-request-data url-http-data) -;; (url-request-extra-headers url-http-extra-headers)) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'url-gw) -(require 'url-parse) -(require 'url-cookie) -(require 'mail-parse) -(require 'url-auth) -(require 'url) -(autoload 'url-cache-create-filename "url-cache") -(require 'url-http) - -(defvar url-http-target-url) -(defvar url-http-extra-headers) - -(defun url-http-parse-headers () - "Parse and handle HTTP specific headers. -Return t if and only if the current buffer is still active and -should be shown to the user." - ;; The comments after each status code handled are taken from RFC - ;; 2616 (HTTP/1.1) - (declare (special url-http-end-of-headers url-http-response-status - url-http-response-version - url-http-method url-http-data url-http-process - url-callback-function url-callback-arguments)) - - (url-http-mark-connection-as-free (url-host url-current-object) - (url-port url-current-object) - url-http-process) - - (if (or (not (boundp 'url-http-end-of-headers)) - (not url-http-end-of-headers)) - (error "Trying to parse headers in odd buffer: %s" (buffer-name))) - (goto-char (point-min)) - (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (let ((connection (mail-fetch-field "Connection"))) - ;; In HTTP 1.0, keep the connection only if there is a - ;; "Connection: keep-alive" header. - ;; In HTTP 1.1 (and greater), keep the connection unless there is a - ;; "Connection: close" header - (cond - ((string= url-http-response-version "1.0") - (unless (and connection - (string= (downcase connection) "keep-alive")) - (delete-process url-http-process))) - (t - (when (and connection - (string= (downcase connection) "close")) - (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes))) - ;; The filename part of a URL could be in remote file syntax, - ;; see Bug#6717 for an example. We disable file name - ;; handlers, therefore. - (file-name-handler-alist nil)) - (setq class (/ url-http-response-status 100)) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) - (when (url-use-cookies url-http-target-url) - (url-http-handle-cookies)) - - (case class - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - (1 ; Information messages - ;; 100 = Continue with request - ;; 101 = Switching protocols - ;; 102 = Processing (Added by DAV) - (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status)) - (2 ; Success - ;; 200 Ok - ;; 201 Created - ;; 202 Accepted - ;; 203 Non-authoritative information - ;; 204 No content - ;; 205 Reset content - ;; 206 Partial content - ;; 207 Multi-status (Added by DAV) - (case status-symbol - ((no-content reset-content) - ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) - (otherwise - ;; Generic success for all others. Store in the cache, and - ;; mark it as successful. - (widen) - (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) - (3 ; Redirection - ;; 300 Multiple choices - ;; 301 Moved permanently - ;; 302 Found - ;; 303 See other - ;; 304 Not modified - ;; 305 Use proxy - ;; 307 Temporary redirect - (let ((redirect-uri (or (mail-fetch-field "Location") - (mail-fetch-field "URI")))) - (case status-symbol - (multiple-choices ; 300 - ;; Quoth the spec (section 10.3.1) - ;; ------------------------------- - ;; The requested resource corresponds to any one of a set of - ;; representations, each with its own specific location and - ;; agent-driven negotiation information is being provided so - ;; that the user can select a preferred representation and - ;; redirect its request to that location. - ;; [...] - ;; If the server has a preferred choice of representation, it - ;; SHOULD include the specific URI for that representation in - ;; the Location field; user agents MAY use the Location field - ;; value for automatic redirection. - ;; ------------------------------- - ;; We do not support agent-driven negotiation, so we just - ;; redirect to the preferred URI if one is provided. - nil) - ((moved-permanently found temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (see-other ; 303 - ;; The response to the request can be found under a different - ;; URI and SHOULD be retrieved using a GET method on that - ;; resource. - (setq url-http-method "GET" - url-http-data nil)) - (not-modified ; 304 - ;; The 304 response MUST NOT contain a message-body. - (url-http-debug "Extracting document from cache... (%s)" - (url-cache-create-filename (url-view-url t))) - (url-cache-extract (url-cache-create-filename (url-view-url t))) - (setq redirect-uri nil - success t)) - (use-proxy ; 305 - ;; The requested resource MUST be accessed through the - ;; proxy given by the Location field. The Location field - ;; gives the URI of the proxy. The recipient is expected - ;; to repeat this single request via the proxy. 305 - ;; responses MUST only be generated by origin servers. - (error "Redirection thru a proxy server not supported: %s" - redirect-uri)) - (otherwise - ;; Treat everything like '300' - nil)) - (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. - (if (not (string-match url-nonrelative-link redirect-uri)) - ;; Be careful to use the real target URL, otherwise we may - ;; compute the redirection relative to the URL of the proxy. - (setq redirect-uri - (url-expand-file-name redirect-uri url-http-target-url))) - ;; Do not automatically include an authorization header in the - ;; redirect. If needed it will be regenerated by the relevant - ;; auth scheme when the new request happens. - (setq url-http-extra-headers - (let (result) - (dolist (header url-http-extra-headers) - (if (not (equal (car header) "Authorization")) - (push header result))) - (nreverse result))) - (let ((url-request-method url-http-method) - (url-request-data url-http-data) - (url-request-extra-headers url-http-extra-headers)) - ;; Check existing number of redirects - (if (or (< url-max-redirections 0) - (and (> url-max-redirections 0) - (let ((events (car url-callback-arguments)) - (old-redirects 0)) - (while events - (if (eq (car events) :redirect) - (setq old-redirects (1+ old-redirects))) - (and (setq events (cdr events)) - (setq events (cdr events)))) - (< old-redirects url-max-redirections)))) - ;; url-max-redirections hasn't been reached, so go - ;; ahead and redirect. - (progn - ;; Remember that the request was redirected. - (setf (car url-callback-arguments) - (nconc (list :redirect redirect-uri) - (car url-callback-arguments))) - ;; Put in the current buffer a forwarding pointer to the new - ;; destination buffer. - ;; FIXME: This is a hack to fix url-retrieve-synchronously - ;; without changing the API. Instead url-retrieve should - ;; either simply not return the "destination" buffer, or it - ;; should take an optional `dest-buf' argument. - (set (make-local-variable 'url-redirect-buffer) - (url-retrieve-internal - redirect-uri url-callback-function - url-callback-arguments - (url-silent url-current-object) - (not (url-use-cookies url-current-object)))) - (url-mark-buffer-as-dead buffer)) - ;; We hit url-max-redirections, so issue an error and - ;; stop redirecting. - (url-http-debug "Maximum redirections reached") - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http-redirect-limit - redirect-uri)) - (car url-callback-arguments))) - (setq success t)))))) - (4 ; Client error - ;; 400 Bad Request - ;; 401 Unauthorized - ;; 402 Payment required - ;; 403 Forbidden - ;; 404 Not found - ;; 405 Method not allowed - ;; 406 Not acceptable - ;; 407 Proxy authentication required - ;; 408 Request time-out - ;; 409 Conflict - ;; 410 Gone - ;; 411 Length required - ;; 412 Precondition failed - ;; 413 Request entity too large - ;; 414 Request-URI too large - ;; 415 Unsupported media type - ;; 416 Requested range not satisfiable - ;; 417 Expectation failed - ;; 422 Unprocessable Entity (Added by DAV) - ;; 423 Locked - ;; 424 Failed Dependency - (case status-symbol - (unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (not-found ; 404 - ;; Not found - (setq success t)) - (method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((request-entity-too-large request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (otherwise - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (5 - ;; 500 Internal server error - ;; 501 Not implemented - ;; 502 Bad gateway - ;; 503 Service unavailable - ;; 504 Gateway time-out - ;; 505 HTTP version not supported - ;; 507 Insufficient storage - (setq success t) - (case url-http-response-status - (not-implemented ; 501 - ;; The server does not support the functionality required to - ;; fulfill the request. - nil) - (bad-gateway ; 502 - ;; The server, while acting as a gateway or proxy, received - ;; an invalid response from the upstream server it accessed - ;; in attempting to fulfill the request. - nil) - (service-unavailable ; 503 - ;; The server is currently unable to handle the request due - ;; to a temporary overloading or maintenance of the server. - ;; The implication is that this is a temporary condition - ;; which will be alleviated after some delay. If known, the - ;; length of the delay MAY be indicated in a Retry-After - ;; header. If no Retry-After is given, the client SHOULD - ;; handle the response as it would for a 500 response. - nil) - (gateway-timeout ; 504 - ;; The server, while acting as a gateway or proxy, did not - ;; receive a timely response from the upstream server - ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other - ;; auxiliary server (e.g. DNS) it needed to access in - ;; attempting to complete the request. - nil) - (http-version-not-supported ; 505 - ;; The server does not support, or refuses to support, the - ;; HTTP protocol version that was used in the request - ;; message. - nil) - (insufficient-storage ; 507 (DAV) - ;; The method could not be performed on the resource - ;; because the server is unable to store the representation - ;; needed to successfully complete the request. This - ;; condition is considered to be temporary. If the request - ;; which received this status code was the result of a user - ;; action, the request MUST NOT be repeated until it is - ;; requested by a separate user action. - nil)) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (otherwise - (error "Unknown class of HTTP response code: %d (%d)" - class url-http-response-status))) - (if (not success) - (url-mark-buffer-as-dead buffer)) - (url-http-debug "Finished parsing HTTP headers: %S" success) - (widen) - success)) - -(provide 'url-http-ntlm-parse-headers-24.1) - -;;; url-http-ntlm-parse-headers-24.1.el ends here diff --git a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.2.el b/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.2.el deleted file mode 100644 index 6547cff74..000000000 --- a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.2.el +++ /dev/null @@ -1,472 +0,0 @@ -;;; url-http-ntlm-parse-headers-24.2.el --- Override url-http-parse-headers - -;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. - -;; Author: Bill Perry -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Override url-http-parse-headers to clear Authorization headers -;; from url-http-extra-headers prior to executing a redirect. The -;; only change is to apply this backward-compatible patch: -;; -;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el -;; index 2bae194..110d339 100644 -;; --- a/lisp/url/url-http.el -;; +++ b/lisp/url/url-http.el -;; @@ -619,6 +619,15 @@ should be shown to the user." -;; ;; compute the redirection relative to the URL of the proxy. -;; (setq redirect-uri -;; (url-expand-file-name redirect-uri url-http-target-url))) -;; + ;; Do not automatically include an authorization header in the -;; + ;; redirect. If needed it will be regenerated by the relevant -;; + ;; auth scheme when the new request happens. -;; + (setq url-http-extra-headers -;; + (let (result) -;; + (dolist (header url-http-extra-headers) -;; + (if (not (equal (car header) "Authorization")) -;; + (push header result))) -;; + (nreverse result))) -;; (let ((url-request-method url-http-method) -;; (url-request-data url-http-data) -;; (url-request-extra-headers url-http-extra-headers)) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'url-gw) -(require 'url-parse) -(require 'url-cookie) -(require 'mail-parse) -(require 'url-auth) -(require 'url) -(autoload 'url-cache-create-filename "url-cache") -(require 'url-http) - -(defvar url-http-target-url) -(defvar url-http-extra-headers) - -(defun url-http-parse-headers () - "Parse and handle HTTP specific headers. -Return t if and only if the current buffer is still active and -should be shown to the user." - ;; The comments after each status code handled are taken from RFC - ;; 2616 (HTTP/1.1) - (declare (special url-http-end-of-headers url-http-response-status - url-http-response-version - url-http-method url-http-data url-http-process - url-callback-function url-callback-arguments)) - - (url-http-mark-connection-as-free (url-host url-current-object) - (url-port url-current-object) - url-http-process) - - (if (or (not (boundp 'url-http-end-of-headers)) - (not url-http-end-of-headers)) - (error "Trying to parse headers in odd buffer: %s" (buffer-name))) - (goto-char (point-min)) - (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (let ((connection (mail-fetch-field "Connection"))) - ;; In HTTP 1.0, keep the connection only if there is a - ;; "Connection: keep-alive" header. - ;; In HTTP 1.1 (and greater), keep the connection unless there is a - ;; "Connection: close" header - (cond - ((string= url-http-response-version "1.0") - (unless (and connection - (string= (downcase connection) "keep-alive")) - (delete-process url-http-process))) - (t - (when (and connection - (string= (downcase connection) "close")) - (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes))) - ;; The filename part of a URL could be in remote file syntax, - ;; see Bug#6717 for an example. We disable file name - ;; handlers, therefore. - (file-name-handler-alist nil)) - (setq class (/ url-http-response-status 100)) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) - (when (url-use-cookies url-http-target-url) - (url-http-handle-cookies)) - - (case class - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - (1 ; Information messages - ;; 100 = Continue with request - ;; 101 = Switching protocols - ;; 102 = Processing (Added by DAV) - (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status)) - (2 ; Success - ;; 200 Ok - ;; 201 Created - ;; 202 Accepted - ;; 203 Non-authoritative information - ;; 204 No content - ;; 205 Reset content - ;; 206 Partial content - ;; 207 Multi-status (Added by DAV) - (case status-symbol - ((no-content reset-content) - ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) - (otherwise - ;; Generic success for all others. Store in the cache, and - ;; mark it as successful. - (widen) - (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) - (3 ; Redirection - ;; 300 Multiple choices - ;; 301 Moved permanently - ;; 302 Found - ;; 303 See other - ;; 304 Not modified - ;; 305 Use proxy - ;; 307 Temporary redirect - (let ((redirect-uri (or (mail-fetch-field "Location") - (mail-fetch-field "URI")))) - (case status-symbol - (multiple-choices ; 300 - ;; Quoth the spec (section 10.3.1) - ;; ------------------------------- - ;; The requested resource corresponds to any one of a set of - ;; representations, each with its own specific location and - ;; agent-driven negotiation information is being provided so - ;; that the user can select a preferred representation and - ;; redirect its request to that location. - ;; [...] - ;; If the server has a preferred choice of representation, it - ;; SHOULD include the specific URI for that representation in - ;; the Location field; user agents MAY use the Location field - ;; value for automatic redirection. - ;; ------------------------------- - ;; We do not support agent-driven negotiation, so we just - ;; redirect to the preferred URI if one is provided. - nil) - ((moved-permanently found temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (see-other ; 303 - ;; The response to the request can be found under a different - ;; URI and SHOULD be retrieved using a GET method on that - ;; resource. - (setq url-http-method "GET" - url-http-data nil)) - (not-modified ; 304 - ;; The 304 response MUST NOT contain a message-body. - (url-http-debug "Extracting document from cache... (%s)" - (url-cache-create-filename (url-view-url t))) - (url-cache-extract (url-cache-create-filename (url-view-url t))) - (setq redirect-uri nil - success t)) - (use-proxy ; 305 - ;; The requested resource MUST be accessed through the - ;; proxy given by the Location field. The Location field - ;; gives the URI of the proxy. The recipient is expected - ;; to repeat this single request via the proxy. 305 - ;; responses MUST only be generated by origin servers. - (error "Redirection thru a proxy server not supported: %s" - redirect-uri)) - (otherwise - ;; Treat everything like '300' - nil)) - (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. - (if (not (string-match url-nonrelative-link redirect-uri)) - ;; Be careful to use the real target URL, otherwise we may - ;; compute the redirection relative to the URL of the proxy. - (setq redirect-uri - (url-expand-file-name redirect-uri url-http-target-url))) - ;; Do not automatically include an authorization header in the - ;; redirect. If needed it will be regenerated by the relevant - ;; auth scheme when the new request happens. - (setq url-http-extra-headers - (let (result) - (dolist (header url-http-extra-headers) - (if (not (equal (car header) "Authorization")) - (push header result))) - (nreverse result))) - (let ((url-request-method url-http-method) - (url-request-data url-http-data) - (url-request-extra-headers url-http-extra-headers)) - ;; Check existing number of redirects - (if (or (< url-max-redirections 0) - (and (> url-max-redirections 0) - (let ((events (car url-callback-arguments)) - (old-redirects 0)) - (while events - (if (eq (car events) :redirect) - (setq old-redirects (1+ old-redirects))) - (and (setq events (cdr events)) - (setq events (cdr events)))) - (< old-redirects url-max-redirections)))) - ;; url-max-redirections hasn't been reached, so go - ;; ahead and redirect. - (progn - ;; Remember that the request was redirected. - (setf (car url-callback-arguments) - (nconc (list :redirect redirect-uri) - (car url-callback-arguments))) - ;; Put in the current buffer a forwarding pointer to the new - ;; destination buffer. - ;; FIXME: This is a hack to fix url-retrieve-synchronously - ;; without changing the API. Instead url-retrieve should - ;; either simply not return the "destination" buffer, or it - ;; should take an optional `dest-buf' argument. - (set (make-local-variable 'url-redirect-buffer) - (url-retrieve-internal - redirect-uri url-callback-function - url-callback-arguments - (url-silent url-current-object) - (not (url-use-cookies url-current-object)))) - (url-mark-buffer-as-dead buffer)) - ;; We hit url-max-redirections, so issue an error and - ;; stop redirecting. - (url-http-debug "Maximum redirections reached") - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http-redirect-limit - redirect-uri)) - (car url-callback-arguments))) - (setq success t)))))) - (4 ; Client error - ;; 400 Bad Request - ;; 401 Unauthorized - ;; 402 Payment required - ;; 403 Forbidden - ;; 404 Not found - ;; 405 Method not allowed - ;; 406 Not acceptable - ;; 407 Proxy authentication required - ;; 408 Request time-out - ;; 409 Conflict - ;; 410 Gone - ;; 411 Length required - ;; 412 Precondition failed - ;; 413 Request entity too large - ;; 414 Request-URI too large - ;; 415 Unsupported media type - ;; 416 Requested range not satisfiable - ;; 417 Expectation failed - ;; 422 Unprocessable Entity (Added by DAV) - ;; 423 Locked - ;; 424 Failed Dependency - (case status-symbol - (unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (not-found ; 404 - ;; Not found - (setq success t)) - (method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((request-entity-too-large request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (otherwise - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (5 - ;; 500 Internal server error - ;; 501 Not implemented - ;; 502 Bad gateway - ;; 503 Service unavailable - ;; 504 Gateway time-out - ;; 505 HTTP version not supported - ;; 507 Insufficient storage - (setq success t) - (case url-http-response-status - (not-implemented ; 501 - ;; The server does not support the functionality required to - ;; fulfill the request. - nil) - (bad-gateway ; 502 - ;; The server, while acting as a gateway or proxy, received - ;; an invalid response from the upstream server it accessed - ;; in attempting to fulfill the request. - nil) - (service-unavailable ; 503 - ;; The server is currently unable to handle the request due - ;; to a temporary overloading or maintenance of the server. - ;; The implication is that this is a temporary condition - ;; which will be alleviated after some delay. If known, the - ;; length of the delay MAY be indicated in a Retry-After - ;; header. If no Retry-After is given, the client SHOULD - ;; handle the response as it would for a 500 response. - nil) - (gateway-timeout ; 504 - ;; The server, while acting as a gateway or proxy, did not - ;; receive a timely response from the upstream server - ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other - ;; auxiliary server (e.g. DNS) it needed to access in - ;; attempting to complete the request. - nil) - (http-version-not-supported ; 505 - ;; The server does not support, or refuses to support, the - ;; HTTP protocol version that was used in the request - ;; message. - nil) - (insufficient-storage ; 507 (DAV) - ;; The method could not be performed on the resource - ;; because the server is unable to store the representation - ;; needed to successfully complete the request. This - ;; condition is considered to be temporary. If the request - ;; which received this status code was the result of a user - ;; action, the request MUST NOT be repeated until it is - ;; requested by a separate user action. - nil)) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (otherwise - (error "Unknown class of HTTP response code: %d (%d)" - class url-http-response-status))) - (if (not success) - (url-mark-buffer-as-dead buffer)) - (url-http-debug "Finished parsing HTTP headers: %S" success) - (widen) - success)) - -(provide 'url-http-ntlm-parse-headers-24.2) - -;;; url-http-ntlm-parse-headers-24.2.el ends here diff --git a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.3.el b/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.3.el deleted file mode 100644 index d81745674..000000000 --- a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.3.el +++ /dev/null @@ -1,473 +0,0 @@ -;;; url-http-ntlm-parse-headers-24.3.el --- Override url-http-parse-headers - -;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. - -;; Author: Bill Perry -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Override url-http-parse-headers to clear Authorization headers -;; from url-http-extra-headers prior to executing a redirect. The -;; only change is to apply this backward-compatible patch: -;; -;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el -;; index 222dbc9..856b8b7 100644 -;; --- a/lisp/url/url-http.el -;; +++ b/lisp/url/url-http.el -;; @@ -620,6 +620,15 @@ should be shown to the user." -;; ;; compute the redirection relative to the URL of the proxy. -;; (setq redirect-uri -;; (url-expand-file-name redirect-uri url-http-target-url))) -;; + ;; Do not automatically include an authorization header in the -;; + ;; redirect. If needed it will be regenerated by the relevant -;; + ;; auth scheme when the new request happens. -;; + (setq url-http-extra-headers -;; + (let (result) -;; + (dolist (header url-http-extra-headers) -;; + (if (not (equal (car header) "Authorization")) -;; + (push header result))) -;; + (nreverse result))) -;; (let ((url-request-method url-http-method) -;; (url-request-data url-http-data) -;; (url-request-extra-headers url-http-extra-headers)) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'url-gw) -(require 'url-parse) -(require 'url-cookie) -(require 'mail-parse) -(require 'url-auth) -(require 'url) -(autoload 'url-cache-create-filename "url-cache") -(require 'url-http) - -(defvar url-http-process) -(defvar url-http-end-of-headers) -(defvar url-http-response-version) -(defvar url-http-response-status) -(defvar url-http-target-url) -(defvar url-http-method) -(defvar url-http-data) -(defvar url-http-extra-headers) -(defvar url-callback-arguments) -(defvar url-callback-function) - -(defun url-http-parse-headers () - "Parse and handle HTTP specific headers. -Return t if and only if the current buffer is still active and -should be shown to the user." - ;; The comments after each status code handled are taken from RFC - ;; 2616 (HTTP/1.1) - (url-http-mark-connection-as-free (url-host url-current-object) - (url-port url-current-object) - url-http-process) - - (if (or (not (boundp 'url-http-end-of-headers)) - (not url-http-end-of-headers)) - (error "Trying to parse headers in odd buffer: %s" (buffer-name))) - (goto-char (point-min)) - (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (let ((connection (mail-fetch-field "Connection"))) - ;; In HTTP 1.0, keep the connection only if there is a - ;; "Connection: keep-alive" header. - ;; In HTTP 1.1 (and greater), keep the connection unless there is a - ;; "Connection: close" header - (cond - ((string= url-http-response-version "1.0") - (unless (and connection - (string= (downcase connection) "keep-alive")) - (delete-process url-http-process))) - (t - (when (and connection - (string= (downcase connection) "close")) - (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (setq class (/ url-http-response-status 100)) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" - class url-http-response-status) - (when (url-use-cookies url-http-target-url) - (url-http-handle-cookies)) - - (pcase class - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - (1 ; Information messages - ;; 100 = Continue with request - ;; 101 = Switching protocols - ;; 102 = Processing (Added by DAV) - (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" - url-http-response-status)) - (2 ; Success - ;; 200 Ok - ;; 201 Created - ;; 202 Accepted - ;; 203 Non-authoritative information - ;; 204 No content - ;; 205 Reset content - ;; 206 Partial content - ;; 207 Multi-status (Added by DAV) - (pcase status-symbol - ((or `no-content `reset-content) - ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) - (_ - ;; Generic success for all others. Store in the cache, and - ;; mark it as successful. - (widen) - (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) - (3 ; Redirection - ;; 300 Multiple choices - ;; 301 Moved permanently - ;; 302 Found - ;; 303 See other - ;; 304 Not modified - ;; 305 Use proxy - ;; 307 Temporary redirect - (let ((redirect-uri (or (mail-fetch-field "Location") - (mail-fetch-field "URI")))) - (pcase status-symbol - (`multiple-choices ; 300 - ;; Quoth the spec (section 10.3.1) - ;; ------------------------------- - ;; The requested resource corresponds to any one of a set of - ;; representations, each with its own specific location and - ;; agent-driven negotiation information is being provided so - ;; that the user can select a preferred representation and - ;; redirect its request to that location. - ;; [...] - ;; If the server has a preferred choice of representation, it - ;; SHOULD include the specific URI for that representation in - ;; the Location field; user agents MAY use the Location field - ;; value for automatic redirection. - ;; ------------------------------- - ;; We do not support agent-driven negotiation, so we just - ;; redirect to the preferred URI if one is provided. - nil) - ((or `moved-permanently `found `temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (`see-other ; 303 - ;; The response to the request can be found under a different - ;; URI and SHOULD be retrieved using a GET method on that - ;; resource. - (setq url-http-method "GET" - url-http-data nil)) - (`not-modified ; 304 - ;; The 304 response MUST NOT contain a message-body. - (url-http-debug "Extracting document from cache... (%s)" - (url-cache-create-filename (url-view-url t))) - (url-cache-extract (url-cache-create-filename (url-view-url t))) - (setq redirect-uri nil - success t)) - (`use-proxy ; 305 - ;; The requested resource MUST be accessed through the - ;; proxy given by the Location field. The Location field - ;; gives the URI of the proxy. The recipient is expected - ;; to repeat this single request via the proxy. 305 - ;; responses MUST only be generated by origin servers. - (error "Redirection thru a proxy server not supported: %s" - redirect-uri)) - (_ - ;; Treat everything like '300' - nil)) - (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. - (if (not (string-match url-nonrelative-link redirect-uri)) - ;; Be careful to use the real target URL, otherwise we may - ;; compute the redirection relative to the URL of the proxy. - (setq redirect-uri - (url-expand-file-name redirect-uri url-http-target-url))) - ;; Do not automatically include an authorization header in the - ;; redirect. If needed it will be regenerated by the relevant - ;; auth scheme when the new request happens. - (setq url-http-extra-headers - (let (result) - (dolist (header url-http-extra-headers) - (if (not (equal (car header) "Authorization")) - (push header result))) - (nreverse result))) - (let ((url-request-method url-http-method) - (url-request-data url-http-data) - (url-request-extra-headers url-http-extra-headers)) - ;; Check existing number of redirects - (if (or (< url-max-redirections 0) - (and (> url-max-redirections 0) - (let ((events (car url-callback-arguments)) - (old-redirects 0)) - (while events - (if (eq (car events) :redirect) - (setq old-redirects (1+ old-redirects))) - (and (setq events (cdr events)) - (setq events (cdr events)))) - (< old-redirects url-max-redirections)))) - ;; url-max-redirections hasn't been reached, so go - ;; ahead and redirect. - (progn - ;; Remember that the request was redirected. - (setf (car url-callback-arguments) - (nconc (list :redirect redirect-uri) - (car url-callback-arguments))) - ;; Put in the current buffer a forwarding pointer to the new - ;; destination buffer. - ;; FIXME: This is a hack to fix url-retrieve-synchronously - ;; without changing the API. Instead url-retrieve should - ;; either simply not return the "destination" buffer, or it - ;; should take an optional `dest-buf' argument. - (set (make-local-variable 'url-redirect-buffer) - (url-retrieve-internal - redirect-uri url-callback-function - url-callback-arguments - (url-silent url-current-object) - (not (url-use-cookies url-current-object)))) - (url-mark-buffer-as-dead buffer)) - ;; We hit url-max-redirections, so issue an error and - ;; stop redirecting. - (url-http-debug "Maximum redirections reached") - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http-redirect-limit - redirect-uri)) - (car url-callback-arguments))) - (setq success t)))))) - (4 ; Client error - ;; 400 Bad Request - ;; 401 Unauthorized - ;; 402 Payment required - ;; 403 Forbidden - ;; 404 Not found - ;; 405 Method not allowed - ;; 406 Not acceptable - ;; 407 Proxy authentication required - ;; 408 Request time-out - ;; 409 Conflict - ;; 410 Gone - ;; 411 Length required - ;; 412 Precondition failed - ;; 413 Request entity too large - ;; 414 Request-URI too large - ;; 415 Unsupported media type - ;; 416 Requested range not satisfiable - ;; 417 Expectation failed - ;; 422 Unprocessable Entity (Added by DAV) - ;; 423 Locked - ;; 424 Failed Dependency - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (`not-found ; 404 - ;; Not found - (setq success t)) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (5 - ;; 500 Internal server error - ;; 501 Not implemented - ;; 502 Bad gateway - ;; 503 Service unavailable - ;; 504 Gateway time-out - ;; 505 HTTP version not supported - ;; 507 Insufficient storage - (setq success t) - (pcase url-http-response-status - (`not-implemented ; 501 - ;; The server does not support the functionality required to - ;; fulfill the request. - nil) - (`bad-gateway ; 502 - ;; The server, while acting as a gateway or proxy, received - ;; an invalid response from the upstream server it accessed - ;; in attempting to fulfill the request. - nil) - (`service-unavailable ; 503 - ;; The server is currently unable to handle the request due - ;; to a temporary overloading or maintenance of the server. - ;; The implication is that this is a temporary condition - ;; which will be alleviated after some delay. If known, the - ;; length of the delay MAY be indicated in a Retry-After - ;; header. If no Retry-After is given, the client SHOULD - ;; handle the response as it would for a 500 response. - nil) - (`gateway-timeout ; 504 - ;; The server, while acting as a gateway or proxy, did not - ;; receive a timely response from the upstream server - ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other - ;; auxiliary server (e.g. DNS) it needed to access in - ;; attempting to complete the request. - nil) - (`http-version-not-supported ; 505 - ;; The server does not support, or refuses to support, the - ;; HTTP protocol version that was used in the request - ;; message. - nil) - (`insufficient-storage ; 507 (DAV) - ;; The method could not be performed on the resource - ;; because the server is unable to store the representation - ;; needed to successfully complete the request. This - ;; condition is considered to be temporary. If the request - ;; which received this status code was the result of a user - ;; action, the request MUST NOT be repeated until it is - ;; requested by a separate user action. - nil)) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (_ - (error "Unknown class of HTTP response code: %d (%d)" - class url-http-response-status))) - (if (not success) - (url-mark-buffer-as-dead buffer)) - (url-http-debug "Finished parsing HTTP headers: %S" success) - (widen) - success)) - -(provide 'url-http-ntlm-parse-headers-24.3) - -;;; url-http-ntlm-parse-headers-24.3.el ends here diff --git a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.4.el b/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.4.el deleted file mode 100644 index f1597994b..000000000 --- a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.4.el +++ /dev/null @@ -1,474 +0,0 @@ -;;; url-http-ntlm-parse-headers-24.4.el --- Override url-http-parse-headers - -;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. - -;; Author: Bill Perry -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Override url-http-parse-headers to clear Authorization headers -;; from url-http-extra-headers prior to executing a redirect. The -;; only change is to apply this backward-compatible patch: -;; -;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el -;; index b0a3b68..80d9cca 100644 -;; --- a/lisp/url/url-http.el -;; +++ b/lisp/url/url-http.el -;; @@ -617,6 +617,15 @@ should be shown to the user." -;; ;; compute the redirection relative to the URL of the proxy. -;; (setq redirect-uri -;; (url-expand-file-name redirect-uri url-http-target-url))) -;; + ;; Do not automatically include an authorization header in the -;; + ;; redirect. If needed it will be regenerated by the relevant -;; + ;; auth scheme when the new request happens. -;; + (setq url-http-extra-headers -;; + (let (result) -;; + (dolist (header url-http-extra-headers) -;; + (if (not (equal (car header) "Authorization")) -;; + (push header result))) -;; + (nreverse result))) -;; (let ((url-request-method url-http-method) -;; (url-request-data url-http-data) -;; (url-request-extra-headers url-http-extra-headers)) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'url-gw) -(require 'url-parse) -(require 'url-cookie) -(require 'mail-parse) -(require 'url-auth) -(require 'url) -(autoload 'url-cache-create-filename "url-cache") -(require 'url-http) - -(defvar url-http-process) -(defvar url-http-end-of-headers) -(defvar url-http-response-version) -(defvar url-http-response-status) -(defvar url-http-target-url) -(defvar url-http-method) -(defvar url-http-data) -(defvar url-http-extra-headers) -(defvar url-callback-arguments) -(defvar url-callback-function) - -(defun url-http-parse-headers () - "Parse and handle HTTP specific headers. -Return t if and only if the current buffer is still active and -should be shown to the user." - ;; The comments after each status code handled are taken from RFC - ;; 2616 (HTTP/1.1) - (url-http-mark-connection-as-free (url-host url-current-object) - (url-port url-current-object) - url-http-process) - - (if (or (not (boundp 'url-http-end-of-headers)) - (not url-http-end-of-headers)) - (error "Trying to parse headers in odd buffer: %s" (buffer-name))) - (goto-char (point-min)) - (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (let ((connection (mail-fetch-field "Connection"))) - ;; In HTTP 1.0, keep the connection only if there is a - ;; "Connection: keep-alive" header. - ;; In HTTP 1.1 (and greater), keep the connection unless there is a - ;; "Connection: close" header - (cond - ((string= url-http-response-version "1.0") - (unless (and connection - (string= (downcase connection) "keep-alive")) - (delete-process url-http-process))) - (t - (when (and connection - (string= (downcase connection) "close")) - (delete-process url-http-process))))) - (let* ((buffer (current-buffer)) - (class (/ url-http-response-status 100)) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" - class url-http-response-status) - (when (url-use-cookies url-http-target-url) - (url-http-handle-cookies)) - - (pcase class - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - (1 ; Information messages - ;; 100 = Continue with request - ;; 101 = Switching protocols - ;; 102 = Processing (Added by DAV) - (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" - url-http-response-status)) - (2 ; Success - ;; 200 Ok - ;; 201 Created - ;; 202 Accepted - ;; 203 Non-authoritative information - ;; 204 No content - ;; 205 Reset content - ;; 206 Partial content - ;; 207 Multi-status (Added by DAV) - (pcase status-symbol - ((or `no-content `reset-content) - ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer)) - (_ - ;; Generic success for all others. Store in the cache, and - ;; mark it as successful. - (widen) - (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)))) - (setq success t)) - (3 ; Redirection - ;; 300 Multiple choices - ;; 301 Moved permanently - ;; 302 Found - ;; 303 See other - ;; 304 Not modified - ;; 305 Use proxy - ;; 307 Temporary redirect - (let ((redirect-uri (or (mail-fetch-field "Location") - (mail-fetch-field "URI")))) - (pcase status-symbol - (`multiple-choices ; 300 - ;; Quoth the spec (section 10.3.1) - ;; ------------------------------- - ;; The requested resource corresponds to any one of a set of - ;; representations, each with its own specific location and - ;; agent-driven negotiation information is being provided so - ;; that the user can select a preferred representation and - ;; redirect its request to that location. - ;; [...] - ;; If the server has a preferred choice of representation, it - ;; SHOULD include the specific URI for that representation in - ;; the Location field; user agents MAY use the Location field - ;; value for automatic redirection. - ;; ------------------------------- - ;; We do not support agent-driven negotiation, so we just - ;; redirect to the preferred URI if one is provided. - nil) - ((or `moved-permanently `found `temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (`see-other ; 303 - ;; The response to the request can be found under a different - ;; URI and SHOULD be retrieved using a GET method on that - ;; resource. - (setq url-http-method "GET" - url-http-data nil)) - (`not-modified ; 304 - ;; The 304 response MUST NOT contain a message-body. - (url-http-debug "Extracting document from cache... (%s)" - (url-cache-create-filename (url-view-url t))) - (url-cache-extract (url-cache-create-filename (url-view-url t))) - (setq redirect-uri nil - success t)) - (`use-proxy ; 305 - ;; The requested resource MUST be accessed through the - ;; proxy given by the Location field. The Location field - ;; gives the URI of the proxy. The recipient is expected - ;; to repeat this single request via the proxy. 305 - ;; responses MUST only be generated by origin servers. - (error "Redirection thru a proxy server not supported: %s" - redirect-uri)) - (_ - ;; Treat everything like '300' - nil)) - (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. - (if (not (string-match url-nonrelative-link redirect-uri)) - ;; Be careful to use the real target URL, otherwise we may - ;; compute the redirection relative to the URL of the proxy. - (setq redirect-uri - (url-expand-file-name redirect-uri url-http-target-url))) - ;; Do not automatically include an authorization header in the - ;; redirect. If needed it will be regenerated by the relevant - ;; auth scheme when the new request happens. - (setq url-http-extra-headers - (let (result) - (dolist (header url-http-extra-headers) - (if (not (equal (car header) "Authorization")) - (push header result))) - (nreverse result))) - (let ((url-request-method url-http-method) - (url-request-data url-http-data) - (url-request-extra-headers url-http-extra-headers)) - ;; Check existing number of redirects - (if (or (< url-max-redirections 0) - (and (> url-max-redirections 0) - (let ((events (car url-callback-arguments)) - (old-redirects 0)) - (while events - (if (eq (car events) :redirect) - (setq old-redirects (1+ old-redirects))) - (and (setq events (cdr events)) - (setq events (cdr events)))) - (< old-redirects url-max-redirections)))) - ;; url-max-redirections hasn't been reached, so go - ;; ahead and redirect. - (progn - ;; Remember that the request was redirected. - (setf (car url-callback-arguments) - (nconc (list :redirect redirect-uri) - (car url-callback-arguments))) - ;; Put in the current buffer a forwarding pointer to the new - ;; destination buffer. - ;; FIXME: This is a hack to fix url-retrieve-synchronously - ;; without changing the API. Instead url-retrieve should - ;; either simply not return the "destination" buffer, or it - ;; should take an optional `dest-buf' argument. - (set (make-local-variable 'url-redirect-buffer) - (url-retrieve-internal - redirect-uri url-callback-function - url-callback-arguments - (url-silent url-current-object) - (not (url-use-cookies url-current-object)))) - (url-mark-buffer-as-dead buffer)) - ;; We hit url-max-redirections, so issue an error and - ;; stop redirecting. - (url-http-debug "Maximum redirections reached") - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http-redirect-limit - redirect-uri)) - (car url-callback-arguments))) - (setq success t)))))) - (4 ; Client error - ;; 400 Bad Request - ;; 401 Unauthorized - ;; 402 Payment required - ;; 403 Forbidden - ;; 404 Not found - ;; 405 Method not allowed - ;; 406 Not acceptable - ;; 407 Proxy authentication required - ;; 408 Request time-out - ;; 409 Conflict - ;; 410 Gone - ;; 411 Length required - ;; 412 Precondition failed - ;; 413 Request entity too large - ;; 414 Request-URI too large - ;; 415 Unsupported media type - ;; 416 Requested range not satisfiable - ;; 417 Expectation failed - ;; 422 Unprocessable Entity (Added by DAV) - ;; 423 Locked - ;; 424 Failed Dependency - (setq success - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - t) - (`not-found ; 404 - ;; Not found - t) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - t) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - t) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - t) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - t) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - t) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - t) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - t) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - t) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - t) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - t) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - t) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - t))) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (5 - ;; 500 Internal server error - ;; 501 Not implemented - ;; 502 Bad gateway - ;; 503 Service unavailable - ;; 504 Gateway time-out - ;; 505 HTTP version not supported - ;; 507 Insufficient storage - (setq success t) - (pcase url-http-response-status - (`not-implemented ; 501 - ;; The server does not support the functionality required to - ;; fulfill the request. - nil) - (`bad-gateway ; 502 - ;; The server, while acting as a gateway or proxy, received - ;; an invalid response from the upstream server it accessed - ;; in attempting to fulfill the request. - nil) - (`service-unavailable ; 503 - ;; The server is currently unable to handle the request due - ;; to a temporary overloading or maintenance of the server. - ;; The implication is that this is a temporary condition - ;; which will be alleviated after some delay. If known, the - ;; length of the delay MAY be indicated in a Retry-After - ;; header. If no Retry-After is given, the client SHOULD - ;; handle the response as it would for a 500 response. - nil) - (`gateway-timeout ; 504 - ;; The server, while acting as a gateway or proxy, did not - ;; receive a timely response from the upstream server - ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other - ;; auxiliary server (e.g. DNS) it needed to access in - ;; attempting to complete the request. - nil) - (`http-version-not-supported ; 505 - ;; The server does not support, or refuses to support, the - ;; HTTP protocol version that was used in the request - ;; message. - nil) - (`insufficient-storage ; 507 (DAV) - ;; The method could not be performed on the resource - ;; because the server is unable to store the representation - ;; needed to successfully complete the request. This - ;; condition is considered to be temporary. If the request - ;; which received this status code was the result of a user - ;; action, the request MUST NOT be repeated until it is - ;; requested by a separate user action. - nil)) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (_ - (error "Unknown class of HTTP response code: %d (%d)" - class url-http-response-status))) - (if (not success) - (url-mark-buffer-as-dead buffer) - (url-handle-content-transfer-encoding)) - (url-http-debug "Finished parsing HTTP headers: %S" success) - (widen) - (goto-char (point-min)) - success)) - -(provide 'url-http-ntlm-parse-headers-24.4) - -;;; url-http-ntlm-parse-headers-24.4.el ends here diff --git a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.5.el b/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.5.el deleted file mode 100644 index ebe90ab76..000000000 --- a/packages/url-http-ntlm/url-http-ntlm-parse-headers-24.5.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; url-http-ntlm-parse-headers-24.5.el --- Override url-http-parse-headers - -;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. - -;; Author: Bill Perry -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Override url-http-parse-headers to clear Authorization headers -;; from url-http-extra-headers prior to executing a redirect. The -;; only change is to apply this backward-compatible patch: -;; -;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el -;; index 680097a..2ff497f 100644 -;; --- a/lisp/url/url-http.el -;; +++ b/lisp/url/url-http.el -;; @@ -617,6 +617,12 @@ should be shown to the user." -;; ;; compute the redirection relative to the URL of the proxy. -;; (setq redirect-uri -;; (url-expand-file-name redirect-uri url-http-target-url))) -;; + ;; Do not automatically include an authorization header in the -;; + ;; redirect. If needed it will be regenerated by the relevant -;; + ;; auth scheme when the new request happens. -;; + (setq url-http-extra-headers -;; + (cl-remove "Authorization" -;; + url-http-extra-headers :key 'car :test 'equal)) -;; (let ((url-request-method url-http-method) -;; (url-request-data url-http-data) -;; (url-request-extra-headers url-http-extra-headers)) -;; -;;; Code: - -(require 'cl-lib) - -(defvar url-callback-arguments) -(defvar url-callback-function) -(defvar url-current-object) -(defvar url-http-after-change-function) -(defvar url-http-chunked-counter) -(defvar url-http-chunked-length) -(defvar url-http-chunked-start) -(defvar url-http-connection-opened) -(defvar url-http-content-length) -(defvar url-http-content-type) -(defvar url-http-data) -(defvar url-http-end-of-headers) -(defvar url-http-extra-headers) -(defvar url-http-method) -(defvar url-http-no-retry) -(defvar url-http-process) -(defvar url-http-proxy) -(defvar url-http-response-status) -(defvar url-http-response-version) -(defvar url-http-target-url) -(defvar url-http-transfer-encoding) -(defvar url-show-status) - -(require 'url-gw) -(require 'url-parse) -(require 'url-cookie) -(require 'mail-parse) -(require 'url-auth) -(require 'url) -(autoload 'url-cache-create-filename "url-cache") -(require 'url-http) - -(defun url-http-parse-headers () - "Parse and handle HTTP specific headers. -Return t if and only if the current buffer is still active and -should be shown to the user." - ;; The comments after each status code handled are taken from RFC - ;; 2616 (HTTP/1.1) - (url-http-mark-connection-as-free (url-host url-current-object) - (url-port url-current-object) - url-http-process) - - (if (or (not (boundp 'url-http-end-of-headers)) - (not url-http-end-of-headers)) - (error "Trying to parse headers in odd buffer: %s" (buffer-name))) - (goto-char (point-min)) - (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (let ((connection (mail-fetch-field "Connection"))) - ;; In HTTP 1.0, keep the connection only if there is a - ;; "Connection: keep-alive" header. - ;; In HTTP 1.1 (and greater), keep the connection unless there is a - ;; "Connection: close" header - (cond - ((string= url-http-response-version "1.0") - (unless (and connection - (string= (downcase connection) "keep-alive")) - (delete-process url-http-process))) - (t - (when (and connection - (string= (downcase connection) "close")) - (delete-process url-http-process))))) - (let* ((buffer (current-buffer)) - (class (/ url-http-response-status 100)) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" - class url-http-response-status) - (when (url-use-cookies url-http-target-url) - (url-http-handle-cookies)) - - (pcase class - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - (1 ; Information messages - ;; 100 = Continue with request - ;; 101 = Switching protocols - ;; 102 = Processing (Added by DAV) - (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" - url-http-response-status)) - (2 ; Success - ;; 200 Ok - ;; 201 Created - ;; 202 Accepted - ;; 203 Non-authoritative information - ;; 204 No content - ;; 205 Reset content - ;; 206 Partial content - ;; 207 Multi-status (Added by DAV) - (pcase status-symbol - ((or `no-content `reset-content) - ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer)) - (_ - ;; Generic success for all others. Store in the cache, and - ;; mark it as successful. - (widen) - (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)))) - (setq success t)) - (3 ; Redirection - ;; 300 Multiple choices - ;; 301 Moved permanently - ;; 302 Found - ;; 303 See other - ;; 304 Not modified - ;; 305 Use proxy - ;; 307 Temporary redirect - (let ((redirect-uri (or (mail-fetch-field "Location") - (mail-fetch-field "URI")))) - (pcase status-symbol - (`multiple-choices ; 300 - ;; Quoth the spec (section 10.3.1) - ;; ------------------------------- - ;; The requested resource corresponds to any one of a set of - ;; representations, each with its own specific location and - ;; agent-driven negotiation information is being provided so - ;; that the user can select a preferred representation and - ;; redirect its request to that location. - ;; [...] - ;; If the server has a preferred choice of representation, it - ;; SHOULD include the specific URI for that representation in - ;; the Location field; user agents MAY use the Location field - ;; value for automatic redirection. - ;; ------------------------------- - ;; We do not support agent-driven negotiation, so we just - ;; redirect to the preferred URI if one is provided. - nil) - ((or `moved-permanently `found `temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (`see-other ; 303 - ;; The response to the request can be found under a different - ;; URI and SHOULD be retrieved using a GET method on that - ;; resource. - (setq url-http-method "GET" - url-http-data nil)) - (`not-modified ; 304 - ;; The 304 response MUST NOT contain a message-body. - (url-http-debug "Extracting document from cache... (%s)" - (url-cache-create-filename (url-view-url t))) - (url-cache-extract (url-cache-create-filename (url-view-url t))) - (setq redirect-uri nil - success t)) - (`use-proxy ; 305 - ;; The requested resource MUST be accessed through the - ;; proxy given by the Location field. The Location field - ;; gives the URI of the proxy. The recipient is expected - ;; to repeat this single request via the proxy. 305 - ;; responses MUST only be generated by origin servers. - (error "Redirection thru a proxy server not supported: %s" - redirect-uri)) - (_ - ;; Treat everything like '300' - nil)) - (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. - (if (not (string-match url-nonrelative-link redirect-uri)) - ;; Be careful to use the real target URL, otherwise we may - ;; compute the redirection relative to the URL of the proxy. - (setq redirect-uri - (url-expand-file-name redirect-uri url-http-target-url))) - ;; Do not automatically include an authorization header in the - ;; redirect. If needed it will be regenerated by the relevant - ;; auth scheme when the new request happens. - (setq url-http-extra-headers - (cl-remove "Authorization" - url-http-extra-headers :key 'car :test 'equal)) - (let ((url-request-method url-http-method) - (url-request-data url-http-data) - (url-request-extra-headers url-http-extra-headers)) - ;; Check existing number of redirects - (if (or (< url-max-redirections 0) - (and (> url-max-redirections 0) - (let ((events (car url-callback-arguments)) - (old-redirects 0)) - (while events - (if (eq (car events) :redirect) - (setq old-redirects (1+ old-redirects))) - (and (setq events (cdr events)) - (setq events (cdr events)))) - (< old-redirects url-max-redirections)))) - ;; url-max-redirections hasn't been reached, so go - ;; ahead and redirect. - (progn - ;; Remember that the request was redirected. - (setf (car url-callback-arguments) - (nconc (list :redirect redirect-uri) - (car url-callback-arguments))) - ;; Put in the current buffer a forwarding pointer to the new - ;; destination buffer. - ;; FIXME: This is a hack to fix url-retrieve-synchronously - ;; without changing the API. Instead url-retrieve should - ;; either simply not return the "destination" buffer, or it - ;; should take an optional `dest-buf' argument. - (set (make-local-variable 'url-redirect-buffer) - (url-retrieve-internal - redirect-uri url-callback-function - url-callback-arguments - (url-silent url-current-object) - (not (url-use-cookies url-current-object)))) - (url-mark-buffer-as-dead buffer)) - ;; We hit url-max-redirections, so issue an error and - ;; stop redirecting. - (url-http-debug "Maximum redirections reached") - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http-redirect-limit - redirect-uri)) - (car url-callback-arguments))) - (setq success t)))))) - (4 ; Client error - ;; 400 Bad Request - ;; 401 Unauthorized - ;; 402 Payment required - ;; 403 Forbidden - ;; 404 Not found - ;; 405 Method not allowed - ;; 406 Not acceptable - ;; 407 Proxy authentication required - ;; 408 Request time-out - ;; 409 Conflict - ;; 410 Gone - ;; 411 Length required - ;; 412 Precondition failed - ;; 413 Request entity too large - ;; 414 Request-URI too large - ;; 415 Unsupported media type - ;; 416 Requested range not satisfiable - ;; 417 Expectation failed - ;; 422 Unprocessable Entity (Added by DAV) - ;; 423 Locked - ;; 424 Failed Dependency - (setq success - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - t) - (`not-found ; 404 - ;; Not found - t) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - t) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - t) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - t) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - t) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - t) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - t) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - t) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - t) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - t) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - t) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - t) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - t))) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (5 - ;; 500 Internal server error - ;; 501 Not implemented - ;; 502 Bad gateway - ;; 503 Service unavailable - ;; 504 Gateway time-out - ;; 505 HTTP version not supported - ;; 507 Insufficient storage - (setq success t) - (pcase url-http-response-status - (`not-implemented ; 501 - ;; The server does not support the functionality required to - ;; fulfill the request. - nil) - (`bad-gateway ; 502 - ;; The server, while acting as a gateway or proxy, received - ;; an invalid response from the upstream server it accessed - ;; in attempting to fulfill the request. - nil) - (`service-unavailable ; 503 - ;; The server is currently unable to handle the request due - ;; to a temporary overloading or maintenance of the server. - ;; The implication is that this is a temporary condition - ;; which will be alleviated after some delay. If known, the - ;; length of the delay MAY be indicated in a Retry-After - ;; header. If no Retry-After is given, the client SHOULD - ;; handle the response as it would for a 500 response. - nil) - (`gateway-timeout ; 504 - ;; The server, while acting as a gateway or proxy, did not - ;; receive a timely response from the upstream server - ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other - ;; auxiliary server (e.g. DNS) it needed to access in - ;; attempting to complete the request. - nil) - (`http-version-not-supported ; 505 - ;; The server does not support, or refuses to support, the - ;; HTTP protocol version that was used in the request - ;; message. - nil) - (`insufficient-storage ; 507 (DAV) - ;; The method could not be performed on the resource - ;; because the server is unable to store the representation - ;; needed to successfully complete the request. This - ;; condition is considered to be temporary. If the request - ;; which received this status code was the result of a user - ;; action, the request MUST NOT be repeated until it is - ;; requested by a separate user action. - nil)) - ;; Tell the callback that an error occurred, and what the - ;; status code was. - (when success - (setf (car url-callback-arguments) - (nconc (list :error (list 'error 'http url-http-response-status)) - (car url-callback-arguments))))) - (_ - (error "Unknown class of HTTP response code: %d (%d)" - class url-http-response-status))) - (if (not success) - (url-mark-buffer-as-dead buffer) - (url-handle-content-transfer-encoding)) - (url-http-debug "Finished parsing HTTP headers: %S" success) - (widen) - (goto-char (point-min)) - success)) - -(provide 'url-http-ntlm-parse-headers-24.5) - -;; url-http-ntlm-parse-headers-24.5.el ends here diff --git a/packages/url-http-ntlm/url-http-ntlm.el b/packages/url-http-ntlm/url-http-ntlm.el index a1e1663b8..e0499b9c9 100644 --- a/packages/url-http-ntlm/url-http-ntlm.el +++ b/packages/url-http-ntlm/url-http-ntlm.el @@ -49,9 +49,25 @@ ;; Remove authorization after redirect. (when (and (boundp 'emacs-major-version) (< emacs-major-version 25)) - (require (intern (format "url-http-ntlm-parse-headers-%d.%d" - emacs-major-version - emacs-minor-version)))) + (defvar url-http-ntlm--parsing-headers nil) + (defadvice url-http-parse-headers (around clear-authorization activate) + (let ((url-http-ntlm--parsing-headers t)) + ad-do-it)) + (defadvice url-http-handle-authentication (around clear-authorization + activate) + (let ((url-http-ntlm--parsing-headers nil)) + ad-do-it)) + (defadvice url-retrieve-internal (before clear-authorization activate) + (when (and url-http-ntlm--parsing-headers + (eq url-request-extra-headers url-http-extra-headers)) + ;; This retrieval is presumably in response to a redirect. + ;; Do not automatically include an authorization header in the + ;; redirect. If needed it will be regenerated by the relevant + ;; auth scheme when the new request happens. + (setq url-http-extra-headers + (cl-remove "Authorization" + url-http-extra-headers :key #'car :test #'equal)) + (setq url-request-extra-headers url-http-extra-headers)))) ;;; Private variables. -- 2.39.2