aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/misc/ChangeLog27
-rw-r--r--doc/misc/gnus.texi56
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/gnus/ChangeLog62
-rw-r--r--lisp/gnus/gnus-art.el4
-rw-r--r--lisp/gnus/gnus-registry.el20
-rw-r--r--lisp/gnus/gnus-sum.el6
-rw-r--r--lisp/gnus/gnus.el2
-rw-r--r--lisp/gnus/mail-source.el63
-rw-r--r--lisp/gnus/message.el2
-rw-r--r--lisp/gnus/nnimap.el81
-rw-r--r--lisp/gnus/nnir.el10
-rw-r--r--lisp/gnus/nnrss.el3
-rw-r--r--lisp/gnus/nntp.el6
-rw-r--r--lisp/gnus/webmail.el836
-rw-r--r--lisp/net/netrc.el32
-rw-r--r--lisp/net/tls.el21
17 files changed, 245 insertions, 996 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 8584e4c26b5..96522da7343 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,20 @@
12010-09-30 Teodor Zlatanov <tzz@lifelogs.com>
2
3 * gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove
4 nnimap-split-rule from examples.
5
62010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
7
8 * gnus.texi (Mail Source Specifiers): Remove webmail.el mentions.
9 (NNTP): Document nntp-server-list-active-group. Suggested by Barry
10 Fishman.
11 (Client-Side IMAP Splitting): Add nnimap-split-fancy.
12
132010-09-30 Julien Danjou <julien@danjou.info>
14
15 * gnus.texi (Gravatars): Fix documentation about
16 gnu-gravatar-properties.
17
12010-09-29 Daiki Ueno <ueno@unixuser.org> 182010-09-29 Daiki Ueno <ueno@unixuser.org>
2 19
3 * epa.texi (Bug Reports): New section. 20 * epa.texi (Bug Reports): New section.
@@ -6,6 +23,16 @@
6 23
7 * Makefile.in (top_srcdir): Remove unused variable. 24 * Makefile.in (top_srcdir): Remove unused variable.
8 25
262010-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
27
28 * gnus.texi (Using IMAP): Remove the @acronyms from the headings.
29 (Client-Side IMAP Splitting): Document 'default.
30
312010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
32
33 * gnus.texi (Customizing the IMAP Connection): Document
34 nnimap-fetch-partial-articles.
35
92010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> 362010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
10 37
11 * gnus-news.texi: Mention nnimap-inbox. 38 * gnus-news.texi: Mention nnimap-inbox.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 153c54d43b1..61a2171baac 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -14394,6 +14394,12 @@ inhibit Gnus to add a @code{Message-ID} header, you could say:
14394Note that not all servers support the recommended ID. This works for 14394Note that not all servers support the recommended ID. This works for
14395INN versions 2.3.0 and later, for instance. 14395INN versions 2.3.0 and later, for instance.
14396 14396
14397@item nntp-server-list-active-group
14398If @code{nil}, then always use @samp{GROUP} instead of @samp{LIST
14399ACTIVE}. This is usually slower, but on misconfigured servers that
14400don't update their active files often, this can help.
14401
14402
14397@end table 14403@end table
14398 14404
14399@menu 14405@menu
@@ -14836,7 +14842,7 @@ Here's an example method that's more complex:
14836 (nnimap-inbox "INBOX") 14842 (nnimap-inbox "INBOX")
14837 (nnimap-split-methods default) 14843 (nnimap-split-methods default)
14838 (nnimap-expunge t) 14844 (nnimap-expunge t)
14839 (nnimap-stream 'ssl) 14845 (nnimap-stream ssl)
14840 (nnir-search-engine imap) 14846 (nnir-search-engine imap)
14841 (nnimap-expunge-inbox t)) 14847 (nnimap-expunge-inbox t))
14842@end example 14848@end example
@@ -14906,6 +14912,9 @@ Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting
14906Mail}), except the symbol @code{default}, which means that it should 14912Mail}), except the symbol @code{default}, which means that it should
14907use the value of the @code{nnmail-split-methods} variable. 14913use the value of the @code{nnmail-split-methods} variable.
14908 14914
14915@item nnimap-split-fancy
14916Uses the same syntax as @code{nnmail-split-fancy}.
14917
14909@end table 14918@end table
14910 14919
14911 14920
@@ -15559,45 +15568,6 @@ An example @acronym{IMAP} mail source:
15559 :fetchflag "\\Seen") 15568 :fetchflag "\\Seen")
15560@end lisp 15569@end lisp
15561 15570
15562@item webmail
15563Get mail from a webmail server, such as @uref{http://www.hotmail.com/},
15564@uref{http://webmail.netscape.com/}, @uref{http://www.netaddress.com/},
15565@uref{http://mail.yahoo.com/}.
15566
15567NOTE: Webmail largely depends on cookies. A "one-line-cookie" patch is
15568required for url "4.0pre.46".
15569
15570WARNING: Mails may be lost. NO WARRANTY.
15571
15572Keywords:
15573
15574@table @code
15575@item :subtype
15576The type of the webmail server. The default is @code{hotmail}. The
15577alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}.
15578
15579@item :user
15580The user name to give to the webmail server. The default is the login
15581name.
15582
15583@item :password
15584The password to give to the webmail server. If not specified, the user is
15585prompted.
15586
15587@item :dontexpunge
15588If non-@code{nil}, only fetch unread articles and don't move them to
15589trash folder after finishing the fetch.
15590
15591@end table
15592
15593An example webmail source:
15594
15595@lisp
15596(webmail :subtype 'hotmail
15597 :user "user-name"
15598 :password "secret")
15599@end lisp
15600
15601@item group 15571@item group
15602Get the actual mail source from the @code{mail-source} group parameter, 15572Get the actual mail source from the @code{mail-source} group parameter,
15603@xref{Group Parameters}. 15573@xref{Group Parameters}.
@@ -24196,8 +24166,8 @@ From Ted Zlatanov <tzz@@lifelogs.com>.
24196 spam-move-spam-nonspam-groups-only nil 24166 spam-move-spam-nonspam-groups-only nil
24197 spam-mark-only-unseen-as-spam t 24167 spam-mark-only-unseen-as-spam t
24198 spam-mark-ham-unread-before-move-from-spam-group t 24168 spam-mark-ham-unread-before-move-from-spam-group t
24199 nnimap-split-rule 'nnimap-split-fancy
24200 ;; @r{understand what this does before you copy it to your own setup!} 24169 ;; @r{understand what this does before you copy it to your own setup!}
24170 ;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual}
24201 nnimap-split-fancy '(| 24171 nnimap-split-fancy '(|
24202 ;; @r{trace references to parents and put in their group} 24172 ;; @r{trace references to parents and put in their group}
24203 (: gnus-registry-split-fancy-with-parent) 24173 (: gnus-registry-split-fancy-with-parent)
@@ -24919,8 +24889,8 @@ messages stay in @samp{INBOX}:
24919@example 24889@example
24920(setq spam-use-spamoracle t 24890(setq spam-use-spamoracle t
24921 spam-split-group "Junk" 24891 spam-split-group "Junk"
24892 ;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual}
24922 nnimap-split-inbox '("INBOX") 24893 nnimap-split-inbox '("INBOX")
24923 nnimap-split-rule 'nnimap-split-fancy
24924 nnimap-split-fancy '(| (: spam-split) "INBOX")) 24894 nnimap-split-fancy '(| (: spam-split) "INBOX"))
24925@end example 24895@end example
24926 24896
@@ -26239,7 +26209,7 @@ wrong show.
26239Masanobu @sc{Umeda}---the writer of the original @sc{gnus}. 26209Masanobu @sc{Umeda}---the writer of the original @sc{gnus}.
26240 26210
26241@item 26211@item
26242Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el, webmail.el, 26212Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el,
26243nnwarchive and many, many other things connected with @acronym{MIME} and 26213nnwarchive and many, many other things connected with @acronym{MIME} and
26244other types of en/decoding, as well as general bug fixing, new 26214other types of en/decoding, as well as general bug fixing, new
26245functionality and stuff. 26215functionality and stuff.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b23262bc367..b93b34a4fcb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * tls.el (tls-starttls-switches): New variable.
4 (tls-find-starttls-argument): Use it.
5 (open-tls-stream): Ditto.
6
71 * netrc.el (netrc-credentials): Return the value of the "default"
8 entry.
9 (netrc-machine): Ditto.
10
12010-09-30 Eli Zaretskii <eliz@gnu.org> 112010-09-30 Eli Zaretskii <eliz@gnu.org>
2 12
3 * vc/vc-hooks.el (vc-default-mode-line-string): Doc fix. 13 * vc/vc-hooks.el (vc-default-mode-line-string): Doc fix.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ee5ea776572..5477fa7cd0f 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,59 @@
12010-09-30 Teodor Zlatanov <tzz@lifelogs.com>
2
3 * gnus-registry.el (gnus-registry-install-nnregistry): New function to
4 install the nnregistry refer method.
5 (gnus-registry-install-hooks): Use it.
6 (gnus-registry-unfollowed-groups): Add nnmairix to the default
7 unfollowed groups.
8
92010-09-30 Jose A. Ortega Ruiz <jao@gnu.org> (tiny change)
10
11 * gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when
12 expanding threads.
13
142010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
15
16 * nnir.el: Use the server names without suffixes (bug #7009).
17
18 * nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from
19 unencrypted to STARTTLS, if possible.
20
212010-09-30 Teemu Likonen <tlikonen@iki.fi> (tiny change)
22
23 * message.el (message-ignored-supersedes-headers): Strip Injection-*
24 headers before superseding.
25
262010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
27
28 * nnrss.el (nnrss-use-local): Add documentation.
29
30 * nnimap.el (nnimap-extend-tls-programs): New function.
31 (nnimap-open-connection): Use tls.el exclusively, and not starttls.el.
32 (nnimap-wait-for-connection): Accept the greeting from the stupid
33 output from openssl s_client -starttls, too.
34
35 * nnimap.el (nnimap-find-article-by-message-id): Really return the
36 article number.
37 (nnimap-split-fancy): New variable.
38 (nnimap-split-incoming-mail): Use it.
39
40 * nntp.el (nntp-server-list-active-group): Document.
41
42 * nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of
43 SELECT to get the message-id.
44
45 * mail-source.el (mail-sources): Removed webmail support.
46 (defvar): Ditto.
47 (mail-source-fetcher-alist): Ditto.
48 (mail-source-fetch-webmail): Removed.
49
50 * webmail.el: Removed -- doesn't seem relevant any more.
51
52 * gnus.el: Fix up make-obsolete-variable declarations throughout.
53
54 * nnimap.el (nnimap-request-accept-article): Get the Message-ID without
55 the \r.
56
12010-09-30 Julien Danjou <julien@danjou.info> 572010-09-30 Julien Danjou <julien@danjou.info>
2 58
3 * gnus-agent.el (gnus-agent-add-group): Fix call to 59 * gnus-agent.el (gnus-agent-add-group): Fix call to
@@ -44,11 +100,13 @@
44 (nnimap-request-accept-article): Add \r\n to the lines to make this 100 (nnimap-request-accept-article): Add \r\n to the lines to make this
45 work with Cyrus. 101 work with Cyrus.
46 102
47 * nnregistry.el: Added.
48
49 * nndraft.el (nndraft-request-expire-articles): Use the group name 103 * nndraft.el (nndraft-request-expire-articles): Use the group name
50 instead if "nndraft". Fix found by Nils Ackermann. 104 instead if "nndraft". Fix found by Nils Ackermann.
51 105
1062010-09-29 Ludovic Courtes <ludo@gnu.org>
107
108 * nnregistry.el: Added.
109
522010-09-29 Stefan Monnier <monnier@iro.umontreal.ca> 1102010-09-29 Stefan Monnier <monnier@iro.umontreal.ca>
53 111
54 * nnmail.el (group, group-art-list, group-art): 112 * nnmail.el (group, group-art-list, group-art):
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4e2d43cc65d..91ff355b6d2 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -725,7 +725,7 @@ Each element is a regular expression."
725 :group 'gnus-article-various) 725 :group 'gnus-article-various)
726 726
727(make-obsolete-variable 'gnus-article-hide-pgp-hook nil 727(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
728 "Gnus 5.10 (Emacs-22.1)") 728 "Gnus 5.10 (Emacs 22.1)")
729 729
730(defface gnus-button 730(defface gnus-button
731 '((t (:weight bold))) 731 '((t (:weight bold)))
@@ -1412,7 +1412,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
1412 :type gnus-article-treat-custom) 1412 :type gnus-article-treat-custom)
1413 1413
1414(make-obsolete-variable 'gnus-treat-display-xface 1414(make-obsolete-variable 'gnus-treat-display-xface
1415 'gnus-treat-display-x-face "22.1") 1415 'gnus-treat-display-x-face "Emacs 22.1")
1416 1416
1417(defcustom gnus-treat-display-x-face 1417(defcustom gnus-treat-display-x-face
1418 (and (not noninteractive) 1418 (and (not noninteractive)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index c7dd012d533..4e6dca536a9 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -122,12 +122,14 @@ display."
122 :type 'symbol) 122 :type 'symbol)
123 123
124(defcustom gnus-registry-unfollowed-groups 124(defcustom gnus-registry-unfollowed-groups
125 '("delayed$" "drafts$" "queue$" "INBOX$") 125 '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:")
126 "List of groups that gnus-registry-split-fancy-with-parent won't return. 126 "List of groups that gnus-registry-split-fancy-with-parent won't return.
127The group names are matched, they don't have to be fully 127The group names are matched, they don't have to be fully
128qualified. This parameter tells the Registry 'never split a 128qualified. This parameter tells the Registry 'never split a
129message into a group that matches one of these, regardless of 129message into a group that matches one of these, regardless of
130references.'" 130references.'
131
132nnmairix groups are specifically excluded because they are ephemeral."
131 :group 'gnus-registry 133 :group 'gnus-registry
132 :type '(repeat regexp)) 134 :type '(repeat regexp))
133 135
@@ -1127,6 +1129,7 @@ Returns the first place where the trail finds a group name."
1127 (setq gnus-registry-install t) ; in case it was 'ask or nil 1129 (setq gnus-registry-install t) ; in case it was 'ask or nil
1128 (gnus-registry-install-hooks) 1130 (gnus-registry-install-hooks)
1129 (gnus-registry-install-shortcuts) 1131 (gnus-registry-install-shortcuts)
1132 (gnus-registry-install-nnregistry)
1130 (gnus-registry-read)) 1133 (gnus-registry-read))
1131 1134
1132;;;###autoload 1135;;;###autoload
@@ -1143,6 +1146,19 @@ Returns the first place where the trail finds a group name."
1143 1146
1144 (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) 1147 (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
1145 1148
1149;;;###autoload
1150(defun gnus-registry-install-nnregistry ()
1151 "Install the nnregistry refer method in `gnus-refer-article-method'."
1152 (interactive)
1153 (when (featurep 'nnregistry)
1154 (setq gnus-refer-article-method
1155 (delete-dups
1156 (append
1157 (if (listp gnus-refer-article-method)
1158 gnus-refer-article-method
1159 (list gnus-refer-article-method))
1160 (list 'nnregistry))))))
1161
1146(defun gnus-registry-unload-hook () 1162(defun gnus-registry-unload-hook ()
1147 "Uninstall the registry hooks." 1163 "Uninstall the registry hooks."
1148 (interactive) 1164 (interactive)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 4cd716803b6..cc1c3823c9f 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -11327,15 +11327,19 @@ For compatibility with XEmacs."
11327 (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) 11327 (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
11328 (gnus-summary-position-point)) 11328 (gnus-summary-position-point))
11329 11329
11330(defsubst gnus-summary--inv (p)
11331 (and (eq (get-char-property p 'invisible) 'gnus-sum) p))
11332
11330(defun gnus-summary-show-thread () 11333(defun gnus-summary-show-thread ()
11331 "Show thread subtrees. 11334 "Show thread subtrees.
11332Returns nil if no thread was there to be shown." 11335Returns nil if no thread was there to be shown."
11333 (interactive) 11336 (interactive)
11334 (let* ((orig (point)) 11337 (let* ((orig (point))
11335 (end (point-at-eol)) 11338 (end (point-at-eol))
11339 (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
11336 ;; Leave point at bol 11340 ;; Leave point at bol
11337 (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) 11341 (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
11338 (eoi (when (eq (get-char-property end 'invisible) 'gnus-sum) 11342 (eoi (when end
11339 (if (fboundp 'next-single-char-property-change) 11343 (if (fboundp 'next-single-char-property-change)
11340 (or (next-single-char-property-change end 'invisible) 11344 (or (next-single-char-property-change end 'invisible)
11341 (point-max)) 11345 (point-max))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 53a30efd22e..9f2ea1e3471 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1427,7 +1427,7 @@ no need to set this variable."
1427 :group 'gnus-message 1427 :group 'gnus-message
1428 :type '(choice (const :tag "default" nil) 1428 :type '(choice (const :tag "default" nil)
1429 string)) 1429 string))
1430(make-obsolete-variable 'gnus-local-domain nil "24.1") 1430(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
1431 1431
1432(defvar gnus-local-organization nil 1432(defvar gnus-local-organization nil
1433 "String with a description of what organization (if any) the user belongs to. 1433 "String with a description of what organization (if any) the user belongs to.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 648ca29b87f..80a1d8846d9 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -219,34 +219,6 @@ See Info node `(gnus)Mail Source Specifiers'."
219 (boolean :tag "Dontexpunge")) 219 (boolean :tag "Dontexpunge"))
220 (group :inline t 220 (group :inline t
221 (const :format "" :value :plugged) 221 (const :format "" :value :plugged)
222 (boolean :tag "Plugged"))))
223 (cons :tag "Webmail server"
224 (const :format "" webmail)
225 (checklist :tag "Options" :greedy t
226 (group :inline t
227 (const :format "" :value :subtype)
228 ;; Should be generated from
229 ;; `webmail-type-definition', but we
230 ;; can't require webmail without W3.
231 (choice :tag "Subtype"
232 :value hotmail
233 (const hotmail)
234 (const yahoo)
235 (const netaddress)
236 (const netscape)
237 (const my-deja)))
238 (group :inline t
239 (const :format "" :value :user)
240 (string :tag "User"))
241 (group :inline t
242 (const :format "" :value :password)
243 (string :tag "Password"))
244 (group :inline t
245 (const :format ""
246 :value :dontexpunge)
247 (boolean :tag "Dontexpunge"))
248 (group :inline t
249 (const :format "" :value :plugged)
250 (boolean :tag "Plugged")))))))) 222 (boolean :tag "Plugged"))))))))
251 223
252(defcustom mail-source-ignore-errors nil 224(defcustom mail-source-ignore-errors nil
@@ -387,13 +359,7 @@ Common keywords should be listed here.")
387 (:prescript) 359 (:prescript)
388 (:prescript-delay) 360 (:prescript-delay)
389 (:postscript) 361 (:postscript)
390 (:dontexpunge)) 362 (:dontexpunge)))
391 (webmail
392 (:subtype hotmail)
393 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
394 (:password)
395 (:dontexpunge)
396 (:authentication password)))
397 "Mapping from keywords to default values. 363 "Mapping from keywords to default values.
398All keywords that can be used must be listed here.")) 364All keywords that can be used must be listed here."))
399 365
@@ -402,8 +368,7 @@ All keywords that can be used must be listed here."))
402 (directory mail-source-fetch-directory) 368 (directory mail-source-fetch-directory)
403 (pop mail-source-fetch-pop) 369 (pop mail-source-fetch-pop)
404 (maildir mail-source-fetch-maildir) 370 (maildir mail-source-fetch-maildir)
405 (imap mail-source-fetch-imap) 371 (imap mail-source-fetch-imap))
406 (webmail mail-source-fetch-webmail))
407 "A mapping from source type to fetcher function.") 372 "A mapping from source type to fetcher function.")
408 373
409(defvar mail-source-password-cache nil) 374(defvar mail-source-password-cache nil)
@@ -1138,30 +1103,6 @@ This only works when `display-time' is enabled."
1138 ?s server ?P port ?u user)) 1103 ?s server ?P port ?u user))
1139 found))) 1104 found)))
1140 1105
1141(autoload 'webmail-fetch "webmail")
1142
1143(defun mail-source-fetch-webmail (source callback)
1144 "Fetch for webmail source."
1145 (mail-source-bind (webmail source)
1146 (let ((mail-source-string (format "webmail:%s:%s" subtype user))
1147 (webmail-newmail-only dontexpunge)
1148 (webmail-move-to-trash-can (not dontexpunge)))
1149 (when (eq authentication 'password)
1150 (setq password
1151 (or password
1152 (cdr (assoc (format "webmail:%s:%s" subtype user)
1153 mail-source-password-cache))
1154 (read-passwd
1155 (format "Password for %s at %s: " user subtype))))
1156 (when (and password
1157 (not (assoc (format "webmail:%s:%s" subtype user)
1158 mail-source-password-cache)))
1159 (push (cons (format "webmail:%s:%s" subtype user) password)
1160 mail-source-password-cache)))
1161 (webmail-fetch mail-source-crash-box subtype user password)
1162 (mail-source-callback callback (symbol-name subtype))
1163 (mail-source-delete-crash-box))))
1164
1165(provide 'mail-source) 1106(provide 'mail-source)
1166 1107
1167;;; mail-source.el ends here 1108;;; mail-source.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index b0738f74b6d..59d3485f7d7 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -283,7 +283,7 @@ This is a list of regexps and regexp matches."
283 :link '(custom-manual "(message)Mail Headers") 283 :link '(custom-manual "(message)Mail Headers")
284 :type 'regexp) 284 :type 'regexp)
285 285
286(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:" 286(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:"
287 "*Header lines matching this regexp will be deleted before posting. 287 "*Header lines matching this regexp will be deleted before posting.
288It's best to delete old Path and Date headers before posting to avoid 288It's best to delete old Path and Date headers before posting to avoid
289any confusion." 289any confusion."
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 1dd561ab6ac..4d26cdb6371 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -38,6 +38,7 @@
38(require 'nnoo) 38(require 'nnoo)
39(require 'netrc) 39(require 'netrc)
40(require 'utf7) 40(require 'utf7)
41(require 'tls)
41(require 'parse-time) 42(require 'parse-time)
42 43
43(autoload 'auth-source-forget-user-or-password "auth-source") 44(autoload 'auth-source-forget-user-or-password "auth-source")
@@ -70,8 +71,11 @@ Values are `ssl', `network', `starttls' or `shell'.")
70 "How mail is split. 71 "How mail is split.
71Uses the same syntax as nnmail-split-methods") 72Uses the same syntax as nnmail-split-methods")
72 73
74(defvoo nnimap-split-fancy nil
75 "Uses the same syntax as nnmail-split-fancy.")
76
73(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" 77(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
74 "Gnus 5.13") 78 "Emacs 24.1")
75 79
76(defvoo nnimap-authenticator nil 80(defvoo nnimap-authenticator nil
77 "How nnimap authenticate itself to the server. 81 "How nnimap authenticate itself to the server.
@@ -306,9 +310,11 @@ textual parts.")
306 (setq port (or nnimap-server-port "imap"))) 310 (setq port (or nnimap-server-port "imap")))
307 '("imap")) 311 '("imap"))
308 ((eq nnimap-stream 'starttls) 312 ((eq nnimap-stream 'starttls)
309 (starttls-open-stream 313 (let ((tls-program (nnimap-extend-tls-programs)))
310 "*nnimap*" (current-buffer) nnimap-address 314 (open-tls-stream
311 (setq port (or nnimap-server-port "imap"))) 315 "*nnimap*" (current-buffer) nnimap-address
316 (setq port (or nnimap-server-port "imap"))
317 'starttls))
312 '("imap")) 318 '("imap"))
313 ((eq nnimap-stream 'ssl) 319 ((eq nnimap-stream 'ssl)
314 (open-tls-stream 320 (open-tls-stream
@@ -342,11 +348,23 @@ textual parts.")
342 #'upcase 348 #'upcase
343 (nnimap-find-parameter 349 (nnimap-find-parameter
344 "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))) 350 "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
345 (when (eq nnimap-stream 'starttls)
346 (nnimap-command "STARTTLS")
347 (starttls-negotiate (nnimap-process nnimap-object)))
348 (when nnimap-server-port 351 (when nnimap-server-port
349 (push (format "%s" nnimap-server-port) ports)) 352 (push (format "%s" nnimap-server-port) ports))
353 ;; If this is a STARTTLS-capable server, then sever the
354 ;; connection and start a STARTTLS connection instead.
355 (when (and (eq nnimap-stream 'network)
356 (member "STARTTLS" (nnimap-capabilities nnimap-object)))
357 (let ((nnimap-stream 'starttls))
358 (let ((tls-process
359 (nnimap-open-connection buffer)))
360 ;; If the STARTTLS connection was successful, we
361 ;; kill our first non-encrypted connection. If it
362 ;; wasn't successful, we just use our unencrypted
363 ;; connection.
364 (when (memq (process-status tls-process) '(open run))
365 (delete-process (nnimap-process nnimap-object))
366 (kill-buffer (current-buffer))
367 (return tls-process)))))
350 (unless (equal connection-result "PREAUTH") 368 (unless (equal connection-result "PREAUTH")
351 (if (not (setq credentials 369 (if (not (setq credentials
352 (if (eq nnimap-authenticator 'anonymous) 370 (if (eq nnimap-authenticator 'anonymous)
@@ -378,7 +396,16 @@ textual parts.")
378 (when nnimap-object 396 (when nnimap-object
379 (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) 397 (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
380 (nnimap-command "ENABLE QRESYNC")) 398 (nnimap-command "ENABLE QRESYNC"))
381 t))))))) 399 (nnimap-process nnimap-object))))))))
400
401(defun nnimap-extend-tls-programs ()
402 (let ((programs tls-program)
403 result)
404 (unless (consp programs)
405 (setq programs (list programs)))
406 (dolist (program programs)
407 (push (concat program " " "%s") result))
408 (nreverse result)))
382 409
383(defun nnimap-find-parameter (parameter elems) 410(defun nnimap-find-parameter (parameter elems)
384 (let (result) 411 (let (result)
@@ -729,16 +756,20 @@ textual parts.")
729 756
730 757
731(defun nnimap-find-article-by-message-id (group message-id) 758(defun nnimap-find-article-by-message-id (group message-id)
732 (when (nnimap-possibly-change-group group nil) 759 (with-current-buffer (nnimap-buffer)
733 (with-current-buffer (nnimap-buffer) 760 (erase-buffer)
734 (let ((result 761 (setf (nnimap-group nnimap-object) nil)
735 (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id)) 762 (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
736 article) 763 (let ((sequence
737 (when (car result) 764 (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id))
738 ;; Select the last instance of the message in the group. 765 article result)
739 (and (setq article 766 (setq result (nnimap-wait-for-response sequence))
740 (car (last (assoc "SEARCH" (cdr result))))) 767 (when (and result
741 (string-to-number article))))))) 768 (car (setq result (nnimap-parse-response))))
769 ;; Select the last instance of the message in the group.
770 (and (setq article
771 (car (last (assoc "SEARCH" (cdr result)))))
772 (string-to-number article))))))
742 773
743(defun nnimap-delete-article (articles) 774(defun nnimap-delete-article (articles)
744 (with-current-buffer (nnimap-buffer) 775 (with-current-buffer (nnimap-buffer)
@@ -796,10 +827,10 @@ textual parts.")
796(deffoo nnimap-request-accept-article (group &optional server last) 827(deffoo nnimap-request-accept-article (group &optional server last)
797 (when (nnimap-possibly-change-group nil server) 828 (when (nnimap-possibly-change-group nil server)
798 (nnmail-check-syntax) 829 (nnmail-check-syntax)
799 (nnimap-add-cr) 830 (let ((message-id (message-field-value "message-id"))
800 (let ((message (buffer-string)) 831 sequence message)
801 (message-id (message-field-value "message-id")) 832 (nnimap-add-cr)
802 sequence) 833 (setq message (buffer-string))
803 (with-current-buffer (nnimap-buffer) 834 (with-current-buffer (nnimap-buffer)
804 (setq sequence (nnimap-send-command 835 (setq sequence (nnimap-send-command
805 "APPEND %S {%d}" (utf7-encode group t) 836 "APPEND %S {%d}" (utf7-encode group t)
@@ -1183,11 +1214,11 @@ textual parts.")
1183 (goto-char (point-min)) 1214 (goto-char (point-min))
1184 (while (and (memq (process-status process) 1215 (while (and (memq (process-status process)
1185 '(open run)) 1216 '(open run))
1186 (not (re-search-forward "^\\* .*\n" nil t))) 1217 (not (re-search-forward "^[*.] .*\n" nil t)))
1187 (nnheader-accept-process-output process) 1218 (nnheader-accept-process-output process)
1188 (goto-char (point-min))) 1219 (goto-char (point-min)))
1189 (forward-line -1) 1220 (forward-line -1)
1190 (and (looking-at "\\* \\([A-Z0-9]+\\)") 1221 (and (looking-at "[*.] \\([A-Z0-9]+\\)")
1191 (match-string 1)))) 1222 (match-string 1))))
1192 1223
1193(defun nnimap-wait-for-response (sequence &optional messagep) 1224(defun nnimap-wait-for-response (sequence &optional messagep)
@@ -1299,6 +1330,8 @@ textual parts.")
1299 (nnmail-split-methods (if (eq nnimap-split-methods 'default) 1330 (nnmail-split-methods (if (eq nnimap-split-methods 'default)
1300 nnmail-split-methods 1331 nnmail-split-methods
1301 nnimap-split-methods)) 1332 nnimap-split-methods))
1333 (nnmail-split-fancy (or nnimap-split-fancy
1334 nnmail-split-fancy))
1302 (nnmail-inhibit-default-split-group t) 1335 (nnmail-inhibit-default-split-group t)
1303 (groups (nnimap-get-groups)) 1336 (groups (nnimap-get-groups))
1304 new-articles) 1337 new-articles)
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 455a0fdaa6e..de304bf216b 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -881,7 +881,9 @@ ready to be added to the list of search results."
881 (when (file-readable-p (concat prefix dirnam article)) 881 (when (file-readable-p (concat prefix dirnam article))
882 ;; remove trailing slash and, for nnmaildir, cur/new/tmp 882 ;; remove trailing slash and, for nnmaildir, cur/new/tmp
883 (setq dirnam 883 (setq dirnam
884 (substring dirnam 0 (if (string= server "nnmaildir:") -5 -1))) 884 (substring dirnam 0
885 (if (string= (gnus-group-server server) "nnmaildir")
886 -5 -1)))
885 887
886 ;; Set group to dirnam without any leading dots or slashes, 888 ;; Set group to dirnam without any leading dots or slashes,
887 ;; and with all subsequent slashes replaced by dots 889 ;; and with all subsequent slashes replaced by dots
@@ -890,7 +892,7 @@ ready to be added to the list of search results."
890 "[/\\]" "." t))) 892 "[/\\]" "." t)))
891 893
892 (vector (nnir-group-full-name group server) 894 (vector (nnir-group-full-name group server)
893 (if (string= server "nnmaildir:") 895 (if (string= (gnus-group-server server) "nnmaildir")
894 (nnmaildir-base-name-to-article-number 896 (nnmaildir-base-name-to-article-number
895 (substring article 0 (string-match ":" article)) 897 (substring article 0 (string-match ":" article))
896 group nil) 898 group nil)
@@ -1200,7 +1202,7 @@ Windows NT 4.0."
1200 ;; is sufficient. Note that we can't only use the value of 1202 ;; is sufficient. Note that we can't only use the value of
1201 ;; nnml-use-compressed-files because old articles might have been 1203 ;; nnml-use-compressed-files because old articles might have been
1202 ;; saved with a different value. 1204 ;; saved with a different value.
1203 (article-pattern (if (string= server "nnmaildir:") 1205 (article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1204 ":[0-9]+" 1206 ":[0-9]+"
1205 "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) 1207 "^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
1206 score artno dirnam filenam) 1208 score artno dirnam filenam)
@@ -1450,7 +1452,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
1450 (when group 1452 (when group
1451 (error "The Namazu backend cannot search specific groups")) 1453 (error "The Namazu backend cannot search specific groups"))
1452 (save-excursion 1454 (save-excursion
1453 (let ((article-pattern (if (string= server "nnmaildir:") 1455 (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1454 ":[0-9]+" 1456 ":[0-9]+"
1455 "^[0-9]+$")) 1457 "^[0-9]+$"))
1456 artlist 1458 artlist
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 94fd55ebbfb..32b4f4f116f 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -77,7 +77,8 @@ this variable to the list of fields to be ignored.")
77(defvar nnrss-group-alist '() 77(defvar nnrss-group-alist '()
78 "List of RSS addresses.") 78 "List of RSS addresses.")
79 79
80(defvar nnrss-use-local nil) 80(defvar nnrss-use-local nil
81 "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
81 82
82(defvar nnrss-description-field 'X-Gnus-Description 83(defvar nnrss-description-field 'X-Gnus-Description
83 "Field name used for DESCRIPTION. 84 "Field name used for DESCRIPTION.
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 1bf2ce1e368..ced15a92838 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -267,6 +267,11 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
267 "*Hook run just before posting an article. It is supposed to be used 267 "*Hook run just before posting an article. It is supposed to be used
268to insert Cancel-Lock headers.") 268to insert Cancel-Lock headers.")
269 269
270(defvoo nntp-server-list-active-group 'try
271 "If nil, then always use GROUP instead of LIST ACTIVE.
272This is usually slower, but on misconfigured servers that don't
273update their active files often, this can help.")
274
270;;; Internal variables. 275;;; Internal variables.
271 276
272(defvar nntp-record-commands nil 277(defvar nntp-record-commands nil
@@ -296,7 +301,6 @@ to insert Cancel-Lock headers.")
296(defvoo nntp-inhibit-output nil) 301(defvoo nntp-inhibit-output nil)
297 302
298(defvoo nntp-server-xover 'try) 303(defvoo nntp-server-xover 'try)
299(defvoo nntp-server-list-active-group 'try)
300 304
301(defvar nntp-async-timer nil) 305(defvar nntp-async-timer nil)
302(defvar nntp-async-process-list nil) 306(defvar nntp-async-process-list nil)
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
deleted file mode 100644
index f3b88490855..00000000000
--- a/lisp/gnus/webmail.el
+++ /dev/null
@@ -1,836 +0,0 @@
1;;; webmail.el --- interface of web mail
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7;; Keywords: hotmail netaddress
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
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
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Note: Now mail.yahoo.com provides POP3 service, the webmail
27;; fetching is not going to be supported.
28
29;; Note: You need to have `url' and `w3' installed for this backend to
30;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
31;; `url'.
32
33;; Todo: To support more web mail servers.
34
35;; Known bugs:
36;; 1. Net@ddress may corrupt `X-Face'.
37
38;; Warning:
39;; Webmail is an experimental function, which means NO WARRANTY.
40
41;;; Code:
42
43(eval-when-compile (require 'cl))
44
45(require 'nnoo)
46(require 'message)
47(require 'gnus-util)
48(require 'gnus)
49(require 'nnmail)
50(require 'mm-util)
51(require 'mm-url)
52(require 'mml)
53(eval-when-compile
54 (ignore-errors
55 (require 'url)
56 (require 'url-cookie)))
57;; Report failure to find w3 at load time if appropriate.
58(eval '(progn
59 (require 'url)
60 (require 'url-cookie)))
61
62;;;
63
64(defvar webmail-type-definition
65 '((hotmail
66 ;; Hotmail hate other HTTP user agents and use one line cookie
67 (paranoid agent cookie post)
68 (address . "www.hotmail.com")
69 (open-url "http://www.hotmail.com/")
70 (open-snarf . webmail-hotmail-open)
71 ;; W3 hate redirect POST
72 (login-url
73 "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
74 webmail-aux user password)
75 ;;(login-snarf . webmail-hotmail-login)
76 ;;(list-url "%s" webmail-aux)
77 (list-snarf . webmail-hotmail-list)
78 (article-snarf . webmail-hotmail-article)
79 (trash-url
80 "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
81 webmail-aux user id))
82 (yahoo
83 (paranoid agent cookie post)
84 (address . "mail.yahoo.com")
85 (open-url "http://mail.yahoo.com/")
86 (open-snarf . webmail-yahoo-open)
87 (login-url;; yahoo will not accept GET
88 content
89 ("%s" webmail-aux)
90 ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s"
91 user password)
92 (login-snarf . webmail-yahoo-login)
93 (list-url "%s&rb=Inbox&YN=1" webmail-aux)
94 (list-snarf . webmail-yahoo-list)
95 (article-snarf . webmail-yahoo-article)
96 (trash-url
97 "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2="
98 webmail-aux id))
99 (netaddress
100 (paranoid cookie post)
101 (address . "www.netaddress.com")
102 (open-url "http://www.netaddress.com/")
103 (open-snarf . webmail-netaddress-open)
104 (login-url
105 content
106 ("%s" webmail-aux)
107 "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s"
108 user password)
109 (login-snarf . webmail-netaddress-login)
110 (list-url
111 "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
112 webmail-session)
113 (list-snarf . webmail-netaddress-list)
114 (article-url "http://www.netaddress.com/")
115 (article-snarf . webmail-netaddress-article)
116 (trash-url
117 "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
118 webmail-session id))))
119
120(defvar webmail-variables
121 '(address article-snarf article-url list-snarf list-url
122 login-url login-snarf open-url open-snarf site articles
123 post-process paranoid trash-url))
124
125(defconst webmail-version "webmail 1.0")
126
127(defvar webmail-newmail-only nil
128 "Only fetch new mails.")
129
130(defvar webmail-move-to-trash-can t
131 "Move mail to trash can after fetch it.")
132
133;;; Internal variables
134
135(defvar webmail-address nil)
136(defvar webmail-paranoid nil)
137(defvar webmail-aux nil)
138(defvar webmail-session nil)
139(defvar webmail-article-snarf nil)
140(defvar webmail-article-url nil)
141(defvar webmail-list-snarf nil)
142(defvar webmail-list-url nil)
143(defvar webmail-login-url nil)
144(defvar webmail-login-snarf nil)
145(defvar webmail-open-snarf nil)
146(defvar webmail-open-url nil)
147(defvar webmail-trash-url nil)
148(defvar webmail-articles nil)
149(defvar webmail-post-process nil)
150
151(defvar webmail-buffer nil)
152(defvar webmail-buffer-list nil)
153
154(defvar webmail-type nil)
155
156(defvar webmail-error-function nil)
157
158(defvar webmail-debug-file "~/.emacs-webmail-debug")
159
160;;; Interface functions
161
162(defun webmail-debug (str)
163 (with-temp-buffer
164 (insert "\n---------------- A bug at " str " ------------------\n")
165 (dolist (sym '(webmail-type user))
166 (if (boundp sym)
167 (gnus-pp `(setq ,sym ',(eval sym)))))
168 (insert "---------------- webmail buffer ------------------\n\n")
169 (insert-buffer-substring webmail-buffer)
170 (insert "\n---------------- end of buffer ------------------\n\n")
171 (append-to-file (point-min) (point-max) webmail-debug-file)))
172
173(defun webmail-error (str)
174 (if webmail-error-function
175 (funcall webmail-error-function str))
176 (message "%s HTML has changed or your w3 package is too old.(%s)"
177 webmail-type str)
178 (error "%s HTML has changed or your w3 package is too old.(%s)"
179 webmail-type str))
180
181(defun webmail-setdefault (type)
182 (let ((type-def (cdr (assq type webmail-type-definition)))
183 (vars webmail-variables)
184 pair)
185 (setq webmail-type type)
186 (dolist (var vars)
187 (if (setq pair (assq var type-def))
188 (set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
189 (set (intern (concat "webmail-" (symbol-name var))) nil)))))
190
191(defun webmail-eval (expr)
192 (cond
193 ((consp expr)
194 (cons (webmail-eval (car expr)) (webmail-eval (cdr expr))))
195 ((symbolp expr)
196 (eval expr))
197 (t
198 expr)))
199
200(defun webmail-url (xurl)
201 (mm-with-unibyte-current-buffer
202 (cond
203 ((eq (car xurl) 'content)
204 (pop xurl)
205 (mm-url-fetch-simple (if (stringp (car xurl))
206 (car xurl)
207 (apply 'format (webmail-eval (car xurl))))
208 (apply 'format (webmail-eval (cdr xurl)))))
209 ((eq (car xurl) 'post)
210 (pop xurl)
211 (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl))))
212 (t
213 (mm-url-insert (apply 'format (webmail-eval xurl)))))))
214
215(defun webmail-init ()
216 "Initialize buffers and such."
217 (if (gnus-buffer-live-p webmail-buffer)
218 (set-buffer webmail-buffer)
219 (setq webmail-buffer
220 (nnheader-set-temp-buffer " *webmail*"))
221 (mm-disable-multibyte)))
222
223(defvar url-package-name)
224(defvar url-package-version)
225(defvar url-cookie-multiple-line)
226(defvar url-confirmation-func)
227
228;; Hack W3 POST redirect. See `url-parse-mime-headers'.
229;;
230;; Netscape uses "GET" as redirect method when orignal method is POST
231;; and status is 302, .i.e no security risks by default without
232;; confirmation.
233;;
234;; Some web servers (at least Apache used by yahoo) return status 302
235;; instead of 303, though they mean 303.
236
237(defun webmail-url-confirmation-func (prompt)
238 (cond
239 ((equal prompt (concat "Honor redirection with non-GET method "
240 "(possible security risks)? "))
241 nil)
242 ((equal prompt "Continue (with method of GET)? ")
243 t)
244 (t (error prompt))))
245
246(defun webmail-refresh-redirect ()
247 "Redirect refresh url in META."
248 (goto-char (point-min))
249 (while (re-search-forward
250 "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
251 nil t)
252 (let ((url (match-string 1)))
253 (erase-buffer)
254 (mm-with-unibyte-current-buffer
255 (mm-url-insert url)))
256 (goto-char (point-min))))
257
258(defun webmail-fetch (file subtype user password)
259 (save-excursion
260 (webmail-setdefault subtype)
261 (let ((url-package-name (if (memq 'agent webmail-paranoid)
262 "Mozilla"
263 url-package-name))
264 (url-package-version (if (memq 'agent webmail-paranoid)
265 "4.0"
266 url-package-version))
267 (url-cookie-multiple-line (if (memq 'cookie webmail-paranoid)
268 nil
269 url-cookie-multiple-line))
270 (url-confirmation-func (if (memq 'post webmail-paranoid)
271 'webmail-url-confirmation-func
272 url-confirmation-func))
273 (url-http-silence-on-insecure-redirection t)
274 url-cookie-storage url-cookie-secure-storage
275 url-cookie-confirmation
276 item id (n 0))
277 (webmail-init)
278 (setq webmail-articles nil)
279 (when webmail-open-url
280 (erase-buffer)
281 (webmail-url webmail-open-url))
282 (if webmail-open-snarf (funcall webmail-open-snarf))
283 (when webmail-login-url
284 (erase-buffer)
285 (webmail-url webmail-login-url))
286 (if webmail-login-snarf
287 (funcall webmail-login-snarf))
288 (when webmail-list-url
289 (erase-buffer)
290 (webmail-url webmail-list-url))
291 (if webmail-list-snarf
292 (funcall webmail-list-snarf))
293 (while (setq item (pop webmail-articles))
294 (message "Fetching mail #%d..." (setq n (1+ n)))
295 (erase-buffer)
296 (mm-with-unibyte-current-buffer
297 (mm-url-insert (cdr item)))
298 (setq id (car item))
299 (if webmail-article-snarf
300 (funcall webmail-article-snarf file id))
301 (when (and webmail-trash-url webmail-move-to-trash-can)
302 (message "Move mail #%d to trash can..." n)
303 (condition-case err
304 (progn
305 (webmail-url webmail-trash-url)
306 (let (buf)
307 (while (setq buf (pop webmail-buffer-list))
308 (kill-buffer buf))))
309 (error
310 (let (buf)
311 (while (setq buf (pop webmail-buffer-list))
312 (kill-buffer buf)))
313 (error err))))))
314 (if webmail-post-process
315 (funcall webmail-post-process))))
316
317(defun webmail-encode-8bit ()
318 (goto-char (point-min))
319 (skip-chars-forward "^\200-\377")
320 (while (not (eobp))
321 (insert (format "&%d;" (mm-char-int (char-after))))
322 (delete-char 1)
323 (skip-chars-forward "^\200-\377")))
324
325;;; hotmail
326
327(defun webmail-hotmail-open ()
328 (goto-char (point-min))
329 (if (re-search-forward
330 "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
331 (setq webmail-aux (match-string 1))
332 (webmail-error "open@1")))
333
334(defun webmail-hotmail-login ()
335 (let (site)
336 (goto-char (point-min))
337 (if (re-search-forward
338 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
339 (setq site (match-string 1))
340 (webmail-error "login@1"))
341 (goto-char (point-min))
342 (if (re-search-forward
343 "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
344 (setq webmail-aux (concat "http://" site (match-string 1)))
345 (webmail-error "login@2"))))
346
347(defun webmail-hotmail-list ()
348 (goto-char (point-min))
349 (skip-chars-forward " \t\n\r")
350 (let (site url newp (total "0"))
351 (if (eobp)
352 (setq total "0")
353 (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
354 (message "Found %s (%s new)" (setq total (match-string 1))
355 (match-string 2))
356 (if (re-search-forward "\\([0-9]+\\) new" nil t)
357 (message "Found %s new" (setq total (match-string 1)))
358 (webmail-error "list@0"))))
359 (unless (equal total "0")
360 (goto-char (point-min))
361 (if (re-search-forward
362 "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
363 (setq site (match-string 1))
364 (webmail-error "list@1"))
365 (goto-char (point-min))
366 (if (re-search-forward "disk=\\([^&]*\\)&" nil t)
367 (setq webmail-aux
368 (concat "http://" site "/cgi-bin/HoTMaiL?disk="
369 (match-string 1)))
370 (webmail-error "list@2"))
371 (goto-char (point-max))
372 (while (re-search-backward
373 "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
374 nil t)
375 (if (setq url (match-string 1))
376 (progn
377 (if (or newp (not webmail-newmail-only))
378 (let (id)
379 (if (string-match "msg=\\([^&]+\\)" url)
380 (setq id (match-string 1 url)))
381 (push (cons id (concat "http://" site url "&raw=0"))
382 webmail-articles)))
383 (setq newp nil))
384 (setq newp t))))))
385
386;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
387
388(defun webmail-hotmail-article (file id)
389 (goto-char (point-min))
390 (skip-chars-forward " \t\n\r")
391 (unless (eobp)
392 (if (not (search-forward "<pre>" nil t))
393 (webmail-error "article@3"))
394 (skip-chars-forward "\n\r\t ")
395 (delete-region (point-min) (point))
396 (if (not (search-forward "</pre>" nil t))
397 (webmail-error "article@3.1"))
398 (delete-region (match-beginning 0) (point-max))
399 (mm-url-remove-markup)
400 (mm-url-decode-entities-nbsp)
401 (goto-char (point-min))
402 (while (re-search-forward "\r\n?" nil t)
403 (replace-match "\n"))
404 (goto-char (point-min))
405 (insert "\n\n")
406 (if (not (looking-at "\n*From "))
407 (insert "From nobody " (current-time-string) "\n")
408 (forward-line))
409 (insert "X-Gnus-Webmail: " (symbol-value 'user)
410 "@" (symbol-name webmail-type) "\n")
411 (mm-append-to-file (point-min) (point-max) file)))
412
413(defun webmail-hotmail-article-old (file id)
414 (let (p attachment count mime hotmail-direct)
415 (save-restriction
416 (webmail-encode-8bit)
417 (goto-char (point-min))
418 (if (not (search-forward "<DIV>" nil t))
419 (if (not (search-forward "Reply&nbsp;All" nil t))
420 (webmail-error "article@1")
421 (setq hotmail-direct t))
422 (goto-char (match-beginning 0)))
423 (narrow-to-region (point-min) (point))
424 (if (not (search-backward "<table" nil t 2))
425 (webmail-error "article@1.1"))
426 (delete-region (point-min) (match-beginning 0))
427 (while (search-forward "<a href=" nil t)
428 (setq p (match-beginning 0))
429 (search-forward "</a>" nil t)
430 (delete-region p (match-end 0)))
431 (mm-url-remove-markup)
432 (mm-url-decode-entities-nbsp)
433 (goto-char (point-min))
434 (delete-blank-lines)
435 (goto-char (point-min))
436 (when (search-forward "\n\n" nil t)
437 (backward-char)
438 (delete-region (point) (point-max)))
439 (goto-char (point-max))
440 (widen)
441 (insert "\n")
442 (setq p (point))
443 (while (re-search-forward
444 "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
445 nil t)
446 (if (setq attachment (match-string 1))
447 (let ((filename (match-string 2))
448 bufname);; Attachment
449 (delete-region p (match-end 0))
450 (save-excursion
451 (set-buffer (generate-new-buffer " *webmail-att*"))
452 (mm-url-insert attachment)
453 (push (current-buffer) webmail-buffer-list)
454 (setq bufname (buffer-name)))
455 (setq mime t)
456 (insert "<#part type="
457 (or (and filename
458 (string-match "\\.[^\\.]+$" filename)
459 (mailcap-extension-to-mime
460 (match-string 0 filename)))
461 "application/octet-stream"))
462 (insert " buffer=\"" bufname "\"")
463 (insert " filename=\"" filename "\"")
464 (insert " disposition=\"inline\"")
465 (insert "><#/part>\n")
466 (setq p (point)))
467 (delete-region p (match-end 0))
468 (if hotmail-direct
469 (if (not (search-forward "</tt>" nil t))
470 (webmail-error "article@1.2")
471 (delete-region (match-beginning 0) (match-end 0)))
472 (setq count 1)
473 (while (and (> count 0)
474 (re-search-forward "</div>\\|\\(<div>\\)" nil t))
475 (if (match-string 1)
476 (setq count (1+ count))
477 (if (= (setq count (1- count)) 0)
478 (delete-region (match-beginning 0)
479 (match-end 0))))))
480 (narrow-to-region p (point))
481 (goto-char (point-min))
482 (cond
483 ((looking-at "<pre>")
484 (goto-char (match-end 0))
485 (if (looking-at "$") (forward-char))
486 (delete-region (point-min) (point))
487 (mm-url-remove-markup)
488 (mm-url-decode-entities-nbsp)
489 nil)
490 (t
491 (setq mime t)
492 (insert "<#part type=\"text/html\" disposition=inline>")
493 (goto-char (point-max))
494 (insert "<#/part>")))
495 (goto-char (point-max))
496 (setq p (point))
497 (widen)))
498 (delete-region p (point-max))
499 (goto-char (point-min))
500 ;; Some blank line to separate mails.
501 (insert "\n\nFrom nobody " (current-time-string) "\n")
502 (insert "X-Gnus-Webmail: " (symbol-value 'user)
503 "@" (symbol-name webmail-type) "\n")
504 (if id
505 (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
506 (unless (looking-at "$")
507 (if (search-forward "\n\n" nil t)
508 (forward-line -1)
509 (webmail-error "article@2")))
510 (narrow-to-region (point) (point-max))
511 (if mime
512 (insert "MIME-Version: 1.0\n"
513 (prog1
514 (mml-generate-mime)
515 (delete-region (point-min) (point-max)))))
516 (goto-char (point-min))
517 (widen)
518 (let (case-fold-search)
519 (while (re-search-forward "^From " nil t)
520 (beginning-of-line)
521 (insert ">"))))
522 (mm-append-to-file (point-min) (point-max) file)))
523
524;;; yahoo
525
526(defun webmail-yahoo-open ()
527 (goto-char (point-min))
528 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
529 (setq webmail-aux (match-string 1))
530 (webmail-error "open@1")))
531
532(defun webmail-yahoo-login ()
533 (goto-char (point-min))
534 (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t)
535 (setq webmail-aux (match-string 0))
536 (webmail-error "login@1"))
537 (if (re-search-forward "YY=[0-9]+" nil t)
538 (setq webmail-aux (concat webmail-aux "ym/ShowFolder?"
539 (match-string 0)))
540 (webmail-error "login@2")))
541
542(defun webmail-yahoo-list ()
543 (let (url (newp t) (tofetch 0))
544 (goto-char (point-min))
545 (when (re-search-forward
546 "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
547 ;;(setq listed (match-string 1))
548 (message "Found %s mail(s)" (match-string 2)))
549 (if (string-match "http://[^/]+" webmail-aux)
550 (setq webmail-aux (match-string 0 webmail-aux))
551 (webmail-error "list@1"))
552 (goto-char (point-min))
553 (while (re-search-forward
554 "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
555 nil t)
556 (if (setq url (match-string 1))
557 (progn
558 (when (or newp (not webmail-newmail-only))
559 (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
560 webmail-articles)
561 (setq tofetch (1+ tofetch)))
562 (setq newp t))
563 (setq newp nil)))
564 (setq webmail-articles (nreverse webmail-articles))
565 (message "Fetching %d mail(s)" tofetch)))
566
567(defun webmail-yahoo-article (file id)
568 (let (p attachment)
569 (save-restriction
570 (goto-char (point-min))
571 (if (not (search-forward "value=\"Done\"" nil t))
572 (webmail-error "article@1"))
573 (if (not (search-forward "<table" nil t))
574 (webmail-error "article@2"))
575 (delete-region (point-min) (match-beginning 0))
576 (if (not (search-forward "</table>" nil t))
577 (webmail-error "article@3"))
578 (narrow-to-region (point-min) (match-end 0))
579 (while (search-forward "<a href=" nil t)
580 (setq p (match-beginning 0))
581 (search-forward "</a>" nil t)
582 (delete-region p (match-end 0)))
583 (mm-url-remove-markup)
584 (mm-url-decode-entities-nbsp)
585 (goto-char (point-min))
586 (delete-blank-lines)
587 (goto-char (point-max))
588 (widen)
589 (insert "\n")
590 (setq p (point))
591 (while (re-search-forward "[^\"]*/ShowLetter/[^\?]+\?[^\"]*" nil t)
592 (setq attachment (match-string 0))
593 (let (bufname ct ctl cd description)
594 (if (not (search-forward "<table" nil t))
595 (webmail-error "article@4"))
596 (delete-region p (match-beginning 0))
597 (if (not (search-forward "</table>" nil t))
598 (webmail-error "article@5"))
599 (narrow-to-region p (match-end 0))
600 (mm-url-remove-markup)
601 (mm-url-decode-entities-nbsp)
602 (goto-char (point-min))
603 (delete-blank-lines)
604 (setq ct (mail-fetch-field "content-type")
605 ctl (and ct (mail-header-parse-content-type ct))
606 ;;cte (mail-fetch-field "content-transfer-encoding")
607 cd (mail-fetch-field "content-disposition")
608 description (mail-fetch-field "content-description")
609 id (mail-fetch-field "content-id"))
610 (delete-region (point-min) (point-max))
611 (widen)
612 (save-excursion
613 (set-buffer (generate-new-buffer " *webmail-att*"))
614 (mm-url-insert (concat webmail-aux attachment))
615 (push (current-buffer) webmail-buffer-list)
616 (setq bufname (buffer-name)))
617 (insert "<#part")
618 (if (and ctl (not (equal (car ctl) "text/")))
619 (insert " type=\"" (car ctl) "\""))
620 (insert " buffer=\"" bufname "\"")
621 (if cd
622 (insert " disposition=\"" cd "\""))
623 (if description
624 (insert " description=\"" description "\""))
625 (insert "><#/part>\n")
626 (setq p (point))))
627 (delete-region p (point-max))
628 (goto-char (point-min))
629 ;; Some blank line to separate mails.
630 (insert "\n\nFrom nobody " (current-time-string) "\n")
631 (insert "X-Gnus-Webmail: " (symbol-value 'user)
632 "@" (symbol-name webmail-type) "\n")
633 (if id
634 (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
635 (unless (looking-at "$")
636 (if (search-forward "\n\n" nil t)
637 (forward-line -1)
638 (webmail-error "article@2")))
639 (narrow-to-region (point) (point-max))
640 (insert "MIME-Version: 1.0\n"
641 (prog1
642 (mml-generate-mime)
643 (delete-region (point-min) (point-max))))
644 (goto-char (point-min))
645 (widen)
646 (let (case-fold-search)
647 (while (re-search-forward "^From " nil t)
648 (beginning-of-line)
649 (insert ">"))))
650 (mm-append-to-file (point-min) (point-max) file)))
651
652;;; netaddress
653
654(defun webmail-netaddress-open ()
655 (goto-char (point-min))
656 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
657 (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
658 (webmail-error "open@1")))
659
660(defun webmail-netaddress-login ()
661 (webmail-refresh-redirect)
662 (goto-char (point-min))
663 (if (re-search-forward "tpl/[^/]+/\\([^/]+\\)" nil t)
664 (setq webmail-session (match-string 1))
665 (webmail-error "login@1")))
666
667(defun webmail-netaddress-list ()
668 (webmail-refresh-redirect)
669 (let (item id)
670 (goto-char (point-min))
671 (when (re-search-forward
672 "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
673 (message "Found %s mail(s), %s unread"
674 (match-string 2) (match-string 1)))
675 (goto-char (point-min))
676 (while (re-search-forward
677 "MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
678 (if (setq id (match-string 2))
679 (setq item
680 (cons id
681 (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
682 (car webmail-article-url)
683 webmail-session id)))
684 (if (or (not webmail-newmail-only)
685 (equal (match-string 1) "True"))
686 (push item webmail-articles))))
687 (setq webmail-articles (nreverse webmail-articles))))
688
689(defun webmail-netaddress-single-part ()
690 (goto-char (point-min))
691 (cond
692 ((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
693 ;; text/plain
694 (replace-match "")
695 (while (re-search-forward "[\t\040\r\n]+" nil t)
696 (replace-match " "))
697 (goto-char (point-min))
698 (while (re-search-forward "<br>" nil t)
699 (replace-match "\n"))
700 (mm-url-remove-markup)
701 (mm-url-decode-entities-nbsp)
702 nil)
703 (t
704 (insert "<#part type=\"text/html\" disposition=inline>")
705 (goto-char (point-max))
706 (insert "<#/part>")
707 t)))
708
709(defun webmail-netaddress-article (file id)
710 (webmail-refresh-redirect)
711 (let (p p1 attachment count mime type)
712 (save-restriction
713 (webmail-encode-8bit)
714 (goto-char (point-min))
715 (if (not (search-forward "Trash" nil t))
716 (webmail-error "article@1"))
717 (if (not (search-forward "<form>" nil t))
718 (webmail-error "article@2"))
719 (delete-region (point-min) (match-beginning 0))
720 (if (not (search-forward "</form>" nil t))
721 (webmail-error "article@3"))
722 (narrow-to-region (point-min) (match-end 0))
723 (goto-char (point-min))
724 (while (re-search-forward "[\040\t\r\n]+" nil t)
725 (replace-match " "))
726 (goto-char (point-min))
727 (while (search-forward "<b>" nil t)
728 (replace-match "\n"))
729 (mm-url-remove-markup)
730 (mm-url-decode-entities-nbsp)
731 (goto-char (point-min))
732 (delete-blank-lines)
733 (goto-char (point-min))
734 (while (re-search-forward "^\040+\\|\040+$" nil t)
735 (replace-match ""))
736 (goto-char (point-min))
737 (while (re-search-forward "\040+" nil t)
738 (replace-match " "))
739 (goto-char (point-max))
740 (widen)
741 (insert "\n\n")
742 (setq p (point))
743 (unless (search-forward "<!-- Data -->" nil t)
744 (webmail-error "article@4"))
745 (forward-line 14)
746 (delete-region p (point))
747 (goto-char (point-max))
748 (unless (re-search-backward
749 "[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
750 (webmail-error "article@5"))
751 (delete-region (point) (point-max))
752 (goto-char p)
753 (while (search-forward
754 "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
755 nil t 2)
756 (setq mime t)
757 (unless (search-forward "</TABLE>" nil t)
758 (webmail-error "article@6"))
759 (setq p1 (point))
760 (if (search-backward "<IMG " p t)
761 (progn
762 (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
763 (webmail-error "article@7"))
764 (setq attachment (match-string 1))
765 (setq type (match-string 2))
766 (unless (search-forward "</TABLE>" nil t)
767 (webmail-error "article@8"))
768 (delete-region p (point))
769 (let (bufname);; Attachment
770 (save-excursion
771 (set-buffer (generate-new-buffer " *webmail-att*"))
772 (mm-url-insert (concat (car webmail-open-url) attachment))
773 (push (current-buffer) webmail-buffer-list)
774 (setq bufname (buffer-name)))
775 (insert "<#part type=" type)
776 (insert " buffer=\"" bufname "\"")
777 (insert " disposition=\"inline\"")
778 (insert "><#/part>\n")
779 (setq p (point))))
780 (delete-region p p1)
781 (narrow-to-region
782 p
783 (if (search-forward
784 "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
785 nil t)
786 (match-beginning 0)
787 (point-max)))
788 (webmail-netaddress-single-part)
789 (goto-char (point-max))
790 (setq p (point))
791 (widen)))
792 (unless mime
793 (narrow-to-region p (point-max))
794 (setq mime (webmail-netaddress-single-part))
795 (widen))
796 (goto-char (point-min))
797 ;; Some blank line to separate mails.
798 (insert "\n\nFrom nobody " (current-time-string) "\n")
799 (insert "X-Gnus-Webmail: " (symbol-value 'user)
800 "@" (symbol-name webmail-type) "\n")
801 (if id
802 (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
803 (unless (looking-at "$")
804 (if (search-forward "\n\n" nil t)
805 (forward-line -1)
806 (webmail-error "article@2")))
807 (when mime
808 (narrow-to-region (point-min) (point))
809 (goto-char (point-min))
810 (while (not (eobp))
811 (if (looking-at "MIME-Version\\|Content-Type")
812 (delete-region (point)
813 (progn
814 (forward-line 1)
815 (if (re-search-forward "^[^ \t]" nil t)
816 (goto-char (match-beginning 0))
817 (point-max))))
818 (forward-line 1)))
819 (goto-char (point-max))
820 (widen)
821 (narrow-to-region (point) (point-max))
822 (insert "MIME-Version: 1.0\n"
823 (prog1
824 (mml-generate-mime)
825 (delete-region (point-min) (point-max))))
826 (goto-char (point-min))
827 (widen))
828 (let (case-fold-search)
829 (while (re-search-forward "^From " nil t)
830 (beginning-of-line)
831 (insert ">"))))
832 (mm-append-to-file (point-min) (point-max) file)))
833
834(provide 'webmail)
835
836;;; webmail.el ends here
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index d76b8cf3a04..ff0b52c2b96 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -131,19 +131,23 @@ Entries without port tokens default to DEFAULTPORT."
131 ;; No machine name matches, so we look for default entries. 131 ;; No machine name matches, so we look for default entries.
132 (while rest 132 (while rest
133 (when (assoc "default" (car rest)) 133 (when (assoc "default" (car rest))
134 (push (car rest) result)) 134 (let ((elem (car rest)))
135 (setq elem (delete (assoc "default" elem) elem))
136 (push elem result)))
135 (pop rest))) 137 (pop rest)))
136 (when result 138 (when result
137 (setq result (nreverse result)) 139 (setq result (nreverse result))
138 (while (and result 140 (if (not port)
139 (not (netrc-port-equal 141 (car result)
140 (or port defaultport "nntp") 142 (while (and result
141 ;; when port is not given in the netrc file, 143 (not (netrc-port-equal
142 ;; it should mean "any port" 144 (or port defaultport "nntp")
143 (or (netrc-get (car result) "port") 145 ;; when port is not given in the netrc file,
144 defaultport port)))) 146 ;; it should mean "any port"
145 (pop result)) 147 (or (netrc-get (car result) "port")
146 (car result)))) 148 defaultport port))))
149 (pop result))
150 (car result)))))
147 151
148(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults) 152(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
149 "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST. 153 "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST.
@@ -238,9 +242,11 @@ Port specifications will be prioritised in the order they are
238listed in the PORTS list." 242listed in the PORTS list."
239 (let ((list (netrc-parse)) 243 (let ((list (netrc-parse))
240 found) 244 found)
241 (while (and ports 245 (if (not ports)
242 (not found)) 246 (setq found (netrc-machine list machine))
243 (setq found (netrc-machine list machine (pop ports)))) 247 (while (and ports
248 (not found))
249 (setq found (netrc-machine list machine (pop ports)))))
244 (when found 250 (when found
245 (list (cdr (assoc "login" found)) 251 (list (cdr (assoc "login" found))
246 (cdr (assoc "password" found)))))) 252 (cdr (assoc "password" found))))))
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index d4fa8c2e73c..ad0768968e5 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -75,9 +75,14 @@ and `gnutls-cli' (version 2.0.1) output."
75 :type 'regexp 75 :type 'regexp
76 :group 'tls) 76 :group 'tls)
77 77
78(defcustom tls-program '("gnutls-cli -p %p %h" 78(defvar tls-starttls-switches
79 "gnutls-cli -p %p %h --protocols ssl3" 79 '(("gnutls-cli" "-s")
80 "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") 80 ("openssl" "-starttls imap"))
81 "Alist of programs and the switches necessary to get starttls behaviour.")
82
83(defcustom tls-program '("gnutls-cli %s -p %p %h"
84 "gnutls-cli %s -p %p %h --protocols ssl3"
85 "openssl s_client %s -connect %h:%p -no_ssl2 -ign_eof")
81 "List of strings containing commands to start TLS stream to a host. 86 "List of strings containing commands to start TLS stream to a host.
82Each entry in the list is tried until a connection is successful. 87Each entry in the list is tried until a connection is successful.
83%h is replaced with server hostname, %p with port to connect to. 88%h is replaced with server hostname, %p with port to connect to.
@@ -199,7 +204,7 @@ Used by `tls-certificate-information'."
199 (push (cons (match-string 1) (match-string 2)) vals)) 204 (push (cons (match-string 1) (match-string 2)) vals))
200 (nreverse vals)))))) 205 (nreverse vals))))))
201 206
202(defun open-tls-stream (name buffer host port) 207(defun open-tls-stream (name buffer host port &optional starttlsp)
203 "Open a TLS connection for a port to a host. 208 "Open a TLS connection for a port to a host.
204Returns a subprocess-object to represent the connection. 209Returns a subprocess-object to represent the connection.
205Input and output work as for subprocesses; `delete-process' closes it. 210Input and output work as for subprocesses; `delete-process' closes it.
@@ -229,6 +234,9 @@ Fourth arg PORT is an integer specifying a port to connect to."
229 (format-spec 234 (format-spec
230 cmd 235 cmd
231 (format-spec-make 236 (format-spec-make
237 ?s (if starttlsp
238 (tls-find-starttls-argument cmd)
239 "")
232 ?h host 240 ?h host
233 ?p (if (integerp port) 241 ?p (if (integerp port)
234 (int-to-string port) 242 (int-to-string port)
@@ -300,6 +308,11 @@ match `%s'. Connect anyway? " host))))))
300 (kill-buffer buffer)) 308 (kill-buffer buffer))
301 done)) 309 done))
302 310
311(defun tls-find-starttls-argument (command)
312 (let ((command (car (split-string command))))
313 (or (cadr (assoc command tls-starttls-switches))
314 "")))
315
303(provide 'tls) 316(provide 'tls)
304 317
305;;; tls.el ends here 318;;; tls.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-24 16:23:48 +0000