;;; url-http.el --- HTTP retrieval routines
-;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2011 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;; Drop the temp buffer link before killing the buffer.
(set-process-buffer proc nil))
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)))))))
;; Building an HTTP request
(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.
;; End request
"\r\n"
;; Any data
- url-http-data "\r\n"))
+ 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))
;; 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)))
+ (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
(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
;; 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.
url-http-response-status))
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(buffer-name))
- (when (not (bobp))
- (let ((end-of-headers nil)
- (old-http nil)
- (content-length nil))
+ (let ((end-of-headers nil)
+ (old-http nil)
+ (process-buffer (current-buffer))
+ (content-length nil))
+ (when (not (bobp))
(goto-char (point-min))
(if (and (looking-at ".*\n") ; have one line at least
(not (looking-at "^HTTP/[1-9]\\.[0-9]")))
;; Haven't seen the end of the headers yet, need to wait
;; for more data to arrive.
nil
- (if old-http
- (message "HTTP/0.9 How I hate thee!")
- (progn
- (url-http-parse-response)
- (mail-narrow-to-head)
- ;;(narrow-to-region (point-min) url-http-end-of-headers)
- (setq url-http-transfer-encoding (mail-fetch-field
- "transfer-encoding")
- url-http-content-type (mail-fetch-field "content-type"))
- (if (mail-fetch-field "content-length")
- (setq url-http-content-length
- (string-to-number (mail-fetch-field "content-length"))))
- (widen)))
+ (unless old-http
+ (url-http-parse-response)
+ (mail-narrow-to-head)
+ (setq url-http-transfer-encoding (mail-fetch-field
+ "transfer-encoding")
+ url-http-content-type (mail-fetch-field "content-type"))
+ (if (mail-fetch-field "content-length")
+ (setq url-http-content-length
+ (string-to-number (mail-fetch-field "content-length"))))
+ (widen))
(when url-http-transfer-encoding
(setq url-http-transfer-encoding
(downcase url-http-transfer-encoding)))
(cond
+ ((null url-http-response-status)
+ ;; We got back a headerless malformed response from the
+ ;; server.
+ (url-http-activate-callback))
((or (= url-http-response-status 204)
(= url-http-response-status 205))
(url-http-debug "%d response must have headers only (%s)."
(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)))
'url-http-simple-after-change-function)))))
;; We are still at the beginning of the buffer... must just be
;; waiting for a response.
- (url-http-debug "Spinning waiting for headers..."))
- (goto-char (point-max)))
+ (url-http-debug "Spinning waiting for headers...")
+ (when (eq process-buffer (current-buffer))
+ (goto-char (point-max)))))
;;;###autoload
(defun url-http (url callback cbargs)
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-start
url-callback-function
url-callback-arguments
+ url-show-status
url-http-process
url-http-method
url-http-extra-headers
(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
(provide 'url-http)
-;; arch-tag: ba7c59ae-c0f4-4a31-9617-d85f221732ee
;;; url-http.el ends here
HCoop / bpt / emacs.git / blobdiff