+++ /dev/null
-;;; 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 <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-2016 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-2016 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-2016 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-2016 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
;; 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))))
\f
;;; Private variables.