diff options
Diffstat (limited to 'lisp/url')
| -rw-r--r-- | lisp/url/ChangeLog | 139 | ||||
| -rw-r--r-- | lisp/url/url-cookie.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-dav.el | 73 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 62 | ||||
| -rw-r--r-- | lisp/url/url-https.el | 56 | ||||
| -rw-r--r-- | lisp/url/url-methods.el | 5 | ||||
| -rw-r--r-- | lisp/url/url-parse.el | 70 |
7 files changed, 205 insertions, 204 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index e4b54f9fc92..2aa14af8983 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,49 @@ +2006-10-12 Magnus Henoch <mange@freemail.hu> + + * url-http.el (url-http-find-free-connection): Handle + url-open-stream returning nil. + +2006-10-11 Magnus Henoch <mange@freemail.hu> + + * url-https.el: Remove (clashes with url-http on 8+3 systems). + + * url-http.el: Move contents of url-https.el here. Add autoloads. + +2006-10-09 Magnus Henoch <mange@freemail.hu> + + * url-parse.el (url-generic-parse-url): Handle URLs with empty + path component and non-empty query component. Untangle path, + query and fragment parsing code. Add references to RFC 3986 in + comments. + (url-recreate-url-attributes): Start query string with "?", not ";". + +2006-09-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-dav.el (url-dav-file-attributes): Simplify. + + * url-http.el (url-http-head-file-attributes): Add device "info". + +2006-09-18 Michael Olson <mwolson@gnu.org> + + * url-methods.el (url-scheme-register-proxy): Handle case where + getenv returns an empty string for http_proxy. This prevents an + error when calling `format' later on. + +2006-08-31 Diane Murray <disumu@x3y2z1.net> + + * url-parse.el (url-recreate-url-attributes): New function, code + simply moved from `url-recreate-url'. + (url-recreate-url): Use it. + Put the `url-target' at the end of the URL after the attributes. + + * url-http.el (url-http-create-request): + Use `url-recreate-url-attributes' when setting real-fname. + +2006-08-29 Diane Murray <disumu@x3y2z1.net> + + * url-cookie.el (url-cookie-write-file): Really don't use versioned + backups. + 2006-08-25 Stefan Monnier <monnier@iro.umontreal.ca> * url-handlers.el (url-file-local-copy): Tell url-copy-file that the @@ -393,32 +439,19 @@ 2004-10-10 Lars Hansen <larsh@math.ku.dk> - * url-auth.el: Update header and footer. - - * url-cache.el: Update header and footer. - - * url-cid.el: Update header and footer. - - * url-dired.el: Update header and footer. - - * url-expand.el: Update header and footer. - - * url-ftp.el: Update header and footer. - - * url-gw.el: Update header and footer. - - * url-imap.el: Update header and footer. - - * url-irc.el: Update header and footer. - - * url-misc.el: Update header and footer. - - * url-news.el: Update header and footer. - - * url-ns.el: Update header and footer. - - * url-privacy.el: Update header and footer. - + * url-auth.el: + * url-cache.el: + * url-cid.el: + * url-dired.el: + * url-expand.el: + * url-ftp.el: + * url-gw.el: + * url-imap.el: + * url-irc.el: + * url-misc.el: + * url-news.el: + * url-ns.el: + * url-privacy.el: * url-proxy.el: Update header and footer. * url-vars.el: Update header. @@ -463,42 +496,24 @@ 2004-10-10 Lars Hansen <larsh@math.ku.dk> - * url-auth.el: Fix copyright notice. - - * url-cache.el: Fix copyright notice. - - * url-cookie.el: Fix copyright notice. - - * url-dired.el: Fix copyright notice. - - * url-file.el: Fix copyright notice. - - * url-ftp.el: Fix copyright notice. - - * url-handlers.el: Fix copyright notice. - - * url-history.el: Fix copyright notice. - - * url-irc.el: Fix copyright notice. - - * url-mailto.el: Fix copyright notice. - - * url-methods.el: Fix copyright notice. - - * url-misc.el: Fix copyright notice. - - * url-news.el: Fix copyright notice. - - * url-nfs.el: Fix copyright notice. - - * url-parse.el: Fix copyright notice. - - * url-privacy.el: Fix copyright notice. - - * url-vars.el: Fix copyright notice. - - * url.el: Fix copyright notice. - + * url-auth.el: + * url-cache.el: + * url-cookie.el: + * url-dired.el: + * url-file.el: + * url-ftp.el: + * url-handlers.el: + * url-history.el: + * url-irc.el: + * url-mailto.el: + * url-methods.el: + * url-misc.el: + * url-news.el: + * url-nfs.el: + * url-parse.el: + * url-privacy.el: + * url-vars.el: + * url.el: * url-util.el: Fix copyright notice. 2004-10-06 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index e74d4989117..f3902619c89 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -168,11 +168,11 @@ telling Microsoft that." (insert ")\n(setq url-cookie-secure-storage\n '") (pp url-cookie-secure-storage (current-buffer)) (insert ")\n") - (insert " ;; Local Variables:\n" + (insert " \n;; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" ";; End:\n") - (set (make-local-variable 'version-control) t) + (set (make-local-variable 'version-control) 'never) (write-file fname) (setq url-cookies-changed-since-last-save nil) (kill-buffer (current-buffer)))))) diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 449d8a510b5..546d744558d 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -621,59 +621,56 @@ Returns t iff the lock was successfully released." (autoload 'url-http-head-file-attributes "url-http") (defun url-dav-file-attributes (url &optional id-format) - (let ((properties (cdar (url-dav-get-properties url))) - (attributes nil)) + (let ((properties (cdar (url-dav-get-properties url)))) (if (and properties (url-dav-http-success-p (plist-get properties 'DAV:status))) ;; We got a good DAV response back.. - (setq attributes - (list - ;; t for directory, string for symbolic link, or nil - ;; Need to support DAV Bindings to figure out the - ;; symbolic link issues. - (if (memq 'DAV:collection (plist-get properties 'DAV:resourcetype)) t nil) + (list + ;; t for directory, string for symbolic link, or nil + ;; Need to support DAV Bindings to figure out the + ;; symbolic link issues. + (if (memq 'DAV:collection (plist-get properties 'DAV:resourcetype)) t nil) - ;; Number of links to file... Needs DAV Bindings. - 1 + ;; Number of links to file... Needs DAV Bindings. + 1 - ;; File uid - no way to figure out? - 0 + ;; File uid - no way to figure out? + 0 - ;; File gid - no way to figure out? - 0 + ;; File gid - no way to figure out? + 0 - ;; Last access time - ??? - nil + ;; Last access time - ??? + nil - ;; Last modification time - (plist-get properties 'DAV:getlastmodified) + ;; Last modification time + (plist-get properties 'DAV:getlastmodified) - ;; Last status change time... just reuse last-modified - ;; for now. - (plist-get properties 'DAV:getlastmodified) + ;; Last status change time... just reuse last-modified + ;; for now. + (plist-get properties 'DAV:getlastmodified) - ;; size in bytes - (or (plist-get properties 'DAV:getcontentlength) 0) + ;; size in bytes + (or (plist-get properties 'DAV:getcontentlength) 0) - ;; file modes as a string like `ls -l' - ;; - ;; Should be able to build this up from the - ;; DAV:supportedlock attribute pretty easily. Getting - ;; the group info could be impossible though. - (url-dav-file-attributes-mode-string properties) + ;; file modes as a string like `ls -l' + ;; + ;; Should be able to build this up from the + ;; DAV:supportedlock attribute pretty easily. Getting + ;; the group info could be impossible though. + (url-dav-file-attributes-mode-string properties) - ;; t iff file's gid would change if it were deleted & - ;; recreated. No way for us to know that thru DAV. - nil + ;; t iff file's gid would change if it were deleted & + ;; recreated. No way for us to know that thru DAV. + nil - ;; inode number - meaningless - nil + ;; inode number - meaningless + nil - ;; device number - meaningless - nil)) + ;; device number - meaningless + nil) ;; Fall back to just the normal http way of doing things. - (setq attributes (url-http-head-file-attributes url id-format))) - attributes)) + (url-http-head-file-attributes url id-format)))) (defun url-dav-save-resource (url obj &optional content-type lock-token) "Save OBJ as URL using WebDAV. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index ae3a4b3e070..bf8069ded7e 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -123,8 +123,10 @@ request.") ;; 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))))))) @@ -160,7 +162,8 @@ request.") (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)) nil @@ -1150,19 +1153,19 @@ CBARGS as the arguments." (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) @@ -1244,6 +1247,35 @@ p3p (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 (condition-case () + (require 'ssl) + (error '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 diff --git a/lisp/url/url-https.el b/lisp/url/url-https.el deleted file mode 100644 index a7440a76535..00000000000 --- a/lisp/url/url-https.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; url-https.el --- HTTP over SSL/TLS routines - -;; Copyright (C) 1999, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Keywords: comm, data, processes - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'url-gw) -(require 'url-util) -(require 'url-parse) -(require 'url-cookie) -(require 'url-http) -(require 'tls) - -(defconst url-https-default-port 443 "Default HTTPS port.") -(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") -(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 (condition-case () - (require 'ssl) - (error 'tls)))) - (,(intern (format (if method "url-http-%s" "url-http") method)) - ,@(remove '&rest (remove '&optional args)))))) - -(url-https-create-secure-wrapper nil (url callback cbargs)) -(url-https-create-secure-wrapper file-exists-p (url)) -(url-https-create-secure-wrapper file-readable-p (url)) -(url-https-create-secure-wrapper file-attributes (url &optional id-format)) - -(provide 'url-https) - -;; arch-tag: c3645ac5-c248-4d12-ad41-7c4b6f7b6d19 -;;; url-https.el ends here diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index 6854d62af03..55166ee46f4 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -75,6 +75,11 @@ (cur-proxy (assoc scheme url-proxy-services)) (urlobj nil)) + ;; If env-proxy is an empty string, treat it as if it were nil + (when (and (stringp env-proxy) + (string= env-proxy "")) + (setq env-proxy nil)) + ;; Store any proxying information - this will not overwrite an old ;; entry, so that people can still set this information in their ;; .emacs file diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index f84bf1a7ba2..2e4fc8a9f27 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -100,28 +100,36 @@ (not (equal (url-port urlobj) (url-scheme-get-property (url-type urlobj) 'default-port)))) (format ":%d" (url-port urlobj))) - (or (url-filename urlobj) "/") + (or (url-filename urlobj) "/") + (url-recreate-url-attributes urlobj) (if (url-target urlobj) - (concat "#" (url-target urlobj))) - (if (url-attributes urlobj) - (concat ";" - (mapconcat - (function - (lambda (x) - (if (cdr x) - (concat (car x) "=" (cdr x)) - (car x)))) (url-attributes urlobj) ";"))))) + (concat "#" (url-target urlobj))))) + +(defun url-recreate-url-attributes (urlobj) + "Recreate the attributes of an URL string from the parsed URLOBJ." + (when (url-attributes urlobj) + (concat "?" + (mapconcat (lambda (x) + (if (cdr x) + (concat (car x) "=" (cdr x)) + (car x))) + (url-attributes urlobj) ";")))) ;;;###autoload (defun url-generic-parse-url (url) "Return a vector of the parts of URL. Format is: \[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" + ;; See RFC 3986. (cond ((null url) (make-vector 9 nil)) ((or (not (string-match url-nonrelative-link url)) (= ?/ (string-to-char url))) + ;; This isn't correct, as a relative URL can be a fragment link + ;; (e.g. "#foo") and many other things (see section 4.2). + ;; However, let's not fix something that isn't broken, especially + ;; when close to a release. (let ((retval (make-vector 9 nil))) (url-set-filename retval url) (url-set-full retval nil) @@ -145,6 +153,8 @@ Format is: (insert url) (goto-char (point-min)) (setq save-pos (point)) + + ;; 3.1. Scheme (if (not (looking-at "//")) (progn (skip-chars-forward "a-zA-Z+.\\-") @@ -153,13 +163,13 @@ Format is: (skip-chars-forward ":") (setq save-pos (point)))) - ;; We are doing a fully specified URL, with hostname and all + ;; 3.2. Authority (if (looking-at "//") (progn (setq full t) (forward-char 2) (setq save-pos (point)) - (skip-chars-forward "^/") + (skip-chars-forward "^/\\?#") (setq host (buffer-substring save-pos (point))) (if (string-match "^\\([^@]+\\)@" host) (setq user (match-string 1 host) @@ -167,6 +177,7 @@ Format is: (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) (setq pass (match-string 2 user) user (match-string 1 user))) + ;; This gives wrong results for IPv6 literal addresses. (if (string-match ":\\([0-9+]+\\)" host) (setq port (string-to-number (match-string 1 host)) host (substring host 0 (match-beginning 0)))) @@ -178,29 +189,26 @@ Format is: (if (not port) (setq port (url-scheme-get-property prot 'default-port))) - ;; Gross hack to preserve ';' in data URLs - + ;; 3.3. Path (setq save-pos (point)) + (skip-chars-forward "^#?") + (setq file (buffer-substring save-pos (point))) - (if (string= "data" prot) - (goto-char (point-max)) - ;; Now check for references + ;; 3.4. Query + (when (looking-at "\\?") + (forward-char 1) + (setq save-pos (point)) (skip-chars-forward "^#") - (if (eobp) - nil - (delete-region - (point) - (progn - (skip-chars-forward "#") - (setq refs (buffer-substring (point) (point-max))) - (point-max)))) - (goto-char save-pos) - (skip-chars-forward "^;") - (if (not (eobp)) - (setq attr (url-parse-args (buffer-substring (point) (point-max)) t) - attr (nreverse attr)))) + ;; RFC 3986 specifies no general way of parsing the query + ;; string, but `url-parse-args' seems universal enough. + (setq attr (url-parse-args (buffer-substring save-pos (point)) t) + attr (nreverse attr))) + + ;; 3.5. Fragment + (when (looking-at "#") + (forward-char 1) + (setq refs (buffer-substring (point) (point-max)))) - (setq file (buffer-substring save-pos (point))) (if (and host (string-match "%[0-9][0-9]" host)) (setq host (url-unhex-string host))) (vector prot user pass host port file refs attr full)))))) |