aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/url
diff options
context:
space:
mode:
authorMiles Bader2004-10-22 10:13:52 +0000
committerMiles Bader2004-10-22 10:13:52 +0000
commit5ea24f9468ea9fb01253a98343a67fdb74d1817e (patch)
tree434ee6dc5f051d6deaf0c357b97b656d16e4ed12 /lisp/url
parent56c68b971d6f7665dd035df1ff302d794c0f294a (diff)
parentd5ddd795bdab373fe62ccfd099c270fd97da0964 (diff)
downloademacs-5ea24f9468ea9fb01253a98343a67fdb74d1817e.tar.gz
emacs-5ea24f9468ea9fb01253a98343a67fdb74d1817e.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-62
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-616 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-620 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-621 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-622 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-625 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-627 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-629 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-630 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-631 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-632 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-633 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-51 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-52 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-53 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-54 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-55 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-56 Update from CVS: Add lisp/legacy-gnus-agent.el * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-57 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-58 Update from CVS
Diffstat (limited to 'lisp/url')
-rw-r--r--lisp/url/ChangeLog59
-rw-r--r--lisp/url/url-auth.el50
-rw-r--r--lisp/url/url-cache.el43
-rw-r--r--lisp/url/url-cid.el66
-rw-r--r--lisp/url/url-dired.el42
-rw-r--r--lisp/url/url-expand.el144
-rw-r--r--lisp/url/url-ftp.el44
-rw-r--r--lisp/url/url-gw.el47
-rw-r--r--lisp/url/url-imap.el85
-rw-r--r--lisp/url/url-irc.el46
-rw-r--r--lisp/url/url-mailto.el3
-rw-r--r--lisp/url/url-misc.el43
-rw-r--r--lisp/url/url-news.el43
-rw-r--r--lisp/url/url-ns.el107
-rw-r--r--lisp/url/url-privacy.el42
-rw-r--r--lisp/url/url-proxy.el79
-rw-r--r--lisp/url/url-util.el6
-rw-r--r--lisp/url/url-vars.el78
-rw-r--r--lisp/url/url.el20
19 files changed, 782 insertions, 265 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 91a6c869a21..053984fcaeb 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,62 @@
12004-10-20 John Paul Wallington <jpw@gnu.org>
2
3 * url-gw.el (url-gateway-nslookup-host):
4 Use `set-process-query-on-exit-flag'.
5
62004-10-10 Lars Hansen <larsh@math.ku.dk>
7
8 * url-auth.el: Update header and footer.
9
10 * url-cache.el: Update header and footer.
11
12 * url-cid.el: Update header and footer.
13
14 * url-dired.el: Update header and footer.
15
16 * url-expand.el: Update header and footer.
17
18 * url-ftp.el: Update header and footer.
19
20 * url-gw.el: Update header and footer.
21
22 * url-imap.el: Update header and footer.
23
24 * url-irc.el: Update header and footer.
25
26 * url-misc.el: Update header and footer.
27
28 * url-news.el: Update header and footer.
29
30 * url-ns.el: Update header and footer.
31
32 * url-privacy.el: Update header and footer.
33
34 * url-proxy.el: Update header and footer.
35
36 * url-vars.el: Update header.
37
382004-10-16 Richard M. Stallman <rms@gnu.org>
39
40 * url.el (url-do-setup): Don't set url-passwd-entry-func.
41
42 * url-vars.el (url-passwd-entry-func): Var deleted.
43 (mm-mime-mule-charset-alist): Remove compatibility code for old Gnus.
44 (url-weekday-alist): Renamed from weekday-alist.
45 (url-monthabbrev-alist): Renamed from monthabbrev-alist.
46 (url-vars-unload-hook): Initialize hook var to hold the function.
47
48 * url-util.el (url-get-normalized-date): Use
49 url-weekday-alist and url-monthabbrev-alist.
50
51 * url-misc.el: Load cl at compile time.
52
53 * url-mailto.el: Don't load cl.
54 (url-mailto): Fix call to `push'.
55
56 * url-gw.el (url-open-telnet): Use read-passwd.
57
58 * url-auth.el (url-basic-auth, url-digest-auth): Use read-passwd.
59
12004-10-12 Simon Josefsson <jas@extundo.com> 602004-10-12 Simon Josefsson <jas@extundo.com>
2 61
3 * url-vars.el (url-gateway-method): Add new method `tls'. 62 * url-vars.el (url-gateway-method): Add new method `tls'.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 39bb730bebc..260315c5d54 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -1,26 +1,27 @@
1;;; url-auth.el --- Uniform Resource Locator authorization modules 1;;; url-auth.el --- Uniform Resource Locator authorization modules
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes, hypermedia 5;; Keywords: comm, data, processes, hypermedia
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
25(require 'url-vars) 26(require 'url-vars)
26(require 'url-parse) 27(require 'url-parse)
@@ -78,7 +79,7 @@ instead of the pathname inheritance method."
78 ((and prompt (not byserv)) 79 ((and prompt (not byserv))
79 (setq user (read-string (url-auth-user-prompt url realm) 80 (setq user (read-string (url-auth-user-prompt url realm)
80 (user-real-login-name)) 81 (user-real-login-name))
81 pass (funcall url-passwd-entry-func "Password: ")) 82 pass (read-passwd "Password: "))
82 (set url-basic-auth-storage 83 (set url-basic-auth-storage
83 (cons (list server 84 (cons (list server
84 (cons path 85 (cons path
@@ -102,7 +103,7 @@ instead of the pathname inheritance method."
102 (progn 103 (progn
103 (setq user (read-string (url-auth-user-prompt url realm) 104 (setq user (read-string (url-auth-user-prompt url realm)
104 (user-real-login-name)) 105 (user-real-login-name))
105 pass (funcall url-passwd-entry-func "Password: ") 106 pass (read-passwd "Password: ")
106 retval (base64-encode-string (format "%s:%s" user pass)) 107 retval (base64-encode-string (format "%s:%s" user pass))
107 byserv (assoc server (symbol-value url-basic-auth-storage))) 108 byserv (assoc server (symbol-value url-basic-auth-storage)))
108 (setcdr byserv 109 (setcdr byserv
@@ -160,7 +161,7 @@ instead of hostname:portnum."
160 ((and prompt (not byserv)) 161 ((and prompt (not byserv))
161 (setq user (read-string (url-auth-user-prompt url realm) 162 (setq user (read-string (url-auth-user-prompt url realm)
162 (user-real-login-name)) 163 (user-real-login-name))
163 pass (funcall url-passwd-entry-func "Password: ") 164 pass (read-passwd "Password: ")
164 url-digest-auth-storage 165 url-digest-auth-storage
165 (cons (list server 166 (cons (list server
166 (cons path 167 (cons path
@@ -187,7 +188,7 @@ instead of hostname:portnum."
187 (progn 188 (progn
188 (setq user (read-string (url-auth-user-prompt url realm) 189 (setq user (read-string (url-auth-user-prompt url realm)
189 (user-real-login-name)) 190 (user-real-login-name))
190 pass (funcall url-passwd-entry-func "Password: ") 191 pass (read-passwd "Password: ")
191 retval (setq retval 192 retval (setq retval
192 (cons user 193 (cons user
193 (url-digest-auth-create-key 194 (url-digest-auth-create-key
@@ -314,3 +315,4 @@ RATING a rating between 1 and 10 of the strength of the authentication.
314(provide 'url-auth) 315(provide 'url-auth)
315 316
316;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 317;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
318;;; url-auth.el ends here
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 1e3374639e1..f27b47251e4 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,26 +1,28 @@
1;;; url-cache.el --- Uniform Resource Locator retrieval tool 1;;; url-cache.el --- Uniform Resource Locator retrieval tool
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes, hypermedia 5;; Keywords: comm, data, processes, hypermedia
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA. 25
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24(require 'url-parse) 26(require 'url-parse)
25(require 'url-util) 27(require 'url-util)
26 28
@@ -200,3 +202,4 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
200(provide 'url-cache) 202(provide 'url-cache)
201 203
202;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c 204;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
205;;; url-cache.el ends here
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
new file mode 100644
index 00000000000..9c44835ca9f
--- /dev/null
+++ b/lisp/url/url-cid.el
@@ -0,0 +1,66 @@
1;;; url-cid.el --- Content-ID URL loader
2
3;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc.
4
5;; Keywords: comm, data, processes
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Code:
25
26(require 'url-vars)
27(require 'url-parse)
28
29(require 'mm-decode)
30
31(defun url-cid-gnus (cid)
32 (let ((content-type nil)
33 (encoding nil)
34 (part nil)
35 (data nil))
36 (setq part (mm-get-content-id cid))
37 (if (not part)
38 (message "Unknown CID encountered: %s" cid)
39 (setq data (save-excursion
40 (set-buffer (mm-handle-buffer part))
41 (buffer-string))
42 content-type (mm-handle-type part)
43 encoding (symbol-name (mm-handle-encoding part)))
44 (if (= 0 (length content-type)) (setq content-type "text/plain"))
45 (if (= 0 (length encoding)) (setq encoding "8bit"))
46 (if (listp content-type)
47 (setq content-type (car content-type)))
48 (insert (format "Content-type: %d\r\n" (length data))
49 "Content-type: " content-type "\r\n"
50 "Content-transfer-encoding: " encoding "\r\n"
51 "\r\n"
52 (or data "")))))
53
54;;;###autoload
55(defun url-cid (url)
56 (cond
57 ((fboundp 'mm-get-content-id)
58 ;; Using Pterodactyl Gnus or later
59 (save-excursion
60 (set-buffer (generate-new-buffer " *url-cid*"))
61 (url-cid-gnus (url-filename url))))
62 (t
63 (message "Unable to handle CID URL: %s" url))))
64
65;;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5
66;;; url-cid.el ends here
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index 73307412e1e..41d81df677e 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -1,26 +1,27 @@
1;;; url-dired.el --- URL Dired minor mode 1;;; url-dired.el --- URL Dired minor mode
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, files 5;; Keywords: comm, files
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
25(autoload 'w3-fetch "w3") 26(autoload 'w3-fetch "w3")
26(autoload 'w3-open-local "w3") 27(autoload 'w3-open-local "w3")
@@ -98,3 +99,4 @@ Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
98(provide 'url-dired) 99(provide 'url-dired)
99 100
100;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f 101;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f
102;;; url-dired.el ends here
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
new file mode 100644
index 00000000000..a7855653103
--- /dev/null
+++ b/lisp/url/url-expand.el
@@ -0,0 +1,144 @@
1;;; url-expand.el --- expand-file-name for URLs
2
3;; Copyright (c) 1999 Free Software Foundation, Inc.
4
5;; Keywords: comm, data, processes
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Code:
25
26(require 'url-methods)
27(require 'url-util)
28(require 'url-parse)
29
30(defun url-expander-remove-relative-links (name)
31 ;; Strip . and .. from pathnames
32 (let ((new (if (not (string-match "^/" name))
33 (concat "/" name)
34 name)))
35
36 ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat
37 ;; the tests that follow are not too complicated in terms of
38 ;; looking for '..' or '../', etc.
39 (if (string-match "/\\.+$" new)
40 (setq new (concat new "/")))
41
42 ;; Remove '/./' first
43 (while (string-match "/\\(\\./\\)" new)
44 (setq new (concat (substring new 0 (match-beginning 1))
45 (substring new (match-end 1)))))
46
47 ;; Then remove '/../'
48 (while (string-match "/\\([^/]*/\\.\\./\\)" new)
49 (setq new (concat (substring new 0 (match-beginning 1))
50 (substring new (match-end 1)))))
51
52 ;; Remove cruft at the beginning of the string, so people that put
53 ;; in extraneous '..' because they are morons won't lose.
54 (while (string-match "^/\\.\\.\\(/\\)" new)
55 (setq new (substring new (match-beginning 1) nil)))
56 new))
57
58(defun url-expand-file-name (url &optional default)
59 "Convert URL to a fully specified URL, and canonicalize it.
60Second arg DEFAULT is a URL to start with if URL is relative.
61If DEFAULT is nil or missing, the current buffer's URL is used.
62Path components that are `.' are removed, and
63path components followed by `..' are removed, along with the `..' itself."
64 (if (and url (not (string-match "^#" url)))
65 ;; Need to nuke newlines and spaces in the URL, or we open
66 ;; ourselves up to potential security holes.
67 (setq url (mapconcat (function (lambda (x)
68 (if (memq x '(? ?\n ?\r))
69 ""
70 (char-to-string x))))
71 url "")))
72
73 ;; Need to figure out how/where to expand the fragment relative to
74 (setq default (cond
75 ((vectorp default)
76 ;; Default URL has already been parsed
77 default)
78 (default
79 ;; They gave us a default URL in non-parsed format
80 (url-generic-parse-url default))
81 (url-current-object
82 ;; We are in a URL-based buffer, use the pre-parsed object
83 url-current-object)
84 ((string-match url-nonrelative-link url)
85 ;; The URL they gave us is absolute, go for it.
86 nil)
87 (t
88 ;; Hmmm - this shouldn't ever happen.
89 (error "url-expand-file-name confused - no default?"))))
90
91 (cond
92 ((= (length url) 0) ; nil or empty string
93 (url-recreate-url default))
94 ((string-match "^#" url) ; Offset link, use it raw
95 url)
96 ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately
97 url)
98 (t
99 (let* ((urlobj (url-generic-parse-url url))
100 (inhibit-file-name-handlers t)
101 (expander (url-scheme-get-property (url-type default) 'expand-file-name)))
102 (if (string-match "^//" url)
103 (setq urlobj (url-generic-parse-url (concat (url-type default) ":"
104 url))))
105 (funcall expander urlobj default)
106 (url-recreate-url urlobj)))))
107
108(defun url-identity-expander (urlobj defobj)
109 (url-set-type urlobj (or (url-type urlobj) (url-type defobj))))
110
111(defun url-default-expander (urlobj defobj)
112 ;; The default expansion routine - urlobj is modified by side effect!
113 (if (url-type urlobj)
114 ;; Well, they told us the scheme, let's just go with it.
115 nil
116 (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))
117 (url-set-port urlobj (or (url-port urlobj)
118 (and (string= (url-type urlobj)
119 (url-type defobj))
120 (url-port defobj))))
121 (if (not (string= "file" (url-type urlobj)))
122 (url-set-host urlobj (or (url-host urlobj) (url-host defobj))))
123 (if (string= "ftp" (url-type urlobj))
124 (url-set-user urlobj (or (url-user urlobj) (url-user defobj))))
125 (if (string= (url-filename urlobj) "")
126 (url-set-filename urlobj "/"))
127 (if (string-match "^/" (url-filename urlobj))
128 nil
129 (let ((query nil)
130 (file nil)
131 (sepchar nil))
132 (if (string-match "[?#]" (url-filename urlobj))
133 (setq query (substring (url-filename urlobj) (match-end 0))
134 file (substring (url-filename urlobj) 0 (match-beginning 0))
135 sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0)))
136 (setq file (url-filename urlobj)))
137 (setq file (url-expander-remove-relative-links
138 (concat (url-basepath (url-filename defobj)) file)))
139 (url-set-filename urlobj (if query (concat file sepchar query) file))))))
140
141(provide 'url-expand)
142
143;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a
144;;; url-expand.el ends here
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index 4346f3910b1..7f9c9de608d 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -1,26 +1,27 @@
1;;; url-ftp.el --- FTP wrapper 1;;; url-ftp.el --- FTP wrapper
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes 5;; Keywords: comm, data, processes
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Commentary:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
25;; We knew not what we did when we overloaded 'file' to mean 'file' 26;; We knew not what we did when we overloaded 'file' to mean 'file'
26;; and 'ftp' back in the dark ages of the web. 27;; and 'ftp' back in the dark ages of the web.
@@ -29,6 +30,8 @@
29;; in url-methods.el and just maps everything onto the code in 30;; in url-methods.el and just maps everything onto the code in
30;; url-file. 31;; url-file.
31 32
33;;; Code:
34
32(require 'url-parse) 35(require 'url-parse)
33(require 'url-file) 36(require 'url-file)
34 37
@@ -40,3 +43,4 @@
40(provide 'url-ftp) 43(provide 'url-ftp)
41 44
42;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc 45;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc
46;;; url-ftp.el ends here
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 608827d7cee..b5701668f83 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,27 +1,29 @@
1;;; url-gw.el --- Gateway munging for URL loading 1;;; url-gw.el --- Gateway munging for URL loading
2
3;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
4
2;; Author: Bill Perry <wmperry@gnu.org> 5;; Author: Bill Perry <wmperry@gnu.org>
3;; Keywords: comm, data, processes 6;; Keywords: comm, data, processes
4 7
5;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8;; This file is part of GNU Emacs.
6;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc. 9
7;;; 10;; GNU Emacs is free software; you can redistribute it and/or modify
8;;; This file is part of GNU Emacs. 11;; it under the terms of the GNU General Public License as published by
9;;; 12;; the Free Software Foundation; either version 2, or (at your option)
10;;; GNU Emacs is free software; you can redistribute it and/or modify 13;; any later version.
11;;; it under the terms of the GNU General Public License as published by 14
12;;; the Free Software Foundation; either version 2, or (at your option) 15;; GNU Emacs is distributed in the hope that it will be useful,
13;;; any later version. 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU Emacs is distributed in the hope that it will be useful, 18;; GNU General Public License for more details.
16;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19
17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; You should have received a copy of the GNU General Public License
18;;; GNU General Public License for more details. 21;; along with GNU Emacs; see the file COPYING. If not, write to the
19;;; 22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;;; You should have received a copy of the GNU General Public License 23;; Boston, MA 02111-1307, USA.
21;;; along with GNU Emacs; see the file COPYING. If not, write to the 24
22;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25;;; Code:
23;;; Boston, MA 02111-1307, USA. 26
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25(eval-when-compile (require 'cl)) 27(eval-when-compile (require 'cl))
26(require 'url-vars) 28(require 'url-vars)
27 29
@@ -115,7 +117,7 @@ linked Emacs under SunOS 4.x"
115 (let ((proc (start-process " *nslookup*" " *nslookup*" 117 (let ((proc (start-process " *nslookup*" " *nslookup*"
116 url-gateway-nslookup-program host)) 118 url-gateway-nslookup-program host))
117 (res host)) 119 (res host))
118 (process-kill-without-query proc) 120 (set-process-query-on-exit-flag proc nil)
119 (save-excursion 121 (save-excursion
120 (set-buffer (process-buffer proc)) 122 (set-buffer (process-buffer proc))
121 (while (memq (process-status proc) '(run open)) 123 (while (memq (process-status proc) '(run open))
@@ -186,7 +188,7 @@ linked Emacs under SunOS 4.x"
186 proc (concat 188 proc (concat
187 (or url-gateway-telnet-password 189 (or url-gateway-telnet-password
188 (setq url-gateway-telnet-password 190 (setq url-gateway-telnet-password
189 (funcall url-passwd-entry-func "Password: "))) 191 (read-passwd "Password: ")))
190 "\n")) 192 "\n"))
191 (erase-buffer) 193 (erase-buffer)
192 (url-wait-for-string url-gateway-prompt-pattern proc) 194 (url-wait-for-string url-gateway-prompt-pattern proc)
@@ -266,3 +268,4 @@ Will not make a connexion if `url-gateway-unplugged' is non-nil."
266(provide 'url-gw) 268(provide 'url-gw)
267 269
268;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 270;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838
271;;; url-gw.el ends here
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
new file mode 100644
index 00000000000..79b53e5d012
--- /dev/null
+++ b/lisp/url/url-imap.el
@@ -0,0 +1,85 @@
1;;; url-imap.el --- IMAP retrieval routines
2
3;; Copyright (c) 1999 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <jas@pdc.kth.se>
6;; Keywords: comm, data, processes
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
24
25;;; Commentary:
26
27;; Anyway, here's a teaser. It's quite broken in lots of regards, but at
28;; least it seem to work. At least a little. At least when called
29;; manually like this (I've no idea how it's supposed to be called):
30
31;; (url-imap (url-generic-parse-url "imap://cyrus.andrew.cmu.edu/archive.c-client;UID=1021"))
32
33;;; Code:
34
35(eval-when-compile (require 'cl))
36(require 'url-util)
37(require 'url-parse)
38(require 'nnimap)
39(require 'mm-util)
40
41(defconst url-imap-default-port 143 "Default IMAP port")
42
43(defun url-imap-open-host (host port user pass)
44 ;; xxx use user and password
45 (if (fboundp 'nnheader-init-server-buffer)
46 (nnheader-init-server-buffer))
47 (let ((imap-username user)
48 (imap-password pass)
49 (authenticator (if user 'login 'anonymous)))
50 (if (stringp port)
51 (setq port (string-to-int port)))
52 (nnimap-open-server host
53 `((nnimap-server-port ,port)
54 (nnimap-stream 'network)
55 (nnimap-authenticator ,authenticator)))))
56
57(defun url-imap (url)
58 (check-type url vector "Need a pre-parsed URL.")
59 (save-excursion
60 (set-buffer (generate-new-buffer " *url-imap*"))
61 (mm-disable-multibyte)
62 (let* ((host (url-host url))
63 (port (url-port url))
64 ;; xxx decode mailbox (see rfc2192)
65 (mailbox (url-filename url))
66 (coding-system-for-read 'binary))
67 (and (eq (string-to-char mailbox) ?/)
68 (setq mailbox (substring mailbox 1)))
69 (url-imap-open-host host port (url-user url) (url-password url))
70 (cond ((assoc "TYPE" (url-attributes url))
71 ;; xxx list mailboxes (start gnus?)
72 )
73 ((assoc "UID" (url-attributes url))
74 ;; fetch message part
75 ;; xxx handle partial fetches
76 (insert "Content-type: message/rfc822\n\n")
77 (nnimap-request-article (cdr (assoc "UID" (url-attributes url)))
78 mailbox host (current-buffer)))
79 (t
80 ;; xxx list messages in mailbox (start gnus?)
81 )))
82 (current-buffer)))
83
84;;; arch-tag: 034991ff-5425-48ea-b911-c96c90e6f47d
85;;; url-imap.el ends here
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index a4b195f253f..8b54b6d9222 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,28 +1,31 @@
1;;; url-irc.el --- IRC URL interface 1;;; url-irc.el --- IRC URL interface
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes 5;; Keywords: comm, data, processes
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Commentary:
22;;; Boston, MA 02111-1307, USA. 25
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
24 27
25;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt 28;;; Code:
26 29
27(require 'url-vars) 30(require 'url-vars)
28(require 'url-parse) 31(require 'url-parse)
@@ -74,3 +77,4 @@ PASSWORD - What password to use"
74(provide 'url-irc) 77(provide 'url-irc)
75 78
76;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e 79;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e
80;;; url-irc.el ends here
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index bcb6bad4179..f5192bcb03f 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -25,7 +25,6 @@
25 25
26;;; Code: 26;;; Code:
27 27
28(eval-when-compile (require 'cl))
29(require 'url-vars) 28(require 'url-vars)
30(require 'url-parse) 29(require 'url-parse)
31(require 'url-util) 30(require 'url-util)
@@ -85,7 +84,7 @@
85 (setq args (cons (list "x-url-from" source-url) args))) 84 (setq args (cons (list "x-url-from" source-url) args)))
86 85
87 (if (assoc "to" args) 86 (if (assoc "to" args)
88 (push to (cdr (assoc "to" args))) 87 (push (cdr (assoc "to" args)) to)
89 (setq args (cons (list "to" to) args))) 88 (setq args (cons (list "to" to) args)))
90 (setq subject (cdr-safe (assoc "subject" args))) 89 (setq subject (cdr-safe (assoc "subject" args)))
91 (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) 90 (if (fboundp url-mail-command) (funcall url-mail-command) (mail))
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index ff2f1282137..21d42820e1b 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,27 +1,29 @@
1;;; url-misc.el --- Misc Uniform Resource Locator retrieval code 1;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
2
3;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes 5;; Keywords: comm, data, processes
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
26(eval-when-compile (require 'cl))
25(require 'url-vars) 27(require 'url-vars)
26(require 'url-parse) 28(require 'url-parse)
27(autoload 'Info-goto-node "info" "" t) 29(autoload 'Info-goto-node "info" "" t)
@@ -115,3 +117,4 @@
115(provide 'url-misc) 117(provide 'url-misc)
116 118
117;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0 119;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
120;;; url-misc.el ends here
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 59364c9ccd0..432c81f5d44 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,26 +1,28 @@
1;;; url-news.el --- News Uniform Resource Locator retrieval code 1;;; url-news.el --- News Uniform Resource Locator retrieval code
2
3;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes 5;; Keywords: comm, data, processes
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA. 25
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24(require 'url-vars) 26(require 'url-vars)
25(require 'url-util) 27(require 'url-util)
26(require 'url-parse) 28(require 'url-parse)
@@ -133,3 +135,4 @@
133(provide 'url-news) 135(provide 'url-news)
134 136
135;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311 137;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
138;;; url-news.el ends here
diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el
new file mode 100644
index 00000000000..fe181422e4f
--- /dev/null
+++ b/lisp/url/url-ns.el
@@ -0,0 +1,107 @@
1;;; url-ns.el --- Various netscape-ish functions for proxy definitions
2
3;; Copyright (c) 1997 - 1999 Free Software Foundation, Inc.
4
5;; Keywords: comm, data, processes, hypermedia
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Code:
25
26(require 'url-gw)
27
28;;;###autoload
29(defun isPlainHostName (host)
30 (not (string-match "\\." host)))
31
32;;;###autoload
33(defun dnsDomainIs (host dom)
34 (string-match (concat (regexp-quote dom) "$") host))
35
36;;;###autoload
37(defun dnsResolve (host)
38 (url-gateway-nslookup-host host))
39
40;;;###autoload
41(defun isResolvable (host)
42 (if (string-match "^[0-9.]+$" host)
43 t
44 (not (string= host (url-gateway-nslookup-host host)))))
45
46;;;###autoload
47(defun isInNet (ip net mask)
48 (let ((netc (split-string ip "\\."))
49 (ipc (split-string net "\\."))
50 (maskc (split-string mask "\\.")))
51 (if (or (/= (length netc) (length ipc))
52 (/= (length ipc) (length maskc)))
53 nil
54 (setq netc (mapcar 'string-to-int netc)
55 ipc (mapcar 'string-to-int ipc)
56 maskc (mapcar 'string-to-int maskc))
57 (and
58 (= (logand (nth 0 netc) (nth 0 maskc))
59 (logand (nth 0 ipc) (nth 0 maskc)))
60 (= (logand (nth 1 netc) (nth 1 maskc))
61 (logand (nth 1 ipc) (nth 1 maskc)))
62 (= (logand (nth 2 netc) (nth 2 maskc))
63 (logand (nth 2 ipc) (nth 2 maskc)))
64 (= (logand (nth 3 netc) (nth 3 maskc))
65 (logand (nth 3 ipc) (nth 3 maskc)))))))
66
67;; Netscape configuration file parsing
68(defvar url-ns-user-prefs nil
69 "Internal, do not use.")
70
71;;;###autoload
72(defun url-ns-prefs (&optional file)
73 (if (not file)
74 (setq file (expand-file-name "~/.netscape/preferences.js")))
75 (if (not (and (file-exists-p file)
76 (file-readable-p file)))
77 (message "Could not open %s for reading" file)
78 (save-excursion
79 (let ((false nil)
80 (true t))
81 (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
82 (set-buffer (get-buffer-create " *ns-parse*"))
83 (erase-buffer)
84 (insert-file-contents file)
85 (goto-char (point-min))
86 (while (re-search-forward "^//" nil t)
87 (replace-match ";;"))
88 (goto-char (point-min))
89 (while (re-search-forward "^user_pref(" nil t)
90 (replace-match "(url-ns-set-user-pref "))
91 (goto-char (point-min))
92 (while (re-search-forward "\"," nil t)
93 (replace-match "\""))
94 (goto-char (point-min))
95 (eval-buffer)))))
96
97(defun url-ns-set-user-pref (key val)
98 (puthash key val url-ns-user-prefs))
99
100;;;###autoload
101(defun url-ns-user-pref (key &optional default)
102 (gethash key url-ns-user-prefs default))
103
104(provide 'url-ns)
105
106;;; arch-tag: 69520992-cf97-40b4-9ad1-c866d3cae5bf
107;;; url-ns.el ends here
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index cb64cfbd4fc..50f46415b80 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,26 +1,27 @@
1;;; url-privacy.el --- Global history tracking for URL package 1;;; url-privacy.el --- Global history tracking for URL package
2
3;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes, hypermedia 5;; Keywords: comm, data, processes, hypermedia
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
25(eval-when-compile (require 'cl)) 26(eval-when-compile (require 'cl))
26(require 'url-vars) 27(require 'url-vars)
@@ -79,3 +80,4 @@
79(provide 'url-privacy) 80(provide 'url-privacy)
80 81
81;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d 82;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
83;;; url-privacy.el ends here
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
new file mode 100644
index 00000000000..20f1b4b7ea7
--- /dev/null
+++ b/lisp/url/url-proxy.el
@@ -0,0 +1,79 @@
1;;; url-proxy.el --- Proxy server support
2
3;; Copyright (c) 1999 Free Software Foundation, Inc.
4
5;; Keywords: comm, data, processes, hypermedia
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Code:
25
26(require 'url-parse)
27(autoload 'url-warn "url")
28
29(defun url-default-find-proxy-for-url (urlobj host)
30 (cond
31 ((or (and (assoc "no_proxy" url-proxy-services)
32 (string-match
33 (cdr
34 (assoc "no_proxy" url-proxy-services))
35 host))
36 (equal "www" (url-type urlobj)))
37 "DIRECT")
38 ((cdr (assoc (url-type urlobj) url-proxy-services))
39 (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
40 ;;
41 ;; Should check for socks
42 ;;
43 (t
44 "DIRECT")))
45
46(defvar url-proxy-locator 'url-default-find-proxy-for-url)
47
48(defun url-find-proxy-for-url (url host)
49 (let ((proxies (split-string (funcall url-proxy-locator url host) " *; *"))
50 (proxy nil)
51 (case-fold-search t))
52 ;; Not sure how I should handle gracefully degrading from one proxy to
53 ;; another, so for now just deal with the first one
54 ;; (while proxies
55 (if (listp proxies)
56 (setq proxy (car proxies))
57 (setq proxy proxies))
58 (cond
59 ((string-match "^direct" proxy) nil)
60 ((string-match "^proxy +" proxy)
61 (concat "http://" (substring proxy (match-end 0)) "/"))
62 ((string-match "^socks +" proxy)
63 (concat "socks://" (substring proxy (match-end 0))))
64 (t
65 (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical)
66 nil))))
67
68(defun url-proxy (url callback &optional cbargs)
69 ;; Retrieve URL from a proxy.
70 ;; Expects `url-using-proxy' to be bound to the specific proxy to use."
71 (setq url-using-proxy (url-generic-parse-url url-using-proxy))
72 (let ((proxy-object (copy-sequence url)))
73 (url-set-target proxy-object nil)
74 (url-http url-using-proxy callback cbargs)))
75
76(provide 'url-proxy)
77
78;;; arch-tag: 4ff8882e-e498-42b7-abc5-acb449cdbc62
79;;; url-proxy.el ends here
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 5d1f73e0d5d..1d0bfcf0c48 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -192,13 +192,13 @@ Will not do anything if `url-show-status' is nil."
192 (nth 1 (current-time-zone)) 192 (nth 1 (current-time-zone))
193 "GMT")) 193 "GMT"))
194 (parsed (timezone-parse-date gmt)) 194 (parsed (timezone-parse-date gmt))
195 (day (cdr-safe (assoc (substring raw 0 3) weekday-alist))) 195 (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
196 (year nil) 196 (year nil)
197 (month (car 197 (month (car
198 (rassoc 198 (rassoc
199 (string-to-int (aref parsed 1)) monthabbrev-alist))) 199 (string-to-int (aref parsed 1)) url-monthabbrev-alist)))
200 ) 200 )
201 (setq day (or (car-safe (rassoc day weekday-alist)) 201 (setq day (or (car-safe (rassoc day url-weekday-alist))
202 (substring raw 0 3)) 202 (substring raw 0 3))
203 year (aref parsed 0)) 203 year (aref parsed 0))
204 ;; This is needed for plexus servers, or the server will hang trying to 204 ;; This is needed for plexus servers, or the server will hang trying to
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index a33d8ba43e3..e4073db4271 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,26 +1,27 @@
1;;; url-vars.el --- Variables for Uniform Resource Locator tool 1;;; url-vars.el --- Variables for Uniform Resource Locator tool
2
3;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
4
2;; Keywords: comm, data, processes, hypermedia 5;; Keywords: comm, data, processes, hypermedia
3 6
4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7;; This file is part of GNU Emacs.
5;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. 8
6;;; 9;; GNU Emacs is free software; you can redistribute it and/or modify
7;;; This file is part of GNU Emacs. 10;; it under the terms of the GNU General Public License as published by
8;;; 11;; the Free Software Foundation; either version 2, or (at your option)
9;;; GNU Emacs is free software; you can redistribute it and/or modify 12;; any later version.
10;;; it under the terms of the GNU General Public License as published by 13
11;;; the Free Software Foundation; either version 2, or (at your option) 14;; GNU Emacs is distributed in the hope that it will be useful,
12;;; any later version. 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU General Public License for more details.
15;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; You should have received a copy of the GNU General Public License
17;;; GNU General Public License for more details. 20;; along with GNU Emacs; see the file COPYING. If not, write to the
18;;; 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19;;; You should have received a copy of the GNU General Public License 22;; Boston, MA 02111-1307, USA.
20;;; along with GNU Emacs; see the file COPYING. If not, write to the 23
21;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;;; Code:
22;;; Boston, MA 02111-1307, USA.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 25
25(require 'mm-util) 26(require 'mm-util)
26 27
@@ -191,19 +192,6 @@ from the ACCESS_proxy environment variables."
191 (string :tag "Proxy"))) 192 (string :tag "Proxy")))
192 :group 'url) 193 :group 'url)
193 194
194(defcustom url-passwd-entry-func nil
195 "*Symbol indicating which function to call to read in a password.
196It will be set up depending on whether you are running EFS or ange-ftp
197at startup if it is nil. This function should accept the prompt
198string as its first argument, and the default value as its second
199argument."
200 :type '(choice (const :tag "Guess" :value nil)
201 (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd)
202 (const :tag "Use EFS" :value efs-read-passwd)
203 (const :tag "Use Password Package" :value read-passwd)
204 (function :tag "Other"))
205 :group 'url-hairy)
206
207(defcustom url-standalone-mode nil 195(defcustom url-standalone-mode nil
208 "*Rely solely on the cache?" 196 "*Rely solely on the cache?"
209 :type 'boolean 197 :type 'boolean
@@ -240,24 +228,6 @@ Should be an assoc list of headers/contents.")
240(defvar url-mime-encoding-string nil 228(defvar url-mime-encoding-string nil
241 "*String to send in the Accept-encoding: field in HTTP requests.") 229 "*String to send in the Accept-encoding: field in HTTP requests.")
242 230
243;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose
244;; cars aren't valid MIME charsets/coding systems, at least in Emacs.
245;; This gets it correct by construction in Emacs. Fixme: DTRT for
246;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg.
247(when (and (not (featurep 'xemacs))
248 (fboundp 'coding-system-list))
249 (setq mm-mime-mule-charset-alist
250 (apply
251 'nconc
252 (mapcar
253 (lambda (cs)
254 (when (and (coding-system-get cs 'mime-charset)
255 (not (eq t (coding-system-get cs 'safe-charsets))))
256 (list (cons (coding-system-get cs 'mime-charset)
257 (delq 'ascii
258 (coding-system-get cs 'safe-charsets))))))
259 (coding-system-list 'base-only)))))
260
261;; Perhaps the first few should actually be given decreasing `q's and 231;; Perhaps the first few should actually be given decreasing `q's and
262;; the list should be trimmed significantly. 232;; the list should be trimmed significantly.
263;; Fixme: do something sane if we don't have `sort-coding-systems' 233;; Fixme: do something sane if we don't have `sort-coding-systems'
@@ -381,14 +351,14 @@ Currently supported methods:
381 351
382(defvar url-setup-done nil "Has setup configuration been done?") 352(defvar url-setup-done nil "Has setup configuration been done?")
383 353
384(defconst weekday-alist 354(defconst url-weekday-alist
385 '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3) 355 '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
386 ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6) 356 ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
387 ("Tues" . 2) ("Thurs" . 4) 357 ("Tues" . 2) ("Thurs" . 4)
388 ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) 358 ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
389 ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) 359 ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
390 360
391(defconst monthabbrev-alist 361(defconst url-monthabbrev-alist
392 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) 362 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
393 ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) 363 ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
394 ("Dec" . 12))) 364 ("Dec" . 12)))
@@ -425,6 +395,8 @@ This should be set, e.g. by mail user agents rendering HTML to avoid
425(defun url-vars-unload-hook () 395(defun url-vars-unload-hook ()
426 (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) 396 (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string))
427 397
398(add-hook 'url-vars-unload-hook 'url-vars-unload-hook)
399
428(provide 'url-vars) 400(provide 'url-vars)
429 401
430;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49 402;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
diff --git a/lisp/url/url.el b/lisp/url/url.el
index f7b1b717681..75ddfdc3a2f 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -113,26 +113,6 @@ Emacs."
113 noproxy "") "\\)")) 113 noproxy "") "\\)"))
114 url-proxy-services)))) 114 url-proxy-services))))
115 115
116 ;; Set the password entry funtion based on user defaults or guess
117 ;; based on which remote-file-access package they are using.
118 (cond
119 (url-passwd-entry-func nil) ; Already been set
120 ((fboundp 'read-passwd) ; Use secure password if available
121 (setq url-passwd-entry-func 'read-passwd))
122 ((or (featurep 'efs) ; Using EFS
123 (featurep 'efs-auto)) ; or autoloading efs
124 (if (not (fboundp 'read-passwd))
125 (autoload 'read-passwd "passwd" "Read in a password" nil))
126 (setq url-passwd-entry-func 'read-passwd))
127 ((or (featurep 'ange-ftp) ; Using ange-ftp
128 (and (boundp 'file-name-handler-alist)
129 (not (featurep 'xemacs)))) ; ??
130 (setq url-passwd-entry-func 'ange-ftp-read-passwd))
131 (t
132 (url-warn
133 'security
134 "(url-setup): Can't determine how to read passwords, winging it.")))
135
136 (url-setup-privacy-info) 116 (url-setup-privacy-info)
137 (run-hooks 'url-load-hook) 117 (run-hooks 'url-load-hook)
138 (setq url-setup-done t))) 118 (setq url-setup-done t)))