Mercurial > emacs
annotate lisp/url/url-gw.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 5495085c9b6c |
children | a5b0f6d4e94a |
rev | line source |
---|---|
54695 | 1 ;;; url-gw.el --- Gateway munging for URL loading |
57612 | 2 |
106815 | 3 ;; Copyright (C) 1997, 1998, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
96361
a99299e4d2de
American English spelling fix.
Glenn Morris <rgm@gnu.org>
parents:
94668
diff
changeset
|
4 ;; Free Software Foundation, Inc. |
57612 | 5 |
54695 | 6 ;; Author: Bill Perry <wmperry@gnu.org> |
7 ;; Keywords: comm, data, processes | |
8 | |
57612 | 9 ;; This file is part of GNU Emacs. |
10 | |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
79720
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
57612 | 12 ;; it under the terms of the GNU General Public License as published by |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
79720
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
79720
diff
changeset
|
14 ;; (at your option) any later version. |
57612 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
79720
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
57612 | 23 |
24 ;;; Code: | |
25 | |
54695 | 26 (eval-when-compile (require 'cl)) |
27 (require 'url-vars) | |
28 | |
29 ;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program? | |
30 | |
31 (autoload 'socks-open-network-stream "socks") | |
32 (autoload 'open-ssl-stream "ssl") | |
57449
202c408c174b
url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents:
54770
diff
changeset
|
33 (autoload 'open-tls-stream "tls") |
54695 | 34 |
35 (defgroup url-gateway nil | |
63987
56d2561b1c9f
(url-gateway): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63618
diff
changeset
|
36 "URL gateway variables." |
54695 | 37 :group 'url) |
38 | |
39 (defcustom url-gateway-local-host-regexp nil | |
110307 | 40 "A regular expression specifying local hostnames/machines." |
54695 | 41 :type '(choice (const nil) regexp) |
42 :group 'url-gateway) | |
43 | |
44 (defcustom url-gateway-prompt-pattern | |
45 "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" | |
110307 | 46 "A regular expression matching a shell prompt." |
54695 | 47 :type 'regexp |
48 :group 'url-gateway) | |
49 | |
50 (defcustom url-gateway-rlogin-host nil | |
110307 | 51 "What hostname to actually rlog into before doing a telnet." |
54695 | 52 :type '(choice (const nil) string) |
53 :group 'url-gateway) | |
54 | |
55 (defcustom url-gateway-rlogin-user-name nil | |
110307 | 56 "Username to log into the remote machine with when using rlogin." |
54695 | 57 :type '(choice (const nil) string) |
58 :group 'url-gateway) | |
59 | |
60 (defcustom url-gateway-rlogin-parameters '("telnet" "-8") | |
110307 | 61 "Parameters to `url-open-rlogin'. |
54695 | 62 This list will be used as the parameter list given to rsh." |
63 :type '(repeat string) | |
64 :group 'url-gateway) | |
65 | |
66 (defcustom url-gateway-telnet-host nil | |
110307 | 67 "What hostname to actually login to before doing a telnet." |
54695 | 68 :type '(choice (const nil) string) |
69 :group 'url-gateway) | |
70 | |
71 (defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") | |
110307 | 72 "Parameters to `url-open-telnet'. |
54695 | 73 This list will be executed as a command after logging in via telnet." |
74 :type '(repeat string) | |
75 :group 'url-gateway) | |
76 | |
77 (defcustom url-gateway-telnet-login-prompt "^\r*.?login:" | |
110307 | 78 "Prompt that tells us we should send our username when loggin in w/telnet." |
54695 | 79 :type 'regexp |
80 :group 'url-gateway) | |
81 | |
82 (defcustom url-gateway-telnet-password-prompt "^\r*.?password:" | |
110307 | 83 "Prompt that tells us we should send our password when loggin in w/telnet." |
54695 | 84 :type 'regexp |
85 :group 'url-gateway) | |
86 | |
87 (defcustom url-gateway-telnet-user-name nil | |
88 "User name to log in via telnet with." | |
89 :type '(choice (const nil) string) | |
90 :group 'url-gateway) | |
91 | |
92 (defcustom url-gateway-telnet-password nil | |
93 "Password to use to log in via telnet with." | |
94 :type '(choice (const nil) string) | |
95 :group 'url-gateway) | |
96 | |
97 (defcustom url-gateway-broken-resolution nil | |
110307 | 98 "Whether to use nslookup to resolve hostnames. |
54695 | 99 This should be used when your version of Emacs cannot correctly use DNS, |
100 but your machine can. This usually happens if you are running a statically | |
96486
7369ded3b436
Typo and docstring fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
96361
diff
changeset
|
101 linked Emacs under SunOS 4.x." |
54695 | 102 :type 'boolean |
103 :group 'url-gateway) | |
104 | |
105 (defcustom url-gateway-nslookup-program "nslookup" | |
110307 | 106 "If non-nil then a string naming nslookup program." |
54695 | 107 :type '(choice (const :tag "None" :value nil) string) |
108 :group 'url-gateway) | |
109 | |
110 ;; Stolen from ange-ftp | |
111 ;;;###autoload | |
112 (defun url-gateway-nslookup-host (host) | |
113 "Attempt to resolve the given HOST using nslookup if possible." | |
114 (interactive "sHost: ") | |
115 (if url-gateway-nslookup-program | |
116 (let ((proc (start-process " *nslookup*" " *nslookup*" | |
117 url-gateway-nslookup-program host)) | |
118 (res host)) | |
57620
462b0b8865f7
(url-gateway-nslookup-host): Use `set-process-query-on-exit-flag'.
John Paul Wallington <jpw@pobox.com>
parents:
57612
diff
changeset
|
119 (set-process-query-on-exit-flag proc nil) |
70241
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
120 (with-current-buffer (process-buffer proc) |
54695 | 121 (while (memq (process-status proc) '(run open)) |
122 (accept-process-output proc)) | |
123 (goto-char (point-min)) | |
124 (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) | |
125 (setq res (buffer-substring (match-beginning 1) | |
126 (match-end 1)))) | |
127 (kill-buffer (current-buffer))) | |
128 res) | |
129 host)) | |
130 | |
131 ;; Stolen from red gnus nntp.el | |
132 (defun url-wait-for-string (regexp proc) | |
133 "Wait until string matching REGEXP arrives in process PROC's buffer." | |
134 (let ((buf (current-buffer))) | |
135 (goto-char (point-min)) | |
136 (while (not (re-search-forward regexp nil t)) | |
137 (accept-process-output proc) | |
138 (set-buffer buf) | |
139 (goto-char (point-min))))) | |
140 | |
141 ;; Stolen from red gnus nntp.el | |
142 (defun url-open-rlogin (name buffer host service) | |
143 "Open a connection using rsh." | |
144 (if (not (stringp service)) | |
145 (setq service (int-to-string service))) | |
146 (let ((proc (if url-gateway-rlogin-user-name | |
147 (start-process | |
148 name buffer "rsh" | |
149 url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name | |
150 (mapconcat 'identity | |
151 (append url-gateway-rlogin-parameters | |
152 (list host service)) " ")) | |
153 (start-process | |
154 name buffer "rsh" url-gateway-rlogin-host | |
155 (mapconcat 'identity | |
156 (append url-gateway-rlogin-parameters | |
157 (list host service)) | |
158 " "))))) | |
159 (set-buffer buffer) | |
160 (url-wait-for-string "^\r*200" proc) | |
161 (beginning-of-line) | |
162 (delete-region (point-min) (point)) | |
163 proc)) | |
164 | |
165 ;; Stolen from red gnus nntp.el | |
166 (defun url-open-telnet (name buffer host service) | |
167 (if (not (stringp service)) | |
168 (setq service (int-to-string service))) | |
70241
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
169 (with-current-buffer (get-buffer-create buffer) |
54695 | 170 (erase-buffer) |
171 (let ((proc (start-process name buffer "telnet" "-8")) | |
172 (case-fold-search t)) | |
173 (when (memq (process-status proc) '(open run)) | |
174 (process-send-string proc "set escape \^X\n") | |
175 (process-send-string proc (concat | |
176 "open " url-gateway-telnet-host "\n")) | |
177 (url-wait-for-string url-gateway-telnet-login-prompt proc) | |
178 (process-send-string | |
179 proc (concat | |
180 (or url-gateway-telnet-user-name | |
181 (setq url-gateway-telnet-user-name (read-string "login: "))) | |
182 "\n")) | |
183 (url-wait-for-string url-gateway-telnet-password-prompt proc) | |
184 (process-send-string | |
185 proc (concat | |
186 (or url-gateway-telnet-password | |
187 (setq url-gateway-telnet-password | |
57510
9f80571c6c3e
(url-open-telnet): Use read-passwd.
Richard M. Stallman <rms@gnu.org>
parents:
57449
diff
changeset
|
188 (read-passwd "Password: "))) |
54695 | 189 "\n")) |
190 (erase-buffer) | |
191 (url-wait-for-string url-gateway-prompt-pattern proc) | |
192 (process-send-string | |
193 proc (concat (mapconcat 'identity | |
194 (append url-gateway-telnet-parameters | |
195 (list host service)) " ") "\n")) | |
196 (url-wait-for-string "^\r*Escape character.*\r*\n+" proc) | |
197 (delete-region (point-min) (match-end 0)) | |
198 (process-send-string proc "\^]\n") | |
199 (url-wait-for-string "^telnet" proc) | |
200 (process-send-string proc "mode character\n") | |
201 (accept-process-output proc 1) | |
202 (sit-for 1) | |
203 (goto-char (point-min)) | |
204 (forward-line 1) | |
205 (delete-region (point) (point-max))) | |
206 proc))) | |
207 | |
208 ;;;###autoload | |
209 (defun url-open-stream (name buffer host service) | |
210 "Open a stream to HOST, possibly via a gateway. | |
211 Args per `open-network-stream'. | |
73501
437fb645afb4
* url-http.el (url-http-mark-connection-as-free): Verify that
Chong Yidong <cyd@stupidchicken.com>
parents:
70241
diff
changeset
|
212 Will not make a connection if `url-gateway-unplugged' is non-nil. |
437fb645afb4
* url-http.el (url-http-mark-connection-as-free): Verify that
Chong Yidong <cyd@stupidchicken.com>
parents:
70241
diff
changeset
|
213 Might do a non-blocking connection; use `process-status' to check." |
54695 | 214 (unless url-gateway-unplugged |
215 (let ((gw-method (if (and url-gateway-local-host-regexp | |
57449
202c408c174b
url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents:
54770
diff
changeset
|
216 (not (eq 'tls url-gateway-method)) |
54695 | 217 (not (eq 'ssl url-gateway-method)) |
218 (string-match | |
219 url-gateway-local-host-regexp | |
220 host)) | |
221 'native | |
222 url-gateway-method)) | |
223 ;;; ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF | |
224 ;;; ;; conversions while trying to be 'helpful' | |
225 ;;; (tcp-binary-process-output-services (if (stringp service) | |
226 ;;; (list service) | |
227 ;;; (list service | |
228 ;;; (int-to-string service)))) | |
229 | |
230 ;; An attempt to deal with denied connections, and attempt | |
231 ;; to reconnect | |
232 (cur-retries 0) | |
233 (retry t) | |
234 (errobj nil) | |
235 (conn nil)) | |
236 | |
237 ;; If the user told us to do DNS for them, do it. | |
238 (if url-gateway-broken-resolution | |
239 (setq host (url-gateway-nslookup-host host))) | |
240 | |
241 (condition-case errobj | |
242 ;; This is a clean way to ensure the new process inherits the | |
243 ;; right coding systems in both Emacs and XEmacs. | |
244 (let ((coding-system-for-read 'binary) | |
245 (coding-system-for-write 'binary)) | |
246 (setq conn (case gw-method | |
57449
202c408c174b
url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents:
54770
diff
changeset
|
247 (tls |
202c408c174b
url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents:
54770
diff
changeset
|
248 (open-tls-stream name buffer host service)) |
54695 | 249 (ssl |
250 (open-ssl-stream name buffer host service)) | |
251 ((native) | |
73501
437fb645afb4
* url-http.el (url-http-mark-connection-as-free): Verify that
Chong Yidong <cyd@stupidchicken.com>
parents:
70241
diff
changeset
|
252 ;; Use non-blocking socket if we can. |
437fb645afb4
* url-http.el (url-http-mark-connection-as-free): Verify that
Chong Yidong <cyd@stupidchicken.com>
parents:
70241
diff
changeset
|
253 (make-network-process :name name :buffer buffer |
437fb645afb4
* url-http.el (url-http-mark-connection-as-free): Verify that
Chong Yidong <cyd@stupidchicken.com>
parents:
70241
diff
changeset
|
254 :host host :service service |
74575
34a1ff09106b
(url-gateway-nslookup-program): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
73533
diff
changeset
|
255 :nowait |
73533
61352a6a6dcf
(url-open-stream): Really use asynchronous connections (accidentally
Magnus Henoch <mange@freemail.hu>
parents:
73501
diff
changeset
|
256 (featurep 'make-network-process '(:nowait t)))) |
54695 | 257 (socks |
258 (socks-open-network-stream name buffer host service)) | |
259 (telnet | |
260 (url-open-telnet name buffer host service)) | |
261 (rlogin | |
262 (url-open-rlogin name buffer host service)) | |
263 (otherwise | |
264 (error "Bad setting of url-gateway-method: %s" | |
265 url-gateway-method))))) | |
70241
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
266 ;; Ignoring errors here seems wrong. E.g. it'll throw away the |
96361
a99299e4d2de
American English spelling fix.
Glenn Morris <rgm@gnu.org>
parents:
94668
diff
changeset
|
267 ;; error signaled two lines above. It was also found inconvenient |
70241
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
268 ;; during debugging. |
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
269 ;; (error |
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
270 ;; (setq conn nil)) |
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
271 ) |
54695 | 272 conn))) |
273 | |
274 (provide 'url-gw) | |
54699 | 275 |
70241
07c1b5999e53
(url-open-stream): Don't hide errors.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
276 ;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 |
57612 | 277 ;;; url-gw.el ends here |