--- /dev/null
+;;; url-http-ntlm-parse-headers-24.1.el --- Override url-http-parse-headers
+
+;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; url-http-ntlm-parse-headers-24.2.el --- Override url-http-parse-headers
+
+;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; url-http-ntlm-parse-headers-24.3.el --- Override url-http-parse-headers
+
+;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; url-http-ntlm-parse-headers-24.4.el --- Override url-http-parse-headers
+
+;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; url-http-ntlm-parse-headers-24.5.el --- Override url-http-parse-headers
+
+;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
+
+;; Author: Bill Perry <wmperry@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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
(require 'cl-lib)
(require 'ntlm)
+;; 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))))
+
\f
;;; Private variables.
(defvar url-http-ntlm--auth-storage nil