;;; url-http.el --- HTTP retrieval routines
-;; Copyright (C) 1999, 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;;; 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)
(503 service-unavailable "Service unavailable")
(504 gateway-timeout "Gateway time-out")
(505 http-version-not-supported "HTTP version not supported")
- (507 insufficient-storage "Insufficient storage")
-"The HTTP return codes and their text."))
+ (507 insufficient-storage "Insufficient storage"))
+ "The HTTP return codes and their text.")
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
(defun url-http-find-free-connection (host port)
(let ((conns (gethash (cons host port) url-http-open-connections))
- (found nil))
- (while (and conns (not found))
+ (connection nil))
+ (while (and conns (not connection))
(if (not (memq (process-status (car conns)) '(run open connect)))
(progn
(url-http-debug "Cleaning up dead process: %s:%d %S"
host port (car conns))
(url-http-idle-sentinel (car conns) nil))
- (setq found (car conns))
- (url-http-debug "Found existing connection: %s:%d %S" host port found))
+ (setq connection (car conns))
+ (url-http-debug "Found existing connection: %s:%d %S" host port connection))
(pop conns))
- (if found
+ (if connection
(url-http-debug "Reusing existing connection: %s:%d" host port)
(url-http-debug "Contacting host: %s:%d" host port))
(url-lazy-message "Contacting host: %s:%d" host port)
- (url-http-mark-connection-as-busy
- host port
- (or found
- (let ((buf (generate-new-buffer " *url-http-temp*")))
- ;; `url-open-stream' needs a buffer in which to do things
- ;; like authentication. But we use another buffer afterwards.
- (unwind-protect
- (let ((proc (url-open-stream host buf host port)))
- ;; url-open-stream might return nil.
- (when (processp proc)
- ;; Drop the temp buffer link before killing the buffer.
- (set-process-buffer proc nil))
- proc)
- (kill-buffer buf)))))))
+
+ (unless connection
+ (let ((buf (generate-new-buffer " *url-http-temp*")))
+ ;; `url-open-stream' needs a buffer in which to do things
+ ;; like authentication. But we use another buffer afterwards.
+ (unwind-protect
+ (let ((proc (url-open-stream host buf host port)))
+ ;; url-open-stream might return nil.
+ (when (processp proc)
+ ;; Drop the temp buffer link before killing the buffer.
+ (set-process-buffer proc nil)
+ (setq connection proc)))
+ ;; If there was an error on connect, make sure we don't
+ ;; get queried.
+ (when (get-buffer-process buf)
+ (set-process-query-on-exit-flag (get-buffer-process buf) nil))
+ (kill-buffer buf))))
+
+ (if connection
+ (url-http-mark-connection-as-busy host port connection))))
;; Building an HTTP request
(defun url-http-user-agent-string ()
(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))))
- (real-fname (concat (url-filename url-http-target-url)
- (url-recreate-url-attributes url-http-target-url)))
+ (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))
nil
(if proxy-auth
(setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n")))
- ;; Protection against stupid values in the referer
+ ;; Protection against stupid values in the referrer
(if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil")
(string= ref-url "")))
(setq ref-url nil))
- ;; We do not want to expose the referer if the user is paranoid.
+ ;; We do not want to expose the referrer if the user is paranoid.
(if (or (memq url-privacy-level '(low high paranoid))
(and (listp url-privacy-level)
(memq 'lastloc url-privacy-level)))
(if (not (equal extra-headers ""))
(setq extra-headers (concat extra-headers "\r\n")))
- ;; This was done with a call to `format'. Concatting parts has
+ ;; This was done with a call to `format'. Concatenating parts has
;; the advantage of keeping the parts of each header together and
;; allows us to elide null lines directly, at the cost of making
;; the layout less clear.
;; Authorization
auth
;; Cookies
- (url-cookie-generate-header-lines host real-fname
- (equal "https" (url-type url-http-target-url)))
+ (when (url-use-cookies url-http-target-url)
+ (url-cookie-generate-header-lines
+ host real-fname
+ (equal "https" (url-type url-http-target-url))))
;; If-modified-since
(if (and (not no-cache)
(member url-http-method '("GET" nil)))
;; End request
"\r\n"
;; Any data
- url-http-data))
+ url-http-data
+ ;; If `url-http-data' is nil, avoid two CRLFs (Bug#8931).
+ (if url-http-data "\r\n")))
""))
(url-http-debug "Request is: \n%s" request)
request))
;; Parsing routines
(defun url-http-clean-headers ()
"Remove trailing \r from header lines.
-This allows us to use `mail-fetch-field', etc."
- (declare (special url-http-end-of-headers))
- (goto-char (point-min))
- (while (re-search-forward "\r$" url-http-end-of-headers t)
- (replace-match "")))
+This allows us to use `mail-fetch-field', etc.
+Return the number of characters removed."
+ (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-handle-cookies)
+ (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
;; confirmed by the user, since this might change the
;; conditions under which the request was issued.
- (if (member url-http-method '("HEAD" "GET"))
- ;; Automatic redirection is ok
- nil
- ;; It is just too big of a pain in the ass to get this
- ;; prompt all the time. We will just silently lose our
- ;; data and convert to a GET method.
- (url-http-debug "Converting `%s' request to `GET' because of REDIRECT(%d)"
- url-http-method url-http-response-status)
- (setq url-http-method "GET"
- url-http-data nil)))
- (see-other ; 303
+ (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
+ (`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
(url-retrieve-internal
redirect-uri url-callback-function
url-callback-arguments
- (url-silent url-current-object)))
+ (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.
;; 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 nota cceptable according to the accept
+ ;; 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
- ;; mioght be able to resolve the conflict and resubmit the
+ ;; 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
+ (`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-open-connections))
(defun url-http-end-of-document-sentinel (proc why)
- ;; Sentinel used for old HTTP/0.9 or connections we know are going
- ;; to die as the 'end of document' notifier.
+ ;; Sentinel used to handle (i) terminated old HTTP/0.9 connections,
+ ;; and (ii) closed connection due to reusing a HTTP connection which
+ ;; we believed was still alive, but which the server closed on us.
+ ;; We handle case (ii) by calling `url-http' again.
(url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
(process-buffer proc))
(url-http-idle-sentinel proc why)
(when (buffer-name (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
- (if (not (looking-at "HTTP/"))
- ;; HTTP/0.9 just gets passed back no matter what
- (url-http-activate-callback)
- (if (url-http-parse-headers)
- (url-http-activate-callback))))))
+ (cond ((not (looking-at "HTTP/"))
+ (if url-http-no-retry
+ ;; HTTP/0.9 just gets passed back no matter what
+ (url-http-activate-callback)
+ ;; Call `url-http' again if our connection expired.
+ (erase-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)
(setq url-http-end-of-headers (set-marker (make-marker)
(point))
end-of-headers t)
- (url-http-clean-headers)))
+ (setq nd (- nd (url-http-clean-headers)))))
(if (not end-of-headers)
;; Haven't seen the end of the headers yet, need to wait
(url-http-activate-callback)))
((string= "CONNECT" url-http-method)
;; A CONNECT request is finished, but we cannot stick this
- ;; back on the free connectin list
+ ;; back on the free connection list
(url-http-debug "CONNECT request must have headers only.")
(when (url-http-parse-headers)
(url-http-activate-callback)))
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
-;;;###autoload
-(defun url-http (url callback cbargs)
+(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."
- (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))
+
+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."
+ (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 (generate-new-buffer (format " *http %s:%d*" host port))))
+ (buffer (or retry-buffer
+ (generate-new-buffer
+ (format " *http %s:%d*" host port)))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
url-http-extra-headers
url-http-data
url-http-target-url
+ url-http-no-retry
url-http-connection-opened
url-http-proxy))
(set (make-local-variable var) nil))
url-callback-arguments cbargs
url-http-after-change-function 'url-http-wait-for-headers-change-function
url-http-target-url url-current-object
+ url-http-no-retry retry-buffer
url-http-connection-opened nil
url-http-proxy url-using-proxy)
;; 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))
(with-current-buffer (process-buffer proc)
(cond
(url-http-connection-opened
+ (setq url-http-no-retry t)
(url-http-end-of-document-sentinel proc why))
((string= (substring why 0 4) "open")
(setq url-http-connection-opened t)
- (process-send-string proc (url-http-create-request)))
+ (condition-case error
+ (process-send-string proc (url-http-create-request))
+ (file-error
+ (setq url-http-connection-opened nil)
+ (message "HTTP error: %s" error))))
(t
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'connection-failed why
;; 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