;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (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-target-url)
+(defvar url-http-method)
(defvar url-http-no-retry)
+(defvar url-http-process)
(defvar url-http-proxy)
-(defvar url-http-connection-opened)
+(defvar url-http-response-status)
+(defvar url-http-response-version)
+(defvar url-http-target-url)
+(defvar url-http-transfer-encoding)
+(defvar url-http-end-of-headers)
+(defvar url-show-status)
+
(require 'url-gw)
(require 'url-util)
(require 'url-parse)
(and (listp url-privacy-level)
(memq 'agent url-privacy-level)))
""
- (format "User-Agent: %sURL/%s%s\r\n"
+ (format "User-Agent: %sURL/%s\r\n"
(if url-package-name
(concat url-package-name "/" url-package-version " ")
"")
- url-version
- (cond
- ((and url-os-type url-system-type)
- (concat " (" url-os-type "; " url-system-type ")"))
- ((or url-os-type url-system-type)
- (concat " (" (or url-system-type url-os-type) ")"))
- (t "")))))
+ url-version)))
(defun url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL."
- (declare (special proxy-info
- url-http-method url-http-data
- url-http-extra-headers))
(let* ((extra-headers)
(request nil)
(no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
- (url-get-authentication url-http-target-url nil 'any nil))))
+ (url-get-authentication url-http-proxy nil 'any nil))))
(real-fname (url-filename url-http-target-url))
(host (url-host url-http-target-url))
(auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
"Remove trailing \r from header lines.
This allows us to use `mail-fetch-field', etc.
Return the number of characters removed."
- (declare (special url-http-end-of-headers))
(let ((end (marker-position url-http-end-of-headers)))
(goto-char (point-min))
(while (re-search-forward "\r$" url-http-end-of-headers t)
(replace-match ""))
(- end url-http-end-of-headers)))
+(defvar status)
+(defvar success)
+
(defun url-http-handle-authentication (proxy)
- (declare (special status success url-http-method url-http-data
- url-callback-function url-callback-arguments))
(url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
(let ((auths (or (nreverse
(mail-fetch-field
(defun url-http-parse-response ()
"Parse just the response code."
- (declare (special url-http-end-of-headers url-http-response-status
- url-http-response-version))
(if (not url-http-end-of-headers)
(error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name)))
(url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
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)
(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))
+ (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)
+ (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
+ (pcase class
;; Classes of response codes
;;
;; 5xx = Server Error
;; 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))
+ (error "HTTP responses in class 1xx not supported (%d)"
+ url-http-response-status))
(2 ; Success
;; 200 Ok
;; 201 Created
;; 205 Reset content
;; 206 Partial content
;; 207 Multi-status (Added by DAV)
- (case status-symbol
- ((no-content reset-content)
+ (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))
- (otherwise
+ (_
;; Generic success for all others. Store in the cache, and
;; mark it as successful.
(widen)
;; 307 Temporary redirect
(let ((redirect-uri (or (mail-fetch-field "Location")
(mail-fetch-field "URI"))))
- (case status-symbol
- (multiple-choices ; 300
+ (pcase status-symbol
+ (`multiple-choices ; 300
;; Quoth the spec (section 10.3.1)
;; -------------------------------
;; The requested resource corresponds to any one of a set of
;; 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
+ ((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
;; conditions under which the request was issued.
(unless (member url-http-method '("HEAD" "GET"))
(setq redirect-uri nil)))
- (see-other ; 303
+ (`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
+ (`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
+ (`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
;; 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
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
- (case status-symbol
- (unauthorized ; 401
+ (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
+ (`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
+ (`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 ; 404
;; Not found
(setq success t))
- (method-not-allowed ; 405
+ (`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
+ (`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
+ (`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
+ (`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
+ (`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
;; information for the user to recognize the source of the
;; conflict.
(setq success t))
- (gone ; 410
+ (`gone ; 410
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
(setq success t))
- (length-required ; 411
+ (`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
;; `url-http-create-request' automatically calculates the
;; content-length.
(setq success t))
- (precondition-failed ; 412
+ (`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
+ ((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
+ (`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
+ (`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
+ (`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.
;; 505 HTTP version not supported
;; 507 Insufficient storage
(setq success t)
- (case url-http-response-status
- (not-implemented ; 501
+ (pcase url-http-response-status
+ (`not-implemented ; 501
;; The server does not support the functionality required to
;; fulfill the request.
nil)
- (bad-gateway ; 502
+ (`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
+ (`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
;; header. If no Retry-After is given, the client SHOULD
;; handle the response as it would for a 500 response.
nil)
- (gateway-timeout ; 504
+ (`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
+ (`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)
+ (`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
(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)
;; Miscellaneous
(defun url-http-activate-callback ()
"Activate callback specified when this buffer was created."
- (declare (special 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)
(url-http-activate-callback)
;; Call `url-http' again if our connection expired.
(erase-buffer)
- (url-http url-current-object url-callback-function
- url-callback-arguments (current-buffer))))
+ (let ((url-request-method url-http-method)
+ (url-request-extra-headers url-http-extra-headers)
+ (url-request-data url-http-data))
+ (url-http url-current-object url-callback-function
+ url-callback-arguments (current-buffer)))))
((url-http-parse-headers)
(url-http-activate-callback))))))
(defun url-http-simple-after-change-function (st nd length)
;; Function used when we do NOT know how long the document is going to be
;; Just _very_ simple 'downloaded %d' type of info.
- (declare (special url-http-end-of-headers))
(url-lazy-message "Reading %s..." (url-pretty-length nd)))
(defun url-http-content-length-after-change-function (st nd length)
More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
the callback to be triggered."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-length
- url-http-content-type
- url-http-process))
(if url-http-content-type
(url-display-percentage
"Reading [%s]... %s of %s (%d%%)"
Cannot give a sophisticated percentage, but we need a different
function to look for the special 0-length chunk that signifies
the end of the document."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-chunked-length
- url-http-chunked-counter
- url-http-process url-http-chunked-start))
(save-excursion
(goto-char st)
(let ((read-next-chunk t)
(defun url-http-wait-for-headers-change-function (st nd length)
;; This will wait for the headers to arrive and then splice in the
;; next appropriate after-change-function, etc.
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-callback-function
- url-callback-arguments
- url-http-process
- url-http-method
- url-http-after-change-function
- url-http-response-status))
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(buffer-name))
(let ((end-of-headers nil)
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
-;;;###autoload
(defun url-http (url callback cbargs &optional retry-buffer)
"Retrieve URL via HTTP asynchronously.
URL must be a parsed URL. See `url-generic-parse-url' for details.
-When retrieval is completed, the function CALLBACK is executed with
-CBARGS as the arguments.
+
+When retrieval is completed, execute the function CALLBACK, using
+the arguments listed in CBARGS. The first element in CBARGS
+should be a plist describing what has happened so far during the
+request, as described in the docstring of `url-retrieve' (if in
+doubt, specify nil).
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted."
- (check-type url vector "Need a pre-parsed URL.")
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-http-after-change-function
- url-callback-function
- url-callback-arguments
- url-show-status
- url-http-method
- url-http-extra-headers
- url-http-data
- url-http-chunked-length
- url-http-chunked-start
- url-http-chunked-counter
- url-http-process))
+ (cl-check-type url vector "Need a pre-parsed URL.")
(let* ((host (url-host (or url-using-proxy url)))
(port (url-port (or url-using-proxy url)))
(connection (url-http-find-free-connection host port))
(buffer (or retry-buffer
- (generate-new-buffer (format " *http %s:%d*" host port)))))
+ (generate-new-buffer
+ (format " *http %s:%d*" host port)))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
(t
- (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+ (set-process-sentinel connection
+ 'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
buffer))
(defun url-http-async-sentinel (proc why)
- (declare (special url-callback-arguments))
;; We are performing an asynchronous connection, and a status change
;; has occurred.
(when (buffer-name (process-buffer proc))
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (declare (special url-http-after-change-function))
(and (process-buffer proc)
(/= (length data) 0)
(with-current-buffer (process-buffer proc)
(url-request-data nil))
(url-retrieve-synchronously url)))
-;;;###autoload
(defun url-http-file-exists-p (url)
(let ((status nil)
(exists nil)
(kill-buffer buffer))
exists))
-;;;###autoload
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
(defun url-http-head-file-attributes (url &optional id-format)
(declare-function url-dav-file-attributes "url-dav" (url &optional id-format))
-;;;###autoload
(defun url-http-file-attributes (url &optional id-format)
(if (url-dav-supported-p url)
(url-dav-file-attributes url id-format)
(url-http-head-file-attributes url id-format)))
-;;;###autoload
(defun url-http-options (url)
"Return a property list describing options available for URL.
This list is retrieved using the `OPTIONS' HTTP method.
;; with url-http.el on systems with 8-character file names.
(require 'tls)
-;;;###autoload
(defconst url-https-default-port 443 "Default HTTPS port.")
-;;;###autoload
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
;; FIXME what is the point of this alias being an autoload?
HCoop / bpt / emacs.git / blobdiff