summaryrefslogtreecommitdiff
path: root/lisp/url
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/url')
-rw-r--r--lisp/url/ChangeLog194
-rw-r--r--lisp/url/url-cache.el66
-rw-r--r--lisp/url/url-cookie.el250
-rw-r--r--lisp/url/url-dired.el39
-rw-r--r--lisp/url/url-file.el19
-rw-r--r--lisp/url/url-gw.el27
-rw-r--r--lisp/url/url-history.el6
-rw-r--r--lisp/url/url-http.el163
-rw-r--r--lisp/url/url-irc.el5
-rw-r--r--lisp/url/url-parse.el22
-rw-r--r--lisp/url/url-util.el23
-rw-r--r--lisp/url/url-vars.el47
-rw-r--r--lisp/url/url.el21
13 files changed, 516 insertions, 366 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index de0f57d073c..dc6fd979231 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,32 +1,149 @@
-2010-12-04 Chong Yidong <cyd@stupidchicken.com>
+2010-12-16 Miles Bader <Miles Bader <miles@gnu.org>>
+
+ * url-cookie.el: Require 'cl when compiling -- it's necessary for
+ defstruct.
+
+2010-12-14 Glenn Morris <rgm@gnu.org>
+
+ * url-cookie.el: Don't require cl when compiling.
+ (url-cookie-clean-up, url-cookie-generate-header-lines): Use dolist.
+ (url-cookie-parse-file, url-cookie-store, url-cookie-retrieve)
+ (url-cookie-handle-set-cookie): Simplify.
+
+2010-12-13 Chong Yidong <cyd@stupidchicken.com>
* url-cookie.el (url-cookie-retrieve): Handle null LOCALPART.
Suggested by Lennart Borgman (Bug#7543).
-2010-09-18 Glenn Morris <rgm@gnu.org>
+2010-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-file.el (url-file-build-filename): Avoid interpreting
+ file:/foo:/bar URLs via tramp.
+
+2010-10-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-gw.el (url-open-stream): Use open-gnutls-stream if it exists.
+
+2010-10-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-end-of-document-sentinel): Protect against
+ the process buffer being killed.
+
+2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Protect against url-http-response-status for degenerate documents.
+ (url-http-wait-for-headers-change-function): Revert previous
+ change. It lead to really slow loads.
+
+2010-10-03 Glenn Morris <rgm@gnu.org>
+
+ * url-util.el (url-get-url-filename-chars): Don't eval-and-compile.
+ (url-get-url-at-point): Don't use eval-when-compile.
+
+ * url-cache.el (url-cache-create-filename-human-readable)
+ (url-cache-create-filename-using-md5):
+ * url-util.el (url-file-directory, url-file-nondirectory):
+ Don't use eval-when-compile and regexp-quote.
+
+2010-10-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-vars.el (url-mime-charset-string): Change the default to
+ nil to avoid sending 1171 bytes of not very useful data to the
+ HTTP server every request.
+
+2010-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-util.el (url-display-percentage): Don't message when the URL
+ is silent.
+ (url-lazy-message): Ditto.
+ (url-lazy-message): Remove leftover debugging code.
+
+ * url-http.el (url-http-parse-headers): Pass the SILENT parameter
+ back to the fetching function.
+
+ * url.el (url-retrieve): Add a silent parameter.
+ (url-retrieve-internal): Ditto.
+
+ * url-parse.el (url): Add a `silent' slot in the URL struct.
+
+2010-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-cookie.el (url-cookie-handle-set-cookie): Use
+ url-lazy-message for the cookie warning, which isn't very interesting.
+
+ * url-http.el (url-http-async-sentinel): Check that the buffer is
+ still alive before switching to it.
+
+2010-09-25 Julien Danjou <julien@danjou.info>
+
+ * url-cache.el (url-cache-create-filename): Ensure no-port and
+ default-port end up with the same cache file.
+ (url-cache-create-filename-human-readable)
+ (url-cache-create-filename-using-md5): Argument is always in the form of
+ a string now.
+
+2010-09-23 Glenn Morris <rgm@gnu.org>
* url-cache.el (url-is-cached): Doc fix.
-2010-09-11 Julien Danjou <julien@danjou.info>
+2010-09-23 Glenn Morris <rgm@gnu.org>
- * url-cache (url-store-in-cache): Make `buff' argument really optional.
+ * url-cache.el (url-cache-expired): Don't autoload.
+ Tweak previous change.
+ (url-cache-expire-time): Doc fix.
-2010-09-09 Glenn Morris <rgm@gnu.org>
+2010-09-23 Julien Danjou <julien@danjou.info>
+
+ * url-cache.el (url-cache-expire-time): New option.
+ (url-cache-expired): Rewrite.
+
+2010-09-19 Julien Danjou <julien@danjou.info>
+
+ * url-cache.el (url-fetch-from-cache): New function.
+
+2010-09-18 Julien Danjou <julien@danjou.info>
+
+ * url-vars.el (url-cache-expired): Remove unused variable.
+
+2010-09-14 Julien Danjou <julien@danjou.info>
+
+ * url-cache.el (url-store-in-cache):
+ Make `buff' argument really optional.
+
+2010-09-14 Glenn Morris <rgm@gnu.org>
* url-cookie.el (url-cookie-expired-p): Tweak previous change.
-2010-09-09 shawn boles <shawn.boles@gmail.com> (tiny change)
+2010-09-14 shawn boles <shawn.boles@gmail.com> (tiny change)
* url-cookie.el (url-cookie-expired-p): Simplify and fix. (Bug#6957)
-2010-07-26 Michael Albinus <michael.albinus@gmx.de>
+2010-09-11 Glenn Morris <rgm@gnu.org>
+
+ * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el:
+ * url-vars.el: Remove leading `*' from defcustom docs.
- * url-http (url-http-parse-headers): Disable file name handlers at
+2010-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * url-http.el (url-http-parse-headers): Disable file name handlers at
all (not only Tramp). (Bug#6717)
-2010-07-25 Michael Albinus <michael.albinus@gmx.de>
+2010-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * url-http.el (url-http-parse-headers): Disable Tramp. (Bug#6717)
+
+2010-07-01 Mark A. Hershberger <mah@everybody.org>
+
+ * url-http.el (url-http-create-request): Add a CRLF on the end so
+ that POSTs with content to https urls work.
+ See <https://bugs.launchpad.net/mediawiki-el/+bug/540759>
+
+2010-06-22 Mark A. Hershberger <mah@everybody.org>
- * url-http (url-http-parse-headers): Disable Tramp. (Bug#6717)
+ * url-parse.el (url-user-for-url, url-password-for-url):
+ Convenience functions that get usernames and passwords for urls
+ from auth-source functions.
2010-06-12 Štěpán Němec <stepnem@gmail.com> (tiny change)
@@ -40,6 +157,33 @@
* Version 23.2 released.
+2010-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-dired.el (url-dired-minor-mode): Use define-minor-mode.
+
+2010-03-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-http.el (url-http-parse-headers): Fix wrong variable name.
+
+2010-03-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-http.el (url-http-codes): New variable to hold a mapping of
+ HTTP status codes' numbers, their symbolic name, and their text.
+ (url-http-parse-headers): Use it, leaving the original numeric
+ code in a comment.
+
+2010-03-19 Glenn Morris <rgm@gnu.org>
+
+ * url.el: Move mailcap require earlier in the file.
+
+2010-03-12 Chong Yidong <cyd@stupidchicken.com>
+
+ * url-vars.el (url): Put in comm group.
+
+2010-03-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * Branch for 23.2.
+
2010-01-23 Chong Yidong <cyd@stupidchicken.com>
* url-util.el: Require url-vars (Bug#5459).
@@ -77,8 +221,8 @@
2009-09-12 Chong Yidong <cyd@stupidchicken.com>
* url-methods.el (url-scheme--registering-proxy): New variable.
- (url-scheme-register-proxy, url-scheme-get-property): Avoid
- calling url-scheme-register-proxy in an infloop (Bug#4191).
+ (url-scheme-register-proxy, url-scheme-get-property):
+ Avoid calling url-scheme-register-proxy in an infloop (Bug#4191).
2009-08-22 Glenn Morris <rgm@gnu.org>
@@ -211,7 +355,7 @@
2008-03-09 Magnus Henoch <mange@freemail.hu>
* url-http.el (url-http-chunked-encoding-after-change-function):
- Remove superfluous CRLF at end of file. (bug #42)
+ Remove superfluous CRLF at end of file. (Bug #42)
2008-03-02 Andreas Schwab <schwab@suse.de>
@@ -475,8 +619,8 @@
* url-http.el (url-http-proxy): New variable.
(url-http-create-request): Use it. Don't use `url-proxy-object'.
(url-http): Treat `url' argument as resource to download, and
- dynamic variable `url-using-proxy' as proxy to use. Set
- `url-current-object' to actual URL, and `url-http-proxy' to proxy
+ dynamic variable `url-using-proxy' as proxy to use.
+ Set `url-current-object' to actual URL, and `url-http-proxy' to proxy
used.
(url-http-handle-cookies): Assume that `url-current-object' does
not point to the proxy used.
@@ -492,24 +636,24 @@
(url-proxy): Bind it instead of `proxy-object'.
* url-http.el (url-http-create-request): Remove url argument, use
- the buffer-local variable `url-http-target-url' instead. Both
- callers updated. Simplify proxy handling.
+ the buffer-local variable `url-http-target-url' instead.
+ Both callers updated. Simplify proxy handling.
(url-http): Don't make proxy-object buffer local.
* url.el (url-retrieve-internal): Bind url-proxy-object to nil.
2006-11-26 Magnus Henoch <mange@freemail.hu>
- * url-http.el (url-http-wait-for-headers-change-function): Use
- `when' instead of `if' when possible.
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Use `when' instead of `if' when possible.
(url-http): Define url-http-response-version.
(url-http-parse-response): Set it.
(url-http-parse-headers): Use it to determine keep-alive behavior.
2006-11-23 Diane Murray <disumu@x3y2z1.net> (tiny change)
- * url-http.el (url-http-content-length-after-change-function): Use
- `url-lazy-message'.
+ * url-http.el (url-http-content-length-after-change-function):
+ Use `url-lazy-message'.
* url-util.el (url-display-percentage): Only show a message if
`url-show-status' is non-nil.
@@ -891,8 +1035,8 @@
(url-cookie-generate-header-lines): Likewise.
(url-cookie-handle-set-cookie): Likewise.
(url-cookie-create): Expect :localpart instead of :path.
- (url-cookie-localpart): Renamed from url-cookie-path.
- (url-cookie-set-localpart): Renamed from url-cookie-set-path.
+ (url-cookie-localpart): Rename from url-cookie-path.
+ (url-cookie-set-localpart): Rename from url-cookie-set-path.
(url-cookie-file): Doc fix.
(url-cookie-p): Add doc string.
@@ -2109,7 +2253,7 @@
message when we have to contact a host so the user always gets
at least some feedback.
- * lisp/url-expand.el (url-expander-remove-relative-links): Moved and
+ * lisp/url-expand.el (url-expander-remove-relative-links): Move and
renamed function.
(url-default-expander): Use it.
@@ -2231,7 +2375,6 @@
;; Local variables:
;; coding: utf-8
-;; add-log-time-zone-rule: t
;; End:
Copyright (C) 1999, 2001, 2002, 2004, 2005,
@@ -2252,4 +2395,3 @@
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;; arch-tag: ac117078-3091-4533-be93-098162ac2926
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 4e6a64fb99d..be2931e090a 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -28,10 +28,17 @@
(defcustom url-cache-directory
(expand-file-name "cache" url-configuration-directory)
- "*The directory where cache files should be stored."
+ "The directory where cache files should be stored."
:type 'directory
:group 'url-file)
+(defcustom url-cache-expire-time 3600
+ "Default maximum time in seconds before cache files expire.
+Used by the function `url-cache-expired'."
+ :version "24.1"
+ :type 'integer
+ :group 'url-cache)
+
;; Cache manager
(defun url-cache-file-writable-p (file)
"Follows the documentation of `file-writable-p', unlike `file-writable-p'."
@@ -68,6 +75,12 @@ FILE can be created or overwritten."
(let ((coding-system-for-write 'binary))
(write-region (point-min) (point-max) fname nil 5))))))
+(defun url-fetch-from-cache (url)
+ "Fetch URL from cache and return a buffer with the content."
+ (with-current-buffer (generate-new-buffer " *temp*")
+ (url-cache-extract (url-cache-create-filename url))
+ (current-buffer)))
+
;;;###autoload
(defun url-is-cached (url)
"Return non-nil if the URL is cached.
@@ -82,8 +95,7 @@ The actual return value is the last modification time of the cache file."
(defun url-cache-create-filename-human-readable (url)
"Return a filename in the local cache for URL."
(if url
- (let* ((url (if (vectorp url) (url-recreate-url url) url))
- (urlobj (url-generic-parse-url url))
+ (let* ((urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
(host-components
@@ -91,8 +103,7 @@ The actual return value is the last modification time of the cache file."
(user-real-login-name)
(cons (or protocol "file")
(reverse (split-string (or hostname "localhost")
- (eval-when-compile
- (regexp-quote ".")))))))
+ "\\.")))))
(fname (url-filename urlobj)))
(if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
(setq fname (substring fname 1 nil)))
@@ -141,8 +152,7 @@ The actual return value is the last modification time of the cache file."
Very fast if you have an `md5' primitive function, suitably fast otherwise."
(require 'md5)
(if url
- (let* ((url (if (vectorp url) (url-recreate-url url) url))
- (checksum (md5 url))
+ (let* ((checksum (md5 url))
(urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
@@ -153,8 +163,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
(nreverse
(delq nil
(split-string (or hostname "localhost")
- (eval-when-compile
- (regexp-quote "."))))))))
+ "\\."))))))
(fname (url-filename urlobj)))
(and fname
(expand-file-name checksum
@@ -163,7 +172,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
url-cache-directory))))))
(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
- "*What function to use to create a cached filename."
+ "What function to use to create a cached filename."
:type '(choice (const :tag "MD5 of filename (low collision rate)"
:value url-cache-create-filename-using-md5)
(const :tag "Human readable filenames (higher collision rate)"
@@ -172,7 +181,13 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
:group 'url-cache)
(defun url-cache-create-filename (url)
- (funcall url-cache-creation-function url))
+ (funcall url-cache-creation-function
+ ;; We need to parse+recreate in order to remove the default port
+ ;; if it has been specified: e.g. http://www.example.com:80 will
+ ;; be transcoded as http://www.example.com
+ (url-recreate-url
+ (if (vectorp url) url
+ (url-generic-parse-url url)))))
;;;###autoload
(defun url-cache-extract (fnam)
@@ -180,22 +195,19 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
(erase-buffer)
(insert-file-contents-literally fnam))
-;;;###autoload
-(defun url-cache-expired (url mod)
- "Return t if a cached file has expired."
- (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
- (type (url-type urlobj)))
- (cond
- (url-standalone-mode
- (not (file-exists-p (url-cache-create-filename url))))
- ((string= type "http")
- t)
- ((member type '("file" "ftp"))
- (if (or (equal mod '(0 0)) (not mod))
- t
- (or (> (nth 0 mod) (nth 0 (current-time)))
- (> (nth 1 mod) (nth 1 (current-time))))))
- (t nil))))
+(defun url-cache-expired (url &optional expire-time)
+ "Return non-nil if a cached URL is older than EXPIRE-TIME seconds.
+The default value of EXPIRE-TIME is `url-cache-expire-time'.
+If `url-standalone-mode' is non-nil, cached items never expire."
+ (if url-standalone-mode
+ (not (file-exists-p (url-cache-create-filename url)))
+ (let ((cache-time (url-is-cached url)))
+ (or (not cache-time)
+ (time-less-p
+ (time-add
+ cache-time
+ (seconds-to-time (or expire-time url-cache-expire-time)))
+ (current-time))))))
(provide 'url-cache)
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 607f4da3d09..c373ef6f66a 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,4 +1,4 @@
-;;; url-cookie.el --- Netscape Cookie support
+;;; url-cookie.el --- URL cookie support
;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010, 2011 Free Software Foundation, Inc.
@@ -26,10 +26,8 @@
(require 'url-util)
(require 'url-parse)
-(eval-when-compile (require 'cl))
-;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
-;; 'open standard' defining this crap.
+(eval-when-compile (require 'cl)) ; defstruct
(defgroup url-cookie nil
"URL cookies."
@@ -76,41 +74,23 @@ telling Microsoft that."
"Whether the cookies list has changed since the last save operation.")
(defun url-cookie-parse-file (&optional fname)
- (setq fname (or fname url-cookie-file))
- (condition-case ()
- (load fname nil t)
- (error
- ;; It's completely normal for the cookies file not to exist yet.
- ;; (message "Could not load cookie file %s" fname)
- )))
+ "Load FNAME, default `url-cookie-file'."
+ ;; It's completely normal for the cookies file not to exist yet.
+ (load (or fname url-cookie-file) t t))
(declare-function url-cookie-p "url-cookie" t t) ; defstruct
(defun url-cookie-clean-up (&optional secure)
- (let* (
- (var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
- (val (symbol-value var))
- (cur nil)
- (new nil)
- (cookies nil)
- (cur-cookie nil)
- (new-cookies nil)
- )
- (while val
- (setq cur (car val)
- val (cdr val)
- new-cookies nil
- cookies (cdr cur))
- (while cookies
- (setq cur-cookie (car cookies)
- cookies (cdr cookies))
- (if (or (not (url-cookie-p cur-cookie))
- (url-cookie-expired-p cur-cookie)
- (null (url-cookie-expires cur-cookie)))
- nil
- (setq new-cookies (cons cur-cookie new-cookies))))
- (if (not new-cookies)
- nil
+ (let ((var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
+ new new-cookies)
+ (dolist (cur (symbol-value var))
+ (setq new-cookies nil)
+ (dolist (cur-cookie (cdr cur))
+ (or (not (url-cookie-p cur-cookie))
+ (url-cookie-expired-p cur-cookie)
+ (null (url-cookie-expires cur-cookie))
+ (setq new-cookies (cons cur-cookie new-cookies))))
+ (when new-cookies
(setcdr cur new-cookies)
(setq new (cons cur new))))
(set var new)))
@@ -143,54 +123,42 @@ telling Microsoft that."
(setq url-cookies-changed-since-last-save nil))))
(defun url-cookie-store (name value &optional expires domain localpart secure)
- "Store a netscape-style cookie."
- (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
- (tmp storage)
- (cur nil)
- (found-domain nil))
-
- ;; First, look for a matching domain
- (setq found-domain (assoc domain storage))
-
- (if found-domain
+ "Store a cookie."
+ (let ((storage (if secure url-cookie-secure-storage url-cookie-storage))
+ tmp found-domain)
+ ;; First, look for a matching domain.
+ (if (setq found-domain (assoc domain storage))
;; Need to either stick the new cookie in existing domain storage
;; or possibly replace an existing cookie if the names match.
- (progn
- (setq storage (cdr found-domain)
- tmp nil)
- (while storage
- (setq cur (car storage)
- storage (cdr storage))
- (if (and (equal localpart (url-cookie-localpart cur))
- (equal name (url-cookie-name cur)))
- (progn
- (setf (url-cookie-expires cur) expires)
- (setf (url-cookie-value cur) value)
- (setq tmp t))))
- (if (not tmp)
- ;; New cookie
- (setcdr found-domain (cons
- (url-cookie-create :name name
- :value value
- :expires expires
- :domain domain
- :localpart localpart
- :secure secure)
- (cdr found-domain)))))
- ;; Need to add a new top-level domain
+ (unless (dolist (cur (setq storage (cdr found-domain)) tmp)
+ (and (equal localpart (url-cookie-localpart cur))
+ (equal name (url-cookie-name cur))
+ (progn
+ (setf (url-cookie-expires cur) expires)
+ (setf (url-cookie-value cur) value)
+ (setq tmp t))))
+ ;; New cookie.
+ (setcdr found-domain (cons
+ (url-cookie-create :name name
+ :value value
+ :expires expires
+ :domain domain
+ :localpart localpart
+ :secure secure)
+ (cdr found-domain))))
+ ;; Need to add a new top-level domain.
(setq tmp (url-cookie-create :name name
:value value
:expires expires
:domain domain
:localpart localpart
:secure secure))
- (cond
- (storage
- (setcdr storage (cons (list domain tmp) (cdr storage))))
- (secure
- (setq url-cookie-secure-storage (list (list domain tmp))))
- (t
- (setq url-cookie-storage (list (list domain tmp))))))))
+ (cond (storage
+ (setcdr storage (cons (list domain tmp) (cdr storage))))
+ (secure
+ (setq url-cookie-secure-storage (list (list domain tmp))))
+ (t
+ (setq url-cookie-storage (list (list domain tmp))))))))
(defun url-cookie-expired-p (cookie)
"Return non-nil if COOKIE is expired."
@@ -203,14 +171,9 @@ telling Microsoft that."
(append url-cookie-secure-storage url-cookie-storage)
url-cookie-storage))
(case-fold-search t)
- (cookies nil)
- (cur nil)
- (retval nil)
- (localpart-match nil))
- (while storage
- (setq cur (car storage)
- storage (cdr storage)
- cookies (cdr cur))
+ cookies retval localpart-match)
+ (dolist (cur storage)
+ (setq cookies (cdr cur))
(if (and (car cur)
(string-match
(concat "^.*"
@@ -222,36 +185,28 @@ telling Microsoft that."
(car cur)))
"$") host))
;; The domains match - a possible hit!
- (while cookies
- (setq cur (car cookies)
- cookies (cdr cookies)
- localpart-match (url-cookie-localpart cur))
- (if (and (if (and (stringp localpart-match)
- (stringp localpart))
- (string-match (concat "^" (regexp-quote
- localpart-match))
- localpart)
- (equal localpart localpart-match))
- (not (url-cookie-expired-p cur)))
- (setq retval (cons cur retval))))))
+ (dolist (cur cookies)
+ (and (if (and (stringp
+ (setq localpart-match (url-cookie-localpart cur)))
+ (stringp localpart))
+ (string-match (concat "^" (regexp-quote localpart-match))
+ localpart)
+ (equal localpart localpart-match))
+ (not (url-cookie-expired-p cur))
+ (setq retval (cons cur retval))))))
retval))
(defun url-cookie-generate-header-lines (host localpart secure)
- (let* ((cookies (url-cookie-retrieve host localpart secure))
- (retval nil)
- (cur nil)
- (chunk nil))
- ;; Have to sort this for sending most specific cookies first
+ (let ((cookies (url-cookie-retrieve host localpart secure))
+ retval chunk)
+ ;; Have to sort this for sending most specific cookies first.
(setq cookies (and cookies
(sort cookies
- (function
- (lambda (x y)
- (> (length (url-cookie-localpart x))
- (length (url-cookie-localpart y))))))))
- (while cookies
- (setq cur (car cookies)
- cookies (cdr cookies)
- chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
+ (lambda (x y)
+ (> (length (url-cookie-localpart x))
+ (length (url-cookie-localpart y)))))))
+ (dolist (cur cookies)
+ (setq chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
retval (if (and url-cookie-multiple-line
(< 80 (+ (length retval) (length chunk) 4)))
(concat retval "\r\nCookie: " chunk)
@@ -321,40 +276,38 @@ telling Microsoft that."
(file-name-directory
(url-filename url-current-object))))
(rest nil))
- (while args
- (if (not (member (downcase (car (car args)))
- '("secure" "domain" "expires" "path")))
- (setq rest (cons (car args) rest)))
- (setq args (cdr args)))
+ (dolist (this args)
+ (or (member (downcase (car this)) '("secure" "domain" "expires" "path"))
+ (setq rest (cons this rest))))
;; Sometimes we get dates that the timezone package cannot handle very
;; gracefully - take care of this here, instead of in url-cookie-expired-p
;; to speed things up.
- (if (and expires
- (string-match
- (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
- "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
- expires))
- (setq expires (concat (match-string 1 expires) " "
- (match-string 2 expires) " "
- (match-string 3 expires) " "
- (match-string 4 expires) " ["
- (match-string 5 expires) "]")))
+ (and expires
+ (string-match
+ (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
+ "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
+ expires)
+ (setq expires (concat (match-string 1 expires) " "
+ (match-string 2 expires) " "
+ (match-string 3 expires) " "
+ (match-string 4 expires) " ["
+ (match-string 5 expires) "]")))
;; This one is for older Emacs/XEmacs variants that don't
;; understand this format without tenths of a second in it.
;; Wednesday, 30-Dec-2037 16:00:00 GMT
;; - vs -
;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
- (if (and expires
- (string-match
- "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
- expires))
- (setq expires (concat (match-string 1 expires) "-" ; day
- (match-string 2 expires) "-" ; month
- (match-string 3 expires) " " ; year
- (match-string 4 expires) ".00 " ; hour:minutes:seconds
- (match-string 6 expires)))) ":" ; timezone
+ (and expires
+ (string-match
+ "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
+ expires)
+ (setq expires (concat (match-string 1 expires) "-" ; day
+ (match-string 2 expires) "-" ; month
+ (match-string 3 expires) " " ; year
+ (match-string 4 expires) ".00 " ; hour:minutes:seconds
+ (match-string 6 expires)))) ":" ; timezone
(while (consp trusted)
(if (string-match (car trusted) current-url)
@@ -364,45 +317,39 @@ telling Microsoft that."
(if (string-match (car untrusted) current-url)
(setq untrusted (- (match-end 0) (match-beginning 0)))
(pop untrusted)))
- (if (and trusted untrusted)
- ;; Choose the more specific match
- (if (> trusted untrusted)
- (setq untrusted nil)
- (setq trusted nil)))
+ (and trusted untrusted
+ ;; Choose the more specific match.
+ (set (if (> trusted untrusted) 'untrusted 'trusted) nil))
(cond
(untrusted
- ;; The site was explicity marked as untrusted by the user
+ ;; The site was explicity marked as untrusted by the user.
nil)
((or (eq url-privacy-level 'paranoid)
(and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
- ;; user never wants cookies
+ ;; User never wants cookies.
nil)
((and url-cookie-confirmation
(not trusted)
(save-window-excursion
(with-output-to-temp-buffer "*Cookie Warning*"
(mapcar
- (function
- (lambda (x)
- (princ (format "%s - %s" (car x) (cdr x))))) rest))
+ (lambda (x)
+ (princ (format "%s - %s" (car x) (cdr x)))) rest))
(prog1
(not (funcall url-confirmation-func
(format "Allow %s to set these cookies? "
(url-host url-current-object))))
(if (get-buffer "*Cookie Warning*")
(kill-buffer "*Cookie Warning*")))))
- ;; user wants to be asked, and declined.
+ ;; User wants to be asked, and declined.
nil)
((url-cookie-host-can-set-p (url-host url-current-object) domain)
- ;; Cookie is accepted by the user, and passes our security checks
- (let ((cur nil))
- (while rest
- (setq cur (pop rest))
- (url-cookie-store (car cur) (cdr cur)
- expires domain localpart secure))))
+ ;; Cookie is accepted by the user, and passes our security checks.
+ (dolist (cur rest)
+ (url-cookie-store (car cur) (cdr cur) expires domain localpart secure)))
(t
- (message "%s tried to set a cookie for domain %s - rejected."
- (url-host url-current-object) domain)))))
+ (url-lazy-message "%s tried to set a cookie for domain %s - rejected."
+ (url-host url-current-object) domain)))))
(defvar url-cookie-timer nil)
@@ -430,5 +377,4 @@ to run the `url-cookie-setup-save-timer' function manually."
(provide 'url-cookie)
-;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7
;;; url-cookie.el ends here
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index 73c8a3b265f..17c056fbe5f 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -31,11 +31,6 @@
map)
"Keymap used when browsing directories.")
-(defvar url-dired-minor-mode nil
- "Whether we are in url-dired-minor-mode.")
-
-(make-variable-buffer-local 'url-dired-minor-mode)
-
(defun url-dired-find-file ()
"In dired, visit the file or directory named on this line."
(interactive)
@@ -48,39 +43,9 @@
(mouse-set-point event)
(url-dired-find-file))
-(defun url-dired-minor-mode (&optional arg)
+(define-minor-mode url-dired-minor-mode
"Minor mode for directory browsing."
- (interactive "P")
- (cond
- ((null arg)
- (setq url-dired-minor-mode (not url-dired-minor-mode)))
- ((equal 0 arg)
- (setq url-dired-minor-mode nil))
- (t
- (setq url-dired-minor-mode t))))
-
-(if (not (fboundp 'add-minor-mode))
- (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
- "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
-TOGGLE is a symbol which is used as the variable which toggle the minor mode,
-NAME is the name that should appear in the modeline (it should be a string
-beginning with a space), KEYMAP is a keymap to make active when the minor
-mode is active, and AFTER is the toggling symbol used for another minor
-mode. If AFTER is non-nil, then it is used to position the new mode in the
-minor-mode alists. TOGGLE-FUN specifies an interactive function that
-is called to toggle the mode on and off; this affects what appens when
-button2 is pressed on the mode, and when button3 is pressed somewhere
-in the list of modes. If TOGGLE-FUN is nil and TOGGLE names an
-interactive function, TOGGLE is used as the toggle function.
-
-Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
- (if (not (assq toggle minor-mode-alist))
- (setq minor-mode-alist (cons (list toggle name) minor-mode-alist)))
- (if (and keymap (not (assq toggle minor-mode-map-alist)))
- (setq minor-mode-map-alist (cons (cons toggle keymap)
- minor-mode-map-alist)))))
-
-(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
+ :lighter " URL" :keymap url-dired-minor-mode-map)
(defun url-find-file-dired (dir)
"\"Edit\" directory DIR, but with additional URL-friendly bindings."
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 319f62f3a1a..28917fb08a5 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -103,12 +103,19 @@ to them."
(format "%s#%d" host port))
host))
(file (url-unhex-string (url-filename url)))
- (filename (if (or user (not (url-file-host-is-local-p host)))
- (concat "/" (or user "anonymous") "@" site ":" file)
- (if (and (memq system-type '(ms-dos windows-nt))
- (string-match "^/[a-zA-Z]:/" file))
- (substring file 1)
- file)))
+ (filename (cond
+ ;; ftp: URL.
+ ((or user (not (url-file-host-is-local-p host)))
+ (concat "/" (or user "anonymous") "@" site ":" file))
+ ;; file: URL on Windows.
+ ((and (string-match "\\`/[a-zA-Z]:/" file)
+ (memq system-type '(ms-dos windows-nt)))
+ (substring file 1))
+ ;; file: URL with a file:/bar:/foo-like spec.
+ ((string-match "\\`/[^/]+:/" file)
+ (concat "/:" file))
+ (t
+ file)))
pos-index)
(and user pass
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 8448647879d..7d3427743b3 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -37,50 +37,50 @@
:group 'url)
(defcustom url-gateway-local-host-regexp nil
- "*A regular expression specifying local hostnames/machines."
+ "A regular expression specifying local hostnames/machines."
:type '(choice (const nil) regexp)
:group 'url-gateway)
(defcustom url-gateway-prompt-pattern
"^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
- "*A regular expression matching a shell prompt."
+ "A regular expression matching a shell prompt."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-rlogin-host nil
- "*What hostname to actually rlog into before doing a telnet."
+ "What hostname to actually rlog into before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-user-name nil
- "*Username to log into the remote machine with when using rlogin."
+ "Username to log into the remote machine with when using rlogin."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
- "*Parameters to `url-open-rlogin'.
+ "Parameters to `url-open-rlogin'.
This list will be used as the parameter list given to rsh."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-host nil
- "*What hostname to actually login to before doing a telnet."
+ "What hostname to actually login to before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
- "*Parameters to `url-open-telnet'.
+ "Parameters to `url-open-telnet'.
This list will be executed as a command after logging in via telnet."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
- "*Prompt that tells us we should send our username when loggin in w/telnet."
+ "Prompt that tells us we should send our username when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
- "*Prompt that tells us we should send our password when loggin in w/telnet."
+ "Prompt that tells us we should send our password when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
@@ -95,7 +95,7 @@ This list will be executed as a command after logging in via telnet."
:group 'url-gateway)
(defcustom url-gateway-broken-resolution nil
- "*Whether to use nslookup to resolve hostnames.
+ "Whether to use nslookup to resolve hostnames.
This should be used when your version of Emacs cannot correctly use DNS,
but your machine can. This usually happens if you are running a statically
linked Emacs under SunOS 4.x."
@@ -103,7 +103,7 @@ linked Emacs under SunOS 4.x."
:group 'url-gateway)
(defcustom url-gateway-nslookup-program "nslookup"
- "*If non-nil then a string naming nslookup program."
+ "If non-nil then a string naming nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'url-gateway)
@@ -245,7 +245,10 @@ Might do a non-blocking connection; use `process-status' to check."
(coding-system-for-write 'binary))
(setq conn (case gw-method
(tls
- (open-tls-stream name buffer host service))
+ (funcall (if (fboundp 'open-gnutls-stream)
+ 'open-gnutls-stream
+ 'open-tls-stream)
+ name buffer host service))
(ssl
(open-ssl-stream name buffer host service))
((native)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 8a5b97b43a8..9e933332e31 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -35,7 +35,7 @@
:group 'url)
(defcustom url-history-track nil
- "*Controls whether to keep a list of all the URLs being visited.
+ "Controls whether to keep a list of all the URLs being visited.
If non-nil, the URL package will keep track of all the URLs visited.
If set to t, then the list is saved to disk at the end of each Emacs
session."
@@ -49,14 +49,14 @@ session."
:group 'url-history)
(defcustom url-history-file nil
- "*The global history file for the URL package.
+ "The global history file for the URL package.
This file contains a list of all the URLs you have visited. This file
is parsed at startup and used to provide URL completion."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-history)
(defcustom url-history-save-interval 3600
- "*The number of seconds between automatic saves of the history list.
+ "The number of seconds between automatic saves of the history list.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index a6652987966..f1b687cfca2 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -64,6 +64,55 @@ This is only useful when debugging the HTTP subsystem. Setting to
nil will explicitly close the connection to the server after every
request.")
+(defconst url-http-codes
+ '((100 continue "Continue with request")
+ (101 switching-protocols "Switching protocols")
+ (102 processing "Processing (Added by DAV)")
+ (200 OK "OK")
+ (201 created "Created")
+ (202 accepted "Accepted")
+ (203 non-authoritative "Non-authoritative information")
+ (204 no-content "No content")
+ (205 reset-content "Reset content")
+ (206 partial-content "Partial content")
+ (207 multi-status "Multi-status (Added by DAV)")
+ (300 multiple-choices "Multiple choices")
+ (301 moved-permanently "Moved permanently")
+ (302 found "Found")
+ (303 see-other "See other")
+ (304 not-modified "Not modified")
+ (305 use-proxy "Use proxy")
+ (307 temporary-redirect "Temporary redirect")
+ (400 bad-request "Bad Request")
+ (401 unauthorized "Unauthorized")
+ (402 payment-required "Payment required")
+ (403 forbidden "Forbidden")
+ (404 not-found "Not found")
+ (405 method-not-allowed "Method not allowed")
+ (406 not-acceptable "Not acceptable")
+ (407 proxy-authentication-required "Proxy authentication required")
+ (408 request-timeout "Request time-out")
+ (409 conflict "Conflict")
+ (410 gone "Gone")
+ (411 length-required "Length required")
+ (412 precondition-failed "Precondition failed")
+ (413 request-entity-too-large "Request entity too large")
+ (414 request-uri-too-large "Request-URI too large")
+ (415 unsupported-media-type "Unsupported media type")
+ (416 requested-range-not-satisfiable "Requested range not satisfiable")
+ (417 expectation-failed "Expectation failed")
+ (422 unprocessable-entity "Unprocessable Entity (Added by DAV)")
+ (423 locked "Locked")
+ (424 failed-Dependency "Failed Dependency")
+ (500 internal-server-error "Internal server error")
+ (501 not-implemented "Not implemented")
+ (502 bad-gateway "Bad gateway")
+ (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."))
+
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
;; when the file is byte-compiled.
@@ -290,7 +339,7 @@ request.")
;; End request
"\r\n"
;; Any data
- url-http-data))
+ url-http-data "\r\n"))
""))
(url-http-debug "Request is: \n%s" request)
request))
@@ -436,6 +485,8 @@ should be shown to the user."
(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)))
;; The filename part of a URL could be in remote file syntax,
;; see Bug#6717 for an example. We disable file name
;; handlers, therefore.
@@ -467,8 +518,8 @@ should be shown to the user."
;; 205 Reset content
;; 206 Partial content
;; 207 Multi-status (Added by DAV)
- (case url-http-response-status
- ((204 205)
+ (case status-symbol
+ ((no-content reset-content)
;; No new data, just stay at the same document
(url-mark-buffer-as-dead buffer)
(setq success t))
@@ -489,8 +540,8 @@ should be shown to the user."
;; 307 Temporary redirect
(let ((redirect-uri (or (mail-fetch-field "Location")
(mail-fetch-field "URI"))))
- (case url-http-response-status
- (300
+ (case status-symbol
+ (multiple-choices ; 300
;; Quoth the spec (section 10.3.1)
;; -------------------------------
;; The requested resource corresponds to any one of a set of
@@ -507,7 +558,7 @@ should be shown to the user."
;; We do not support agent-driven negotiation, so we just
;; redirect to the preferred URI if one is provided.
nil)
- ((301 302 307)
+ ((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
@@ -523,20 +574,20 @@ should be shown to the user."
url-http-method url-http-response-status)
(setq url-http-method "GET"
url-http-data nil)))
- (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))
- (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))
- (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
@@ -592,7 +643,8 @@ should be shown to the user."
(set (make-local-variable 'url-redirect-buffer)
(url-retrieve-internal
redirect-uri url-callback-function
- url-callback-arguments))
+ url-callback-arguments
+ (url-silent url-current-object)))
(url-mark-buffer-as-dead buffer))
;; We hit url-max-redirections, so issue an error and
;; stop redirecting.
@@ -624,51 +676,51 @@ should be shown to the user."
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
- (case url-http-response-status
- (401
+ (case 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))
- (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"))
- (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))
- (404
+ (not-found ; 404
;; Not found
(setq success t))
- (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))
- (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
;; headers sent in the request.
(setq success t))
- (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))
- (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))
- (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
@@ -677,11 +729,11 @@ should be shown to the user."
;; information for the user to recognize the source of the
;; conflict.
(setq success t))
- (410
+ (gone ; 410
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
(setq success t))
- (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
@@ -691,29 +743,29 @@ should be shown to the user."
;; `url-http-create-request' automatically calculates the
;; content-length.
(setq success t))
- (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))
- ((413 414)
+ ((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))
- (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))
- (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))
- (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
@@ -740,16 +792,16 @@ should be shown to the user."
;; 507 Insufficient storage
(setq success t)
(case url-http-response-status
- (501
+ (not-implemented ; 501
;; The server does not support the functionality required to
;; fulfill the request.
nil)
- (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)
- (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
@@ -758,19 +810,19 @@ should be shown to the user."
;; header. If no Retry-After is given, the client SHOULD
;; handle the response as it would for a 500 response.
nil)
- (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)
- (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)
- (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
@@ -822,13 +874,14 @@ should be shown to the user."
(url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
(process-buffer proc))
(url-http-idle-sentinel proc why)
- (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)))))
+ (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))))))
(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
@@ -1193,20 +1246,21 @@ CBARGS as the arguments."
(declare (special url-callback-arguments))
;; We are performing an asynchronous connection, and a status change
;; has occurred.
- (with-current-buffer (process-buffer proc)
- (cond
- (url-http-connection-opened
- (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)))
- (t
- (setf (car url-callback-arguments)
- (nconc (list :error (list 'error 'connection-failed why
- :host (url-host (or url-http-proxy url-current-object))
- :service (url-port (or url-http-proxy url-current-object))))
- (car url-callback-arguments)))
- (url-http-activate-callback)))))
+ (when (buffer-name (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (cond
+ (url-http-connection-opened
+ (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)))
+ (t
+ (setf (car url-callback-arguments)
+ (nconc (list :error (list 'error 'connection-failed why
+ :host (url-host (or url-http-proxy url-current-object))
+ :service (url-port (or url-http-proxy 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
@@ -1214,6 +1268,7 @@ CBARGS as the arguments."
;; the data ourselves. This is slightly less efficient, but there
;; were tons of weird ways the after-change code was biting us in the
;; shorts.
+;; FIXME this can probably be simplified since the above is no longer true.
(defun url-http-generic-filter (proc data)
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 3c7377aedcd..5270aab7b4c 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -22,7 +22,8 @@
;;; Commentary:
-;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+;; IRC URLs are defined in
+;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;;; Code:
@@ -32,7 +33,7 @@
(defconst url-irc-default-port 6667 "Default port for IRC connections.")
(defcustom url-irc-function 'url-irc-rcirc
- "*Function to actually open an IRC connection.
+ "Function to actually open an IRC connection.
The function should take the following arguments:
HOST - the hostname of the IRC server to contact
PORT - the port number of the IRC server to contact
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index ee1df01e14a..2ac7685c6cc 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -25,6 +25,7 @@
;;; Code:
(require 'url-vars)
+(require 'auth-source)
(eval-when-compile (require 'cl))
(autoload 'url-scheme-get-property "url-methods")
@@ -35,7 +36,7 @@
(&optional type user password host portspec filename
target attributes fullness))
(:copier nil))
- type user password host portspec filename target attributes fullness)
+ type user password host portspec filename target attributes fullness silent)
(defsubst url-port (urlobj)
(or (url-portspec urlobj)
@@ -174,6 +175,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
(url-parse-make-urlobj
prot user pass host port file refs attr full)))))))
+(defmacro url-bit-for-url (method lookfor url)
+ `(let* ((urlobj (url-generic-parse-url url))
+ (bit (funcall ,method urlobj))
+ (methods (list 'url-recreate-url
+ 'url-host)))
+ (while (and (not bit) (> (length methods) 0))
+ (setq bit
+ (auth-source-user-or-password
+ ,lookfor (funcall (pop methods) urlobj) (url-type urlobj))))
+ bit))
+
+(defun url-user-for-url (url)
+ "Attempt to use .authinfo to find a user for this URL."
+ (url-bit-for-url 'url-user "login" url))
+
+(defun url-password-for-url (url)
+ "Attempt to use .authinfo to find a password for this URL."
+ (url-bit-for-url 'url-password "password" url))
+
(provide 'url-parse)
;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index d63fc3e2838..cce153bdb6b 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -43,7 +43,7 @@
;;;###autoload
(defcustom url-debug nil
- "*What types of debug messages from the URL library to show.
+ "What types of debug messages from the URL library to show.
Debug messages are logged to the *URL-DEBUG* buffer.
If t, all messages will be logged.
@@ -177,7 +177,9 @@ Strips out default port numbers, etc."
(defun url-lazy-message (&rest args)
"Just like `message', but is a no-op if called more than once a second.
Will not do anything if `url-show-status' is nil."
- (if (or (null url-show-status)
+ (if (or (and url-current-object
+ (url-silent url-current-object))
+ (null url-show-status)
(active-minibuffer-window)
(= url-lazy-message-time
(setq url-lazy-message-time (nth 1 (current-time)))))
@@ -222,7 +224,9 @@ Will not do anything if `url-show-status' is nil."
;;;###autoload
(defun url-display-percentage (fmt perc &rest args)
- (when url-show-status
+ (when (and url-show-status
+ (or (null url-current-object)
+ (not (url-silent url-current-object))))
(if (null fmt)
(if (fboundp 'clear-progress-display)
(clear-progress-display))
@@ -244,7 +248,7 @@ Will not do anything if `url-show-status' is nil."
"Return the directory part of FILE, for a URL."
(cond
((null file) "")
- ((string-match (eval-when-compile (regexp-quote "?")) file)
+ ((string-match "\\?" file)
(file-name-directory (substring file 0 (match-beginning 0))))
(t (file-name-directory file))))
@@ -253,7 +257,7 @@ Will not do anything if `url-show-status' is nil."
"Return the nondirectory part of FILE, for a URL."
(cond
((null file) "")
- ((string-match (eval-when-compile (regexp-quote "?")) file)
+ ((string-match "\\?" file)
(file-name-nondirectory (substring file 0 (match-beginning 0))))
(t (file-name-nondirectory file))))
@@ -432,10 +436,8 @@ This uses `url-current-object', set locally to the buffer."
(url-recreate-url url-current-object)
(message "%s" (url-recreate-url url-current-object)))))
-(eval-and-compile
- (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
- "Valid characters in a URL.")
- )
+(defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
+ "Valid characters in a URL.")
(defun url-get-url-at-point (&optional pt)
"Get the URL closest to point, but don't change position.
@@ -453,8 +455,7 @@ Has a preference for looking backward when not directly on a symbol."
(if (not (bobp))
(backward-char 1)))))
(if (and (char-after (point))
- (string-match (eval-when-compile
- (concat "[" url-get-url-filename-chars "]"))
+ (string-match (concat "[" url-get-url-filename-chars "]")
(char-to-string (char-after (point)))))
(progn
(skip-chars-backward url-get-url-filename-chars)
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 4732a57a069..f64ef38b8de 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -30,7 +30,7 @@
(defgroup url nil
"Uniform Resource Locator tool."
:version "22.1"
- :group 'hypermedia)
+ :group 'comm)
(defgroup url-file nil
"URL storage."
@@ -68,7 +68,7 @@
))
(defcustom url-honor-refresh-requests t
- "*Whether to do automatic page reloads.
+ "Whether to do automatic page reloads.
These are done at the request of the document author or the server via
the `Refresh' header in an HTTP response. If nil, no refresh
requests will be honored. If t, all refresh requests will be honored.
@@ -79,31 +79,22 @@ If non-nil and not t, the user will be asked for each refresh request."
:group 'url-hairy)
(defcustom url-automatic-caching nil
- "*If non-nil, all documents will be automatically cached to the local disk."
+ "If non-nil, all documents will be automatically cached to the local disk."
:type 'boolean
:group 'url-cache)
-;; Fixme: sanitize this.
-(defcustom url-cache-expired
- (lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
- "*A function determining if a cached item has expired.
-It takes two times (numbers) as its arguments, and returns non-nil if
-the second time is 'too old' when compared to the first time."
- :type 'function
- :group 'url-cache)
-
(defconst url-bug-address "bug-gnu-emacs@gnu.org"
"Where to send bug reports.")
(defcustom url-personal-mail-address nil
- "*Your full email address.
+ "Your full email address.
This is what is sent to HTTP servers as the FROM field in an HTTP
request."
:type '(choice (const :tag "Unspecified" nil) string)
:group 'url)
(defcustom url-directory-index-file "index.html"
- "*The filename to look for when indexing a directory.
+ "The filename to look for when indexing a directory.
If this file exists, and is readable, then it will be viewed instead of
using `dired' to view the directory."
:type 'string
@@ -166,14 +157,14 @@ variable."
(".hqx" . "x-hqx")
(".Z" . "x-compress")
(".bz2" . "x-bzip2"))
- "*An alist of file extensions and appropriate content-transfer-encodings."
+ "An alist of file extensions and appropriate content-transfer-encodings."
:type '(repeat (cons :format "%v"
(string :tag "Extension")
(string :tag "Encoding")))
:group 'url-mime)
(defcustom url-mail-command 'compose-mail
- "*This function will be called whenever URL needs to send mail.
+ "This function will be called whenever URL needs to send mail.
It should enter a mail-mode-like buffer in the current window.
The commands `mail-to' and `mail-subject' should still work in this
buffer, and it should use `mail-header-separator' if possible."
@@ -181,7 +172,7 @@ buffer, and it should use `mail-header-separator' if possible."
:group 'url)
(defcustom url-proxy-services nil
- "*An alist of schemes and proxy servers that gateway them.
+ "An alist of schemes and proxy servers that gateway them.
Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up
from the ACCESS_proxy environment variables."
:type '(repeat (cons :format "%v"
@@ -190,7 +181,7 @@ from the ACCESS_proxy environment variables."
:group 'url)
(defcustom url-standalone-mode nil
- "*Rely solely on the cache?"
+ "Rely solely on the cache?"
:type 'boolean
:group 'url-cache)
@@ -202,7 +193,7 @@ from the ACCESS_proxy environment variables."
(defcustom url-bad-port-list
'("25" "119" "19")
- "*List of ports to warn the user about connecting to.
+ "List of ports to warn the user about connecting to.
Defaults to just the mail, chargen, and NNTP ports so you cannot be
tricked into sending fake mail or forging messages by a malicious HTML
document."
@@ -243,7 +234,7 @@ Generated according to current coding system priorities."
(mapconcat 'symbol-name ordered ";q=0.5, ")
";q=0.5"))))
-(defvar url-mime-charset-string (url-mime-charset-string)
+(defvar url-mime-charset-string nil
"*String to send in the Accept-charset: field in HTTP requests.
The MIME charset corresponding to the most preferred coding system is
given priority 1 and the rest are given priority 0.5.")
@@ -255,7 +246,7 @@ given priority 1 and the rest are given priority 0.5.")
;; Fixme: set from the locale.
(defcustom url-mime-language-string nil
- "*String to send in the Accept-language: field in HTTP requests.
+ "String to send in the Accept-language: field in HTTP requests.
Specifies the preferred language when servers can serve documents in
several languages. Use RFC 1766 abbreviations, e.g.: `en' for
@@ -284,20 +275,20 @@ get the first available language (as opposed to the default)."
"What OS we are on.")
(defcustom url-max-password-attempts 5
- "*Maximum number of times a password will be prompted for.
+ "Maximum number of times a password will be prompted for.
Applies when a protected document is denied by the server."
:type 'integer
:group 'url)
(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "*Where temporary files go."
+ "Where temporary files go."
:type 'directory
:group 'url-file)
(make-obsolete-variable 'url-temporary-directory
'temporary-file-directory "23.1")
(defcustom url-show-status t
- "*Whether to show a running total of bytes transferred.
+ "Whether to show a running total of bytes transferred.
Can cause a large hit if using a remote X display over a slow link, or
a terminal with a slow modem."
:type 'boolean
@@ -308,7 +299,7 @@ a terminal with a slow modem."
http://www.example.com/")
(defcustom url-news-server nil
- "*The default news server from which to get newsgroups/articles.
+ "The default news server from which to get newsgroups/articles.
Applies if no server is specified in the URL. Defaults to the
environment variable NNTPSERVER or \"news\" if NNTPSERVER is
undefined."
@@ -320,13 +311,13 @@ undefined."
"A regular expression that will match an absolute URL.")
(defcustom url-max-redirections 30
- "*The maximum number of redirection requests to honor in a HTTP connection.
+ "The maximum number of redirection requests to honor in a HTTP connection.
A negative number means to honor an unlimited number of redirection requests."
:type 'integer
:group 'url)
(defcustom url-confirmation-func 'y-or-n-p
- "*What function to use for asking yes or no functions.
+ "What function to use for asking yes or no functions.
Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
takes a single argument (the prompt), and returns t only if a positive
answer is given."
@@ -336,7 +327,7 @@ answer is given."
:group 'url-hairy)
(defcustom url-gateway-method 'native
- "*The type of gateway support to use.
+ "The type of gateway support to use.
Should be a symbol specifying how to get a connection from the local machine.
Currently supported methods:
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 52368dbbd5a..2529adeb965 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -29,11 +29,12 @@
(eval-when-compile (require 'cl))
+(require 'mailcap)
+
(eval-when-compile
(require 'mm-decode)
(require 'mm-view))
-(require 'mailcap)
(require 'url-vars)
(require 'url-cookie)
(require 'url-history)
@@ -120,7 +121,7 @@ than the one returned initially by `url-retrieve'. In this case, it sets this
variable in the original buffer as a forwarding pointer.")
;;;###autoload
-(defun url-retrieve (url callback &optional cbargs)
+(defun url-retrieve (url callback &optional cbargs silent)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
URL is either a string or a parsed URL.
@@ -142,7 +143,9 @@ the callback is not called).
The variables `url-request-data', `url-request-method' and
`url-request-extra-headers' can be dynamically bound around the
request; dynamic binding of other variables doesn't necessarily
-take effect."
+take effect.
+
+If SILENT, then don't message progress reports and the like."
;;; XXX: There is code in Emacs that does dynamic binding
;;; of the following variables around url-retrieve:
;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
@@ -153,12 +156,14 @@ take effect."
;;; webmail.el; the latter should be updated. Is
;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
;;; are (for now) only used in synchronous retrievals.
- (url-retrieve-internal url callback (cons nil cbargs)))
+ (url-retrieve-internal url callback (cons nil cbargs) silent))
-(defun url-retrieve-internal (url callback cbargs)
+(defun url-retrieve-internal (url callback cbargs &optional silent)
"Internal function; external interface is `url-retrieve'.
CBARGS is what the callback will actually receive - the first item is
-the list of events, as described in the docstring of `url-retrieve'."
+the list of events, as described in the docstring of `url-retrieve'.
+
+If SILENT, don't message progress reports and the like."
(url-do-setup)
(url-gc-dead-buffers)
(if (stringp url)
@@ -169,6 +174,7 @@ the list of events, as described in the docstring of `url-retrieve'."
(error "Must provide a callback function to url-retrieve"))
(unless (url-type url)
(error "Bad url: %s" (url-recreate-url url)))
+ (setf (url-silent url) silent)
(let ((loader (url-scheme-get-property (url-type url) 'loader))
(url-using-proxy (if (url-host url)
(url-find-proxy-for-url url (url-host url))))
@@ -178,7 +184,8 @@ the list of events, as described in the docstring of `url-retrieve'."
(setq asynch t
loader 'url-proxy))
(if asynch
- (setq buffer (funcall loader url callback cbargs))
+ (let ((url-current-object url))
+ (setq buffer (funcall loader url callback cbargs)))
(setq buffer (funcall loader url))
(if buffer
(with-current-buffer buffer
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 12:36:19 +0000