Commit 3a3f390d authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/url/url-http.el (status): Remove, unused.

(success): Remove var.
(url-http-handle-authentication): Return the value that `success'
should take instead of setting `success' directly.  Don't set `status'
since it's not used.
(url-http-parse-headers): Avoid unneeded setq.
Move the `setq success'.
(url-http): Use pcase.
(url-http-file-exists-p): Simplify.
parent a1c80d9d
2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
* url-http.el (status): Remove, unused.
(success): Remove var.
(url-http-handle-authentication): Return the value that `success'
should take instead of setting `success' directly. Don't set `status'
since it's not used.
(url-http-parse-headers): Avoid unneeded setq.
Move the `setq success'.
(url-http): Use pcase.
(url-http-file-exists-p): Simplify.
2013-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-cookie.el: Implement a command and mode for displaying and
......
......@@ -375,9 +375,6 @@ Return the number of characters removed."
(replace-match ""))
(- end url-http-end-of-headers)))
(defvar status)
(defvar success)
(defun url-http-handle-authentication (proxy)
(url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
(let ((auths (or (nreverse
......@@ -404,9 +401,9 @@ Return the number of characters removed."
(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)))
(downcase (if (string-match "[ \t]" this-auth)
(substring this-auth 0 (match-beginning 0))
this-auth)))
(registered (url-auth-registered this-type))
(this-strength (cddr registered)))
(when (and registered (> this-strength strength))
......@@ -421,20 +418,26 @@ Return the number of characters removed."
(insert "<hr>Sorry, but I do not know how to handle " type
" authentication. If you'd like to write it,"
" send it to " url-bug-address ".<hr>")
(setq status t))
;; We used to set a `status' var (declared "special") but I can't
;; find the corresponding let-binding, so it's probably an error.
;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
;; (setq status t)
nil) ;; Not success yet.
(let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
(auth (url-get-authentication auth-url
(cdr-safe (assoc "realm" args))
type t args)))
(if (not auth)
(setq success t)
t ;Success.
(push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
url-http-extra-headers)
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
(url-retrieve-internal url url-callback-function
url-callback-arguments)))))))
url-callback-arguments))
nil))))) ;; Not success yet.
(defun url-http-parse-response ()
"Parse just the response code."
......@@ -498,12 +501,11 @@ should be shown to the user."
(when (and connection
(string= (downcase connection) "close"))
(delete-process url-http-process)))))
(let ((buffer (current-buffer))
(class nil)
(success nil)
;; other status symbols: jewelry and luxury cars
(status-symbol (cadr (assq url-http-response-status url-http-codes))))
(setq class (/ url-http-response-status 100))
(let* ((buffer (current-buffer))
(class (/ url-http-response-status 100))
(success nil)
;; other status symbols: jewelry and luxury cars
(status-symbol (cadr (assq url-http-response-status url-http-codes))))
(url-http-debug "Parsed HTTP headers: class=%d status=%d"
class url-http-response-status)
(when (url-use-cookies url-http-target-url)
......@@ -536,15 +538,14 @@ should be shown to the user."
(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))
(url-mark-buffer-as-dead buffer))
(_
;; Generic success for all others. Store in the cache, and
;; mark it as successful.
(widen)
(if (and url-automatic-caching (equal url-http-method "GET"))
(url-store-in-cache buffer))
(setq success t))))
(url-store-in-cache buffer))))
(setq success t))
(3 ; Redirection
;; 300 Multiple choices
;; 301 Moved permanently
......@@ -684,106 +685,107 @@ should be shown to the user."
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
(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
;; This code is reserved for future use
(url-mark-buffer-as-dead buffer)
(error "Somebody wants you to give them money"))
(`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
(setq success t))
(`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
;; 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
;; 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
;; 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
;; 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
;; 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
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
(setq success t))
(`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
;; length of the message-body in the request message.
;;
;; NOTE - this will never happen because
;; `url-http-create-request' automatically calculates the
;; content-length.
(setq success t))
(`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))
((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
;; 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
;; 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
;; 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))
(_
;; 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
(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
;; This code is reserved for future use
(url-mark-buffer-as-dead buffer)
(error "Somebody wants you to give them money"))
(`forbidden ; 403
;; The server understood the request, but is refusing to
;; fulfill it. Authorization will not help and the request
;; SHOULD NOT be repeated.
t)
(`not-found ; 404
;; Not found
t)
(`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.
t)
(`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.
t)
(`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
;; 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.
t)
(`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
;; 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.
t)
(`gone ; 410
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
t)
(`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
;; length of the message-body in the request message.
;;
;; NOTE - this will never happen because
;; `url-http-create-request' automatically calculates the
;; content-length.
t)
(`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.
t)
((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.
t)
(`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.
t)
(`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.
t)
(`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.
t)
(_
;; The request could not be understood by the server due to
;; malformed syntax. The client SHOULD NOT repeat the
;; request without modifications.
t)))
;; Tell the callback that an error occurred, and what the
;; status code was.
(when success
......@@ -1222,18 +1224,17 @@ previous `url-http' call, which is being re-attempted."
(set-process-buffer connection buffer)
(set-process-filter connection 'url-http-generic-filter)
(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" host port))
(t
(set-process-sentinel connection
'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
(pcase (process-status connection)
(`connect
;; Asynchronous connection
(set-process-sentinel connection 'url-http-async-sentinel))
(`failed
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
(_
(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)
......@@ -1302,17 +1303,14 @@ previous `url-http' call, which is being re-attempted."
(url-retrieve-synchronously url)))
(defun url-http-file-exists-p (url)
(let ((status nil)
(exists nil)
(buffer (url-http-head url)))
(if (not buffer)
(setq exists nil)
(setq status (url-http-symbol-value-in-buffer 'url-http-response-status
buffer 500)
exists (and (integerp status)
(>= status 200) (< status 300)))
(kill-buffer buffer))
exists))
(let ((buffer (url-http-head url)))
(when buffer
(let ((status (url-http-symbol-value-in-buffer 'url-http-response-status
buffer 500)))
(prog1
(and (integerp status)
(>= status 200) (< status 300))
(kill-buffer buffer))))))
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment