1 ;;; url-http-ntlm-parse-headers-24.5.el --- Override url-http-parse-headers
3 ;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc.
5 ;; Author: Bill Perry <wmperry@gnu.org>
6 ;; Keywords: comm, data, processes
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Override url-http-parse-headers to clear Authorization headers
26 ;; from url-http-extra-headers prior to executing a redirect. The
27 ;; only change is to apply this backward-compatible patch:
29 ;; diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
30 ;; index 680097a..2ff497f 100644
31 ;; --- a/lisp/url/url-http.el
32 ;; +++ b/lisp/url/url-http.el
33 ;; @@ -617,6 +617,12 @@ should be shown to the user."
34 ;; ;; compute the redirection relative to the URL of the proxy.
36 ;; (url-expand-file-name redirect-uri url-http-target-url)))
37 ;; + ;; Do not automatically include an authorization header in the
38 ;; + ;; redirect. If needed it will be regenerated by the relevant
39 ;; + ;; auth scheme when the new request happens.
40 ;; + (setq url-http-extra-headers
41 ;; + (cl-remove "Authorization"
42 ;; + url-http-extra-headers :key 'car :test 'equal))
43 ;; (let ((url-request-method url-http-method)
44 ;; (url-request-data url-http-data)
45 ;; (url-request-extra-headers url-http-extra-headers))
51 (defvar url-callback-arguments)
52 (defvar url-callback-function)
53 (defvar url-current-object)
54 (defvar url-http-after-change-function)
55 (defvar url-http-chunked-counter)
56 (defvar url-http-chunked-length)
57 (defvar url-http-chunked-start)
58 (defvar url-http-connection-opened)
59 (defvar url-http-content-length)
60 (defvar url-http-content-type)
61 (defvar url-http-data)
62 (defvar url-http-end-of-headers)
63 (defvar url-http-extra-headers)
64 (defvar url-http-method)
65 (defvar url-http-no-retry)
66 (defvar url-http-process)
67 (defvar url-http-proxy)
68 (defvar url-http-response-status)
69 (defvar url-http-response-version)
70 (defvar url-http-target-url)
71 (defvar url-http-transfer-encoding)
72 (defvar url-show-status)
80 (autoload 'url-cache-create-filename "url-cache")
83 (defun url-http-parse-headers ()
84 "Parse and handle HTTP specific headers.
85 Return t if and only if the current buffer is still active and
86 should be shown to the user."
87 ;; The comments after each status code handled are taken from RFC
89 (url-http-mark-connection-as-free (url-host url-current-object)
90 (url-port url-current-object)
93 (if (or (not (boundp 'url-http-end-of-headers))
94 (not url-http-end-of-headers))
95 (error "Trying to parse headers in odd buffer: %s" (buffer-name)))
96 (goto-char (point-min))
97 (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name))
98 (url-http-parse-response)
100 ;;(narrow-to-region (point-min) url-http-end-of-headers)
101 (let ((connection (mail-fetch-field "Connection")))
102 ;; In HTTP 1.0, keep the connection only if there is a
103 ;; "Connection: keep-alive" header.
104 ;; In HTTP 1.1 (and greater), keep the connection unless there is a
105 ;; "Connection: close" header
107 ((string= url-http-response-version "1.0")
108 (unless (and connection
109 (string= (downcase connection) "keep-alive"))
110 (delete-process url-http-process)))
112 (when (and connection
113 (string= (downcase connection) "close"))
114 (delete-process url-http-process)))))
115 (let* ((buffer (current-buffer))
116 (class (/ url-http-response-status 100))
118 ;; other status symbols: jewelry and luxury cars
119 (status-symbol (cadr (assq url-http-response-status url-http-codes))))
120 (url-http-debug "Parsed HTTP headers: class=%d status=%d"
121 class url-http-response-status)
122 (when (url-use-cookies url-http-target-url)
123 (url-http-handle-cookies))
126 ;; Classes of response codes
128 ;; 5xx = Server Error
129 ;; 4xx = Client Error
132 ;; 1xx = Informational
133 (1 ; Information messages
134 ;; 100 = Continue with request
135 ;; 101 = Switching protocols
136 ;; 102 = Processing (Added by DAV)
137 (url-mark-buffer-as-dead buffer)
138 (error "HTTP responses in class 1xx not supported (%d)"
139 url-http-response-status))
144 ;; 203 Non-authoritative information
147 ;; 206 Partial content
148 ;; 207 Multi-status (Added by DAV)
150 ((or `no-content `reset-content)
151 ;; No new data, just stay at the same document
152 (url-mark-buffer-as-dead buffer))
154 ;; Generic success for all others. Store in the cache, and
155 ;; mark it as successful.
157 (if (and url-automatic-caching (equal url-http-method "GET"))
158 (url-store-in-cache buffer))))
161 ;; 300 Multiple choices
162 ;; 301 Moved permanently
167 ;; 307 Temporary redirect
168 (let ((redirect-uri (or (mail-fetch-field "Location")
169 (mail-fetch-field "URI"))))
171 (`multiple-choices ; 300
172 ;; Quoth the spec (section 10.3.1)
173 ;; -------------------------------
174 ;; The requested resource corresponds to any one of a set of
175 ;; representations, each with its own specific location and
176 ;; agent-driven negotiation information is being provided so
177 ;; that the user can select a preferred representation and
178 ;; redirect its request to that location.
180 ;; If the server has a preferred choice of representation, it
181 ;; SHOULD include the specific URI for that representation in
182 ;; the Location field; user agents MAY use the Location field
183 ;; value for automatic redirection.
184 ;; -------------------------------
185 ;; We do not support agent-driven negotiation, so we just
186 ;; redirect to the preferred URI if one is provided.
188 ((or `moved-permanently `found `temporary-redirect) ; 301 302 307
189 ;; If the 301|302 status code is received in response to a
190 ;; request other than GET or HEAD, the user agent MUST NOT
191 ;; automatically redirect the request unless it can be
192 ;; confirmed by the user, since this might change the
193 ;; conditions under which the request was issued.
194 (unless (member url-http-method '("HEAD" "GET"))
195 (setq redirect-uri nil)))
197 ;; The response to the request can be found under a different
198 ;; URI and SHOULD be retrieved using a GET method on that
200 (setq url-http-method "GET"
203 ;; The 304 response MUST NOT contain a message-body.
204 (url-http-debug "Extracting document from cache... (%s)"
205 (url-cache-create-filename (url-view-url t)))
206 (url-cache-extract (url-cache-create-filename (url-view-url t)))
207 (setq redirect-uri nil
210 ;; The requested resource MUST be accessed through the
211 ;; proxy given by the Location field. The Location field
212 ;; gives the URI of the proxy. The recipient is expected
213 ;; to repeat this single request via the proxy. 305
214 ;; responses MUST only be generated by origin servers.
215 (error "Redirection thru a proxy server not supported: %s"
218 ;; Treat everything like '300'
221 ;; Clean off any whitespace and/or <...> cruft.
222 (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri)
223 (setq redirect-uri (match-string 1 redirect-uri)))
224 (if (string-match "^<\\(.*\\)>$" redirect-uri)
225 (setq redirect-uri (match-string 1 redirect-uri)))
227 ;; Some stupid sites (like sourceforge) send a
228 ;; non-fully-qualified URL (ie: /), which royally confuses
230 (if (not (string-match url-nonrelative-link redirect-uri))
231 ;; Be careful to use the real target URL, otherwise we may
232 ;; compute the redirection relative to the URL of the proxy.
234 (url-expand-file-name redirect-uri url-http-target-url)))
235 ;; Do not automatically include an authorization header in the
236 ;; redirect. If needed it will be regenerated by the relevant
237 ;; auth scheme when the new request happens.
238 (setq url-http-extra-headers
239 (cl-remove "Authorization"
240 url-http-extra-headers :key 'car :test 'equal))
241 (let ((url-request-method url-http-method)
242 (url-request-data url-http-data)
243 (url-request-extra-headers url-http-extra-headers))
244 ;; Check existing number of redirects
245 (if (or (< url-max-redirections 0)
246 (and (> url-max-redirections 0)
247 (let ((events (car url-callback-arguments))
250 (if (eq (car events) :redirect)
251 (setq old-redirects (1+ old-redirects)))
252 (and (setq events (cdr events))
253 (setq events (cdr events))))
254 (< old-redirects url-max-redirections))))
255 ;; url-max-redirections hasn't been reached, so go
256 ;; ahead and redirect.
258 ;; Remember that the request was redirected.
259 (setf (car url-callback-arguments)
260 (nconc (list :redirect redirect-uri)
261 (car url-callback-arguments)))
262 ;; Put in the current buffer a forwarding pointer to the new
263 ;; destination buffer.
264 ;; FIXME: This is a hack to fix url-retrieve-synchronously
265 ;; without changing the API. Instead url-retrieve should
266 ;; either simply not return the "destination" buffer, or it
267 ;; should take an optional `dest-buf' argument.
268 (set (make-local-variable 'url-redirect-buffer)
269 (url-retrieve-internal
270 redirect-uri url-callback-function
271 url-callback-arguments
272 (url-silent url-current-object)
273 (not (url-use-cookies url-current-object))))
274 (url-mark-buffer-as-dead buffer))
275 ;; We hit url-max-redirections, so issue an error and
277 (url-http-debug "Maximum redirections reached")
278 (setf (car url-callback-arguments)
279 (nconc (list :error (list 'error 'http-redirect-limit
281 (car url-callback-arguments)))
282 (setq success t))))))
286 ;; 402 Payment required
289 ;; 405 Method not allowed
290 ;; 406 Not acceptable
291 ;; 407 Proxy authentication required
292 ;; 408 Request time-out
295 ;; 411 Length required
296 ;; 412 Precondition failed
297 ;; 413 Request entity too large
298 ;; 414 Request-URI too large
299 ;; 415 Unsupported media type
300 ;; 416 Requested range not satisfiable
301 ;; 417 Expectation failed
302 ;; 422 Unprocessable Entity (Added by DAV)
304 ;; 424 Failed Dependency
308 ;; The request requires user authentication. The response
309 ;; MUST include a WWW-Authenticate header field containing a
310 ;; challenge applicable to the requested resource. The
311 ;; client MAY repeat the request with a suitable
312 ;; Authorization header field.
313 (url-http-handle-authentication nil))
314 (`payment-required ; 402
315 ;; This code is reserved for future use
316 (url-mark-buffer-as-dead buffer)
317 (error "Somebody wants you to give them money"))
319 ;; The server understood the request, but is refusing to
320 ;; fulfill it. Authorization will not help and the request
321 ;; SHOULD NOT be repeated.
326 (`method-not-allowed ; 405
327 ;; The method specified in the Request-Line is not allowed
328 ;; for the resource identified by the Request-URI. The
329 ;; response MUST include an Allow header containing a list of
330 ;; valid methods for the requested resource.
332 (`not-acceptable ; 406
333 ;; The resource identified by the request is only capable of
334 ;; generating response entities which have content
335 ;; characteristics not acceptable according to the accept
336 ;; headers sent in the request.
338 (`proxy-authentication-required ; 407
339 ;; This code is similar to 401 (Unauthorized), but indicates
340 ;; that the client must first authenticate itself with the
341 ;; proxy. The proxy MUST return a Proxy-Authenticate header
342 ;; field containing a challenge applicable to the proxy for
343 ;; the requested resource.
344 (url-http-handle-authentication t))
345 (`request-timeout ; 408
346 ;; The client did not produce a request within the time that
347 ;; the server was prepared to wait. The client MAY repeat
348 ;; the request without modifications at any later time.
351 ;; The request could not be completed due to a conflict with
352 ;; the current state of the resource. This code is only
353 ;; allowed in situations where it is expected that the user
354 ;; might be able to resolve the conflict and resubmit the
355 ;; request. The response body SHOULD include enough
356 ;; information for the user to recognize the source of the
360 ;; The requested resource is no longer available at the
361 ;; server and no forwarding address is known.
363 (`length-required ; 411
364 ;; The server refuses to accept the request without a defined
365 ;; Content-Length. The client MAY repeat the request if it
366 ;; adds a valid Content-Length header field containing the
367 ;; length of the message-body in the request message.
369 ;; NOTE - this will never happen because
370 ;; `url-http-create-request' automatically calculates the
373 (`precondition-failed ; 412
374 ;; The precondition given in one or more of the
375 ;; request-header fields evaluated to false when it was
376 ;; tested on the server.
378 ((or `request-entity-too-large `request-uri-too-large) ; 413 414
379 ;; The server is refusing to process a request because the
380 ;; request entity|URI is larger than the server is willing or
383 (`unsupported-media-type ; 415
384 ;; The server is refusing to service the request because the
385 ;; entity of the request is in a format not supported by the
386 ;; requested resource for the requested method.
388 (`requested-range-not-satisfiable ; 416
389 ;; A server SHOULD return a response with this status code if
390 ;; a request included a Range request-header field, and none
391 ;; of the range-specifier values in this field overlap the
392 ;; current extent of the selected resource, and the request
393 ;; did not include an If-Range request-header field.
395 (`expectation-failed ; 417
396 ;; The expectation given in an Expect request-header field
397 ;; could not be met by this server, or, if the server is a
398 ;; proxy, the server has unambiguous evidence that the
399 ;; request could not be met by the next-hop server.
402 ;; The request could not be understood by the server due to
403 ;; malformed syntax. The client SHOULD NOT repeat the
404 ;; request without modifications.
406 ;; Tell the callback that an error occurred, and what the
409 (setf (car url-callback-arguments)
410 (nconc (list :error (list 'error 'http url-http-response-status))
411 (car url-callback-arguments)))))
413 ;; 500 Internal server error
414 ;; 501 Not implemented
416 ;; 503 Service unavailable
417 ;; 504 Gateway time-out
418 ;; 505 HTTP version not supported
419 ;; 507 Insufficient storage
421 (pcase url-http-response-status
422 (`not-implemented ; 501
423 ;; The server does not support the functionality required to
424 ;; fulfill the request.
427 ;; The server, while acting as a gateway or proxy, received
428 ;; an invalid response from the upstream server it accessed
429 ;; in attempting to fulfill the request.
431 (`service-unavailable ; 503
432 ;; The server is currently unable to handle the request due
433 ;; to a temporary overloading or maintenance of the server.
434 ;; The implication is that this is a temporary condition
435 ;; which will be alleviated after some delay. If known, the
436 ;; length of the delay MAY be indicated in a Retry-After
437 ;; header. If no Retry-After is given, the client SHOULD
438 ;; handle the response as it would for a 500 response.
440 (`gateway-timeout ; 504
441 ;; The server, while acting as a gateway or proxy, did not
442 ;; receive a timely response from the upstream server
443 ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other
444 ;; auxiliary server (e.g. DNS) it needed to access in
445 ;; attempting to complete the request.
447 (`http-version-not-supported ; 505
448 ;; The server does not support, or refuses to support, the
449 ;; HTTP protocol version that was used in the request
452 (`insufficient-storage ; 507 (DAV)
453 ;; The method could not be performed on the resource
454 ;; because the server is unable to store the representation
455 ;; needed to successfully complete the request. This
456 ;; condition is considered to be temporary. If the request
457 ;; which received this status code was the result of a user
458 ;; action, the request MUST NOT be repeated until it is
459 ;; requested by a separate user action.
461 ;; Tell the callback that an error occurred, and what the
464 (setf (car url-callback-arguments)
465 (nconc (list :error (list 'error 'http url-http-response-status))
466 (car url-callback-arguments)))))
468 (error "Unknown class of HTTP response code: %d (%d)"
469 class url-http-response-status)))
471 (url-mark-buffer-as-dead buffer)
472 (url-handle-content-transfer-encoding))
473 (url-http-debug "Finished parsing HTTP headers: %S" success)
475 (goto-char (point-min))
478 (provide 'url-http-ntlm-parse-headers-24.5)
480 ;; url-http-ntlm-parse-headers-24.5.el ends here