(defun url-http-mark-connection-as-free (host port proc)
(url-http-debug "Marking connection as free: %s:%d %S" host port proc)
- (set-process-buffer proc nil)
- (set-process-sentinel proc 'url-http-idle-sentinel)
- (puthash (cons host port)
- (cons proc (gethash (cons host port) url-http-open-connections))
- url-http-open-connections)
+ (when (memq (process-status proc) '(open run connect))
+ (set-process-buffer proc nil)
+ (set-process-sentinel proc 'url-http-idle-sentinel)
+ (puthash (cons host port)
+ (cons proc (gethash (cons host port) url-http-open-connections))
+ url-http-open-connections))
nil)
(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))
- (if (not (memq (process-status (car conns)) '(run open)))
+ (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))
;; like authentication. But we use another buffer afterwards.
(unwind-protect
(let ((proc (url-open-stream host buf host port)))
- ;; Drop the temp buffer link before killing the buffer.
- (set-process-buffer proc nil)
+ ;; 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)))))))
(defun url-http-create-request (url &optional ref-url)
"Create an HTTP request for URL, referred to by REF-URL."
- (declare (special proxy-object proxy-info))
+ (declare (special proxy-object proxy-info
+ url-http-method url-http-data
+ url-http-extra-headers))
(let* ((extra-headers)
(request nil)
- (no-cache (cdr-safe (assoc "Pragma" url-request-extra-headers)))
+ (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
(proxy-obj (and (boundp 'proxy-object) proxy-object))
(proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization"
- url-request-extra-headers))
+ url-http-extra-headers))
(not proxy-obj))
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
(url-get-authentication url nil 'any nil))))
- (real-fname (url-filename (or proxy-obj url)))
+ (real-fname (concat (url-filename (or proxy-obj url))
+ (url-recreate-url-attributes (or proxy-obj url))))
(host (url-host (or proxy-obj url)))
- (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers))
+ (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
nil
(url-get-authentication (or
(and (boundp 'proxy-info)
(memq 'lastloc url-privacy-level)))
(setq ref-url nil))
- ;; url-request-extra-headers contains an assoc-list of
+ ;; url-http-extra-headers contains an assoc-list of
;; header/value pairs that we need to put into the request.
(setq extra-headers (mapconcat
(lambda (x)
(concat (car x) ": " (cdr x)))
- url-request-extra-headers "\r\n"))
+ url-http-extra-headers "\r\n"))
(if (not (equal extra-headers ""))
(setq extra-headers (concat extra-headers "\r\n")))
(delq nil
(list
;; The request
- (or url-request-method "GET") " "
+ (or url-http-method "GET") " "
(if proxy-obj (url-recreate-url proxy-obj) real-fname)
" HTTP/" url-http-version "\r\n"
;; Version of MIME we speak
(equal "https" (url-type url)))
;; If-modified-since
(if (and (not no-cache)
- (member url-request-method '("GET" nil)))
+ (member url-http-method '("GET" nil)))
(let ((tm (url-is-cached (or proxy-obj url))))
(if tm
(concat "If-modified-since: "
"Referer: " ref-url "\r\n"))
extra-headers
;; Length of data
- (if url-request-data
+ (if url-http-data
(concat
"Content-length: " (number-to-string
- (length url-request-data))
+ (length url-http-data))
"\r\n"))
;; End request
"\r\n"
;; Any data
- url-request-data))
+ url-http-data))
""))
(url-http-debug "Request is: \n%s" request)
request))
(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 ((auth (or (mail-fetch-field (if proxy "proxy-authenticate" "www-authenticate"))
- "basic"))
+ (let ((auths (or (nreverse
+ (mail-fetch-field
+ (if proxy "proxy-authenticate" "www-authenticate")
+ nil nil t))
+ '("basic")))
(type nil)
(url (url-recreate-url url-current-object))
(url-basic-auth-storage 'url-http-real-basic-auth-storage)
- )
-
+ auth
+ (strength 0))
;; Cheating, but who cares? :)
(if proxy
(setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage))
- (setq auth (url-eat-trailing-space (url-strip-leading-spaces auth)))
- (if (string-match "[ \t]" auth)
- (setq type (downcase (substring auth 0 (match-beginning 0))))
- (setq type (downcase auth)))
+ ;; find strongest supported auth
+ (dolist (this-auth auths)
+ (setq this-auth (url-eat-trailing-space
+ (url-strip-leading-spaces
+ this-auth)))
+ (let* ((this-type
+ (if (string-match "[ \t]" this-auth)
+ (downcase (substring this-auth 0 (match-beginning 0)))
+ (downcase this-auth)))
+ (registered (url-auth-registered this-type))
+ (this-strength (cddr registered)))
+ (when (and registered (> this-strength strength))
+ (setq auth this-auth
+ type this-type
+ strength this-strength))))
(if (not (url-auth-registered type))
(progn
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
- (url-retrieve url url-callback-function
- url-callback-arguments)))))))
+ (url-retrieve-internal url url-callback-function
+ url-callback-arguments)))))))
(defun url-http-parse-response ()
"Parse just the response code."
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
- ;; 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 redirect-uri url-callback-function
- (cons :redirect
- (cons redirect-uri
- url-callback-arguments))))
- (url-mark-buffer-as-dead (current-buffer))))))
+ ;; 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-mark-buffer-as-dead (current-buffer))))))
(4 ; Client error
;; 400 Bad Request
;; 401 Unauthorized
;; 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))))
+ (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
;; 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)))
+ 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)))
url-current-object))
(set-process-buffer connection buffer)
- (set-process-sentinel connection 'url-http-end-of-document-sentinel)
(set-process-filter connection 'url-http-generic-filter)
- (process-send-string connection (url-http-create-request url))))
+ (let ((status (process-status connection)))
+ (cond
+ ((eq status 'connect)
+ ;; Asynchronous connection
+ (set-process-sentinel connection 'url-http-async-sentinel))
+ ((eq status 'failed)
+ ;; Asynchronous connection failed
+ (error "Could not create connection to %s:%d" (url-host url)
+ (url-port url)))
+ (t
+ (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+ (process-send-string connection (url-http-create-request url)))))))
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.
+ (with-current-buffer (process-buffer proc)
+ (cond
+ ((string= (substring why 0 4) "open")
+ (set-process-sentinel proc 'url-http-end-of-document-sentinel)
+ (process-send-string proc (url-http-create-request url-http-target-url)))
+ (t
+ (setf (car url-callback-arguments)
+ (nconc (list :error (list 'error 'connection-failed why
+ :host (url-host url-current-object)
+ :service (url-port url-current-object)))
+ (car url-callback-arguments)))
+ (url-http-activate-callback)))))
+
;; Since Emacs 19/20 does not allow you to change the
;; `after-change-functions' hook in the midst of running them, we fake
;; an after change by hooking into the process filter and inserting
(setq exists nil)
(setq status (url-http-symbol-value-in-buffer 'url-http-response-status
buffer 500)
- exists (and (>= status 200) (< status 300)))
+ exists (and (integerp status)
+ (>= status 200) (< status 300)))
(kill-buffer buffer))
exists))
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
(defun url-http-head-file-attributes (url &optional id-format)
- (let ((buffer (url-http-head url))
- (attributes nil))
+ (let ((buffer (url-http-head url)))
(when buffer
- (setq attributes (make-list 11 nil))
- (setf (nth 1 attributes) 1) ; Number of links to file
- (setf (nth 2 attributes) 0) ; file uid
- (setf (nth 3 attributes) 0) ; file gid
- (setf (nth 7 attributes) ; file size
- (url-http-symbol-value-in-buffer 'url-http-content-length
- buffer -1))
- (setf (nth 8 attributes) (eval-when-compile (make-string 10 ?-)))
- (kill-buffer buffer))
- attributes))
+ (prog1
+ (list
+ nil ;dir / link / normal file
+ 1 ;number of links to file.
+ 0 0 ;uid ; gid
+ nil nil nil ;atime ; mtime ; ctime
+ (url-http-symbol-value-in-buffer 'url-http-content-length
+ buffer -1)
+ (eval-when-compile (make-string 10 ?-))
+ nil nil nil) ;whether gid would change ; inode ; device.
+ (kill-buffer buffer)))))
;;;###autoload
(defun url-http-file-attributes (url &optional id-format)
(if buffer (kill-buffer buffer))
options))
+;; HTTPS. This used to be in url-https.el, but that file collides
+;; 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.")
+;;;###autoload
+(defalias 'url-https-expand-file-name 'url-http-expand-file-name)
+
+(defmacro url-https-create-secure-wrapper (method args)
+ `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
+ ,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
+ (let ((url-gateway-method 'tls))
+ (,(intern (format (if method "url-http-%s" "url-http") method))
+ ,@(remove '&rest (remove '&optional args))))))
+
+;;;###autoload (autoload 'url-https "url-http")
+(url-https-create-secure-wrapper nil (url callback cbargs))
+;;;###autoload (autoload 'url-https-file-exists-p "url-http")
+(url-https-create-secure-wrapper file-exists-p (url))
+;;;###autoload (autoload 'url-https-file-readable-p "url-http")
+(url-https-create-secure-wrapper file-readable-p (url))
+;;;###autoload (autoload 'url-https-file-attributes "url-http")
+(url-https-create-secure-wrapper file-attributes (url &optional id-format))
+
(provide 'url-http)
;; arch-tag: ba7c59ae-c0f4-4a31-9617-d85f221732ee