nnimap.el (nnimap-request-accept-article): Get the Message-ID without the \r.
nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of SELECT to get the message-id. gnus-art.el, gnus.el, nnimap.el: Fix up make-obsolete-variable declarations throughout. gnus.texi (Mail Source Specifiers): Remove webmail.el mentions. mail-source.el: Removed webmail support. nntp.el (nntp-server-list-active-group): Document. gnus.texi (NNTP): Document nntp-server-list-active-group. gnus.texi (Customizing the IMAP Connection): Remove extra quote. nnimap.el (nnimap-find-article-by-message-id): Really return the article number. nnimap.el: Add nnimap-split-fancy. netrc.el (netrc-credentials, netrc-machine): Return the value of the "default" entry. nnimap.el: Use tls.el exclusively, and not starttls.el at all. nnimap.el (nnimap-wait-for-connection): Accept the moronic openssl s_client -starttls output, too. nnrss.el (nnrss-use-local): Add documentation. message.el (message-ignored-supersedes-headers): Strip Injection-* headers before superseding. nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from unencrypted to STARTTLS, if possible. nnir.el: Use the server names without suffixes. gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when expanding threads. gnus-registry.el: Don't follow nnmairix references. Install the nnregistry refer method. gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove nnimap-split-rule from examples.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
55e572ef89
commit
6b9588145b
17 changed files with 245 additions and 996 deletions
|
|
@ -1,3 +1,20 @@
|
|||
2010-09-30 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove
|
||||
nnimap-split-rule from examples.
|
||||
|
||||
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus.texi (Mail Source Specifiers): Remove webmail.el mentions.
|
||||
(NNTP): Document nntp-server-list-active-group. Suggested by Barry
|
||||
Fishman.
|
||||
(Client-Side IMAP Splitting): Add nnimap-split-fancy.
|
||||
|
||||
2010-09-30 Julien Danjou <julien@danjou.info>
|
||||
|
||||
* gnus.texi (Gravatars): Fix documentation about
|
||||
gnu-gravatar-properties.
|
||||
|
||||
2010-09-29 Daiki Ueno <ueno@unixuser.org>
|
||||
|
||||
* epa.texi (Bug Reports): New section.
|
||||
|
|
@ -6,6 +23,16 @@
|
|||
|
||||
* Makefile.in (top_srcdir): Remove unused variable.
|
||||
|
||||
2010-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus.texi (Using IMAP): Remove the @acronyms from the headings.
|
||||
(Client-Side IMAP Splitting): Document 'default.
|
||||
|
||||
2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus.texi (Customizing the IMAP Connection): Document
|
||||
nnimap-fetch-partial-articles.
|
||||
|
||||
2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus-news.texi: Mention nnimap-inbox.
|
||||
|
|
|
|||
|
|
@ -14394,6 +14394,12 @@ inhibit Gnus to add a @code{Message-ID} header, you could say:
|
|||
Note that not all servers support the recommended ID. This works for
|
||||
INN versions 2.3.0 and later, for instance.
|
||||
|
||||
@item nntp-server-list-active-group
|
||||
If @code{nil}, then always use @samp{GROUP} instead of @samp{LIST
|
||||
ACTIVE}. This is usually slower, but on misconfigured servers that
|
||||
don't update their active files often, this can help.
|
||||
|
||||
|
||||
@end table
|
||||
|
||||
@menu
|
||||
|
|
@ -14836,7 +14842,7 @@ Here's an example method that's more complex:
|
|||
(nnimap-inbox "INBOX")
|
||||
(nnimap-split-methods default)
|
||||
(nnimap-expunge t)
|
||||
(nnimap-stream 'ssl)
|
||||
(nnimap-stream ssl)
|
||||
(nnir-search-engine imap)
|
||||
(nnimap-expunge-inbox t))
|
||||
@end example
|
||||
|
|
@ -14906,6 +14912,9 @@ Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting
|
|||
Mail}), except the symbol @code{default}, which means that it should
|
||||
use the value of the @code{nnmail-split-methods} variable.
|
||||
|
||||
@item nnimap-split-fancy
|
||||
Uses the same syntax as @code{nnmail-split-fancy}.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
|
|
@ -15559,45 +15568,6 @@ An example @acronym{IMAP} mail source:
|
|||
:fetchflag "\\Seen")
|
||||
@end lisp
|
||||
|
||||
@item webmail
|
||||
Get mail from a webmail server, such as @uref{http://www.hotmail.com/},
|
||||
@uref{http://webmail.netscape.com/}, @uref{http://www.netaddress.com/},
|
||||
@uref{http://mail.yahoo.com/}.
|
||||
|
||||
NOTE: Webmail largely depends on cookies. A "one-line-cookie" patch is
|
||||
required for url "4.0pre.46".
|
||||
|
||||
WARNING: Mails may be lost. NO WARRANTY.
|
||||
|
||||
Keywords:
|
||||
|
||||
@table @code
|
||||
@item :subtype
|
||||
The type of the webmail server. The default is @code{hotmail}. The
|
||||
alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}.
|
||||
|
||||
@item :user
|
||||
The user name to give to the webmail server. The default is the login
|
||||
name.
|
||||
|
||||
@item :password
|
||||
The password to give to the webmail server. If not specified, the user is
|
||||
prompted.
|
||||
|
||||
@item :dontexpunge
|
||||
If non-@code{nil}, only fetch unread articles and don't move them to
|
||||
trash folder after finishing the fetch.
|
||||
|
||||
@end table
|
||||
|
||||
An example webmail source:
|
||||
|
||||
@lisp
|
||||
(webmail :subtype 'hotmail
|
||||
:user "user-name"
|
||||
:password "secret")
|
||||
@end lisp
|
||||
|
||||
@item group
|
||||
Get the actual mail source from the @code{mail-source} group parameter,
|
||||
@xref{Group Parameters}.
|
||||
|
|
@ -24196,8 +24166,8 @@ From Ted Zlatanov <tzz@@lifelogs.com>.
|
|||
spam-move-spam-nonspam-groups-only nil
|
||||
spam-mark-only-unseen-as-spam t
|
||||
spam-mark-ham-unread-before-move-from-spam-group t
|
||||
nnimap-split-rule 'nnimap-split-fancy
|
||||
;; @r{understand what this does before you copy it to your own setup!}
|
||||
;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual}
|
||||
nnimap-split-fancy '(|
|
||||
;; @r{trace references to parents and put in their group}
|
||||
(: gnus-registry-split-fancy-with-parent)
|
||||
|
|
@ -24919,8 +24889,8 @@ messages stay in @samp{INBOX}:
|
|||
@example
|
||||
(setq spam-use-spamoracle t
|
||||
spam-split-group "Junk"
|
||||
;; @r{for nnimap you'll probably want to set nnimap-split-methods, see the manual}
|
||||
nnimap-split-inbox '("INBOX")
|
||||
nnimap-split-rule 'nnimap-split-fancy
|
||||
nnimap-split-fancy '(| (: spam-split) "INBOX"))
|
||||
@end example
|
||||
|
||||
|
|
@ -26239,7 +26209,7 @@ wrong show.
|
|||
Masanobu @sc{Umeda}---the writer of the original @sc{gnus}.
|
||||
|
||||
@item
|
||||
Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el, webmail.el,
|
||||
Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el,
|
||||
nnwarchive and many, many other things connected with @acronym{MIME} and
|
||||
other types of en/decoding, as well as general bug fixing, new
|
||||
functionality and stuff.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,13 @@
|
|||
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* tls.el (tls-starttls-switches): New variable.
|
||||
(tls-find-starttls-argument): Use it.
|
||||
(open-tls-stream): Ditto.
|
||||
|
||||
1 * netrc.el (netrc-credentials): Return the value of the "default"
|
||||
entry.
|
||||
(netrc-machine): Ditto.
|
||||
|
||||
2010-09-30 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* vc/vc-hooks.el (vc-default-mode-line-string): Doc fix.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,59 @@
|
|||
2010-09-30 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
* gnus-registry.el (gnus-registry-install-nnregistry): New function to
|
||||
install the nnregistry refer method.
|
||||
(gnus-registry-install-hooks): Use it.
|
||||
(gnus-registry-unfollowed-groups): Add nnmairix to the default
|
||||
unfollowed groups.
|
||||
|
||||
2010-09-30 Jose A. Ortega Ruiz <jao@gnu.org> (tiny change)
|
||||
|
||||
* gnus-sum.el (gnus-summary-show-thread): Skip past invisible text when
|
||||
expanding threads.
|
||||
|
||||
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* nnir.el: Use the server names without suffixes (bug #7009).
|
||||
|
||||
* nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from
|
||||
unencrypted to STARTTLS, if possible.
|
||||
|
||||
2010-09-30 Teemu Likonen <tlikonen@iki.fi> (tiny change)
|
||||
|
||||
* message.el (message-ignored-supersedes-headers): Strip Injection-*
|
||||
headers before superseding.
|
||||
|
||||
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* nnrss.el (nnrss-use-local): Add documentation.
|
||||
|
||||
* nnimap.el (nnimap-extend-tls-programs): New function.
|
||||
(nnimap-open-connection): Use tls.el exclusively, and not starttls.el.
|
||||
(nnimap-wait-for-connection): Accept the greeting from the stupid
|
||||
output from openssl s_client -starttls, too.
|
||||
|
||||
* nnimap.el (nnimap-find-article-by-message-id): Really return the
|
||||
article number.
|
||||
(nnimap-split-fancy): New variable.
|
||||
(nnimap-split-incoming-mail): Use it.
|
||||
|
||||
* nntp.el (nntp-server-list-active-group): Document.
|
||||
|
||||
* nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of
|
||||
SELECT to get the message-id.
|
||||
|
||||
* mail-source.el (mail-sources): Removed webmail support.
|
||||
(defvar): Ditto.
|
||||
(mail-source-fetcher-alist): Ditto.
|
||||
(mail-source-fetch-webmail): Removed.
|
||||
|
||||
* webmail.el: Removed -- doesn't seem relevant any more.
|
||||
|
||||
* gnus.el: Fix up make-obsolete-variable declarations throughout.
|
||||
|
||||
* nnimap.el (nnimap-request-accept-article): Get the Message-ID without
|
||||
the \r.
|
||||
|
||||
2010-09-30 Julien Danjou <julien@danjou.info>
|
||||
|
||||
* gnus-agent.el (gnus-agent-add-group): Fix call to
|
||||
|
|
@ -44,11 +100,13 @@
|
|||
(nnimap-request-accept-article): Add \r\n to the lines to make this
|
||||
work with Cyrus.
|
||||
|
||||
* nnregistry.el: Added.
|
||||
|
||||
* nndraft.el (nndraft-request-expire-articles): Use the group name
|
||||
instead if "nndraft". Fix found by Nils Ackermann.
|
||||
|
||||
2010-09-29 Ludovic Courtes <ludo@gnu.org>
|
||||
|
||||
* nnregistry.el: Added.
|
||||
|
||||
2010-09-29 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* nnmail.el (group, group-art-list, group-art):
|
||||
|
|
|
|||
|
|
@ -725,7 +725,7 @@ Each element is a regular expression."
|
|||
:group 'gnus-article-various)
|
||||
|
||||
(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
|
||||
"Gnus 5.10 (Emacs-22.1)")
|
||||
"Gnus 5.10 (Emacs 22.1)")
|
||||
|
||||
(defface gnus-button
|
||||
'((t (:weight bold)))
|
||||
|
|
@ -1412,7 +1412,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
|
|||
:type gnus-article-treat-custom)
|
||||
|
||||
(make-obsolete-variable 'gnus-treat-display-xface
|
||||
'gnus-treat-display-x-face "22.1")
|
||||
'gnus-treat-display-x-face "Emacs 22.1")
|
||||
|
||||
(defcustom gnus-treat-display-x-face
|
||||
(and (not noninteractive)
|
||||
|
|
|
|||
|
|
@ -122,12 +122,14 @@ display."
|
|||
:type 'symbol)
|
||||
|
||||
(defcustom gnus-registry-unfollowed-groups
|
||||
'("delayed$" "drafts$" "queue$" "INBOX$")
|
||||
'("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:")
|
||||
"List of groups that gnus-registry-split-fancy-with-parent won't return.
|
||||
The group names are matched, they don't have to be fully
|
||||
qualified. This parameter tells the Registry 'never split a
|
||||
message into a group that matches one of these, regardless of
|
||||
references.'"
|
||||
references.'
|
||||
|
||||
nnmairix groups are specifically excluded because they are ephemeral."
|
||||
:group 'gnus-registry
|
||||
:type '(repeat regexp))
|
||||
|
||||
|
|
@ -1127,6 +1129,7 @@ Returns the first place where the trail finds a group name."
|
|||
(setq gnus-registry-install t) ; in case it was 'ask or nil
|
||||
(gnus-registry-install-hooks)
|
||||
(gnus-registry-install-shortcuts)
|
||||
(gnus-registry-install-nnregistry)
|
||||
(gnus-registry-read))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -1143,6 +1146,19 @@ Returns the first place where the trail finds a group name."
|
|||
|
||||
(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
|
||||
|
||||
;;;###autoload
|
||||
(defun gnus-registry-install-nnregistry ()
|
||||
"Install the nnregistry refer method in `gnus-refer-article-method'."
|
||||
(interactive)
|
||||
(when (featurep 'nnregistry)
|
||||
(setq gnus-refer-article-method
|
||||
(delete-dups
|
||||
(append
|
||||
(if (listp gnus-refer-article-method)
|
||||
gnus-refer-article-method
|
||||
(list gnus-refer-article-method))
|
||||
(list 'nnregistry))))))
|
||||
|
||||
(defun gnus-registry-unload-hook ()
|
||||
"Uninstall the registry hooks."
|
||||
(interactive)
|
||||
|
|
|
|||
|
|
@ -11327,15 +11327,19 @@ For compatibility with XEmacs."
|
|||
(gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
|
||||
(gnus-summary-position-point))
|
||||
|
||||
(defsubst gnus-summary--inv (p)
|
||||
(and (eq (get-char-property p 'invisible) 'gnus-sum) p))
|
||||
|
||||
(defun gnus-summary-show-thread ()
|
||||
"Show thread subtrees.
|
||||
Returns nil if no thread was there to be shown."
|
||||
(interactive)
|
||||
(let* ((orig (point))
|
||||
(end (point-at-eol))
|
||||
(end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
|
||||
;; Leave point at bol
|
||||
(beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
|
||||
(eoi (when (eq (get-char-property end 'invisible) 'gnus-sum)
|
||||
(eoi (when end
|
||||
(if (fboundp 'next-single-char-property-change)
|
||||
(or (next-single-char-property-change end 'invisible)
|
||||
(point-max))
|
||||
|
|
|
|||
|
|
@ -1427,7 +1427,7 @@ no need to set this variable."
|
|||
:group 'gnus-message
|
||||
:type '(choice (const :tag "default" nil)
|
||||
string))
|
||||
(make-obsolete-variable 'gnus-local-domain nil "24.1")
|
||||
(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
|
||||
|
||||
(defvar gnus-local-organization nil
|
||||
"String with a description of what organization (if any) the user belongs to.
|
||||
|
|
|
|||
|
|
@ -217,34 +217,6 @@ See Info node `(gnus)Mail Source Specifiers'."
|
|||
(const :format ""
|
||||
:value :dontexpunge)
|
||||
(boolean :tag "Dontexpunge"))
|
||||
(group :inline t
|
||||
(const :format "" :value :plugged)
|
||||
(boolean :tag "Plugged"))))
|
||||
(cons :tag "Webmail server"
|
||||
(const :format "" webmail)
|
||||
(checklist :tag "Options" :greedy t
|
||||
(group :inline t
|
||||
(const :format "" :value :subtype)
|
||||
;; Should be generated from
|
||||
;; `webmail-type-definition', but we
|
||||
;; can't require webmail without W3.
|
||||
(choice :tag "Subtype"
|
||||
:value hotmail
|
||||
(const hotmail)
|
||||
(const yahoo)
|
||||
(const netaddress)
|
||||
(const netscape)
|
||||
(const my-deja)))
|
||||
(group :inline t
|
||||
(const :format "" :value :user)
|
||||
(string :tag "User"))
|
||||
(group :inline t
|
||||
(const :format "" :value :password)
|
||||
(string :tag "Password"))
|
||||
(group :inline t
|
||||
(const :format ""
|
||||
:value :dontexpunge)
|
||||
(boolean :tag "Dontexpunge"))
|
||||
(group :inline t
|
||||
(const :format "" :value :plugged)
|
||||
(boolean :tag "Plugged"))))))))
|
||||
|
|
@ -387,13 +359,7 @@ Common keywords should be listed here.")
|
|||
(:prescript)
|
||||
(:prescript-delay)
|
||||
(:postscript)
|
||||
(:dontexpunge))
|
||||
(webmail
|
||||
(:subtype hotmail)
|
||||
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
|
||||
(:password)
|
||||
(:dontexpunge)
|
||||
(:authentication password)))
|
||||
(:dontexpunge)))
|
||||
"Mapping from keywords to default values.
|
||||
All keywords that can be used must be listed here."))
|
||||
|
||||
|
|
@ -402,8 +368,7 @@ All keywords that can be used must be listed here."))
|
|||
(directory mail-source-fetch-directory)
|
||||
(pop mail-source-fetch-pop)
|
||||
(maildir mail-source-fetch-maildir)
|
||||
(imap mail-source-fetch-imap)
|
||||
(webmail mail-source-fetch-webmail))
|
||||
(imap mail-source-fetch-imap))
|
||||
"A mapping from source type to fetcher function.")
|
||||
|
||||
(defvar mail-source-password-cache nil)
|
||||
|
|
@ -1138,30 +1103,6 @@ This only works when `display-time' is enabled."
|
|||
?s server ?P port ?u user))
|
||||
found)))
|
||||
|
||||
(autoload 'webmail-fetch "webmail")
|
||||
|
||||
(defun mail-source-fetch-webmail (source callback)
|
||||
"Fetch for webmail source."
|
||||
(mail-source-bind (webmail source)
|
||||
(let ((mail-source-string (format "webmail:%s:%s" subtype user))
|
||||
(webmail-newmail-only dontexpunge)
|
||||
(webmail-move-to-trash-can (not dontexpunge)))
|
||||
(when (eq authentication 'password)
|
||||
(setq password
|
||||
(or password
|
||||
(cdr (assoc (format "webmail:%s:%s" subtype user)
|
||||
mail-source-password-cache))
|
||||
(read-passwd
|
||||
(format "Password for %s at %s: " user subtype))))
|
||||
(when (and password
|
||||
(not (assoc (format "webmail:%s:%s" subtype user)
|
||||
mail-source-password-cache)))
|
||||
(push (cons (format "webmail:%s:%s" subtype user) password)
|
||||
mail-source-password-cache)))
|
||||
(webmail-fetch mail-source-crash-box subtype user password)
|
||||
(mail-source-callback callback (symbol-name subtype))
|
||||
(mail-source-delete-crash-box))))
|
||||
|
||||
(provide 'mail-source)
|
||||
|
||||
;;; mail-source.el ends here
|
||||
|
|
|
|||
|
|
@ -283,7 +283,7 @@ This is a list of regexps and regexp matches."
|
|||
:link '(custom-manual "(message)Mail Headers")
|
||||
:type 'regexp)
|
||||
|
||||
(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:"
|
||||
(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:"
|
||||
"*Header lines matching this regexp will be deleted before posting.
|
||||
It's best to delete old Path and Date headers before posting to avoid
|
||||
any confusion."
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@
|
|||
(require 'nnoo)
|
||||
(require 'netrc)
|
||||
(require 'utf7)
|
||||
(require 'tls)
|
||||
(require 'parse-time)
|
||||
|
||||
(autoload 'auth-source-forget-user-or-password "auth-source")
|
||||
|
|
@ -70,8 +71,11 @@ Values are `ssl', `network', `starttls' or `shell'.")
|
|||
"How mail is split.
|
||||
Uses the same syntax as nnmail-split-methods")
|
||||
|
||||
(defvoo nnimap-split-fancy nil
|
||||
"Uses the same syntax as nnmail-split-fancy.")
|
||||
|
||||
(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
|
||||
"Gnus 5.13")
|
||||
"Emacs 24.1")
|
||||
|
||||
(defvoo nnimap-authenticator nil
|
||||
"How nnimap authenticate itself to the server.
|
||||
|
|
@ -306,9 +310,11 @@ textual parts.")
|
|||
(setq port (or nnimap-server-port "imap")))
|
||||
'("imap"))
|
||||
((eq nnimap-stream 'starttls)
|
||||
(starttls-open-stream
|
||||
"*nnimap*" (current-buffer) nnimap-address
|
||||
(setq port (or nnimap-server-port "imap")))
|
||||
(let ((tls-program (nnimap-extend-tls-programs)))
|
||||
(open-tls-stream
|
||||
"*nnimap*" (current-buffer) nnimap-address
|
||||
(setq port (or nnimap-server-port "imap"))
|
||||
'starttls))
|
||||
'("imap"))
|
||||
((eq nnimap-stream 'ssl)
|
||||
(open-tls-stream
|
||||
|
|
@ -342,11 +348,23 @@ textual parts.")
|
|||
#'upcase
|
||||
(nnimap-find-parameter
|
||||
"CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
|
||||
(when (eq nnimap-stream 'starttls)
|
||||
(nnimap-command "STARTTLS")
|
||||
(starttls-negotiate (nnimap-process nnimap-object)))
|
||||
(when nnimap-server-port
|
||||
(push (format "%s" nnimap-server-port) ports))
|
||||
;; If this is a STARTTLS-capable server, then sever the
|
||||
;; connection and start a STARTTLS connection instead.
|
||||
(when (and (eq nnimap-stream 'network)
|
||||
(member "STARTTLS" (nnimap-capabilities nnimap-object)))
|
||||
(let ((nnimap-stream 'starttls))
|
||||
(let ((tls-process
|
||||
(nnimap-open-connection buffer)))
|
||||
;; If the STARTTLS connection was successful, we
|
||||
;; kill our first non-encrypted connection. If it
|
||||
;; wasn't successful, we just use our unencrypted
|
||||
;; connection.
|
||||
(when (memq (process-status tls-process) '(open run))
|
||||
(delete-process (nnimap-process nnimap-object))
|
||||
(kill-buffer (current-buffer))
|
||||
(return tls-process)))))
|
||||
(unless (equal connection-result "PREAUTH")
|
||||
(if (not (setq credentials
|
||||
(if (eq nnimap-authenticator 'anonymous)
|
||||
|
|
@ -378,7 +396,16 @@ textual parts.")
|
|||
(when nnimap-object
|
||||
(when (member "QRESYNC" (nnimap-capabilities nnimap-object))
|
||||
(nnimap-command "ENABLE QRESYNC"))
|
||||
t)))))))
|
||||
(nnimap-process nnimap-object))))))))
|
||||
|
||||
(defun nnimap-extend-tls-programs ()
|
||||
(let ((programs tls-program)
|
||||
result)
|
||||
(unless (consp programs)
|
||||
(setq programs (list programs)))
|
||||
(dolist (program programs)
|
||||
(push (concat program " " "%s") result))
|
||||
(nreverse result)))
|
||||
|
||||
(defun nnimap-find-parameter (parameter elems)
|
||||
(let (result)
|
||||
|
|
@ -729,16 +756,20 @@ textual parts.")
|
|||
|
||||
|
||||
(defun nnimap-find-article-by-message-id (group message-id)
|
||||
(when (nnimap-possibly-change-group group nil)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(let ((result
|
||||
(nnimap-command "UID SEARCH HEADER Message-Id %S" message-id))
|
||||
article)
|
||||
(when (car result)
|
||||
;; Select the last instance of the message in the group.
|
||||
(and (setq article
|
||||
(car (last (assoc "SEARCH" (cdr result)))))
|
||||
(string-to-number article)))))))
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(erase-buffer)
|
||||
(setf (nnimap-group nnimap-object) nil)
|
||||
(nnimap-send-command "EXAMINE %S" (utf7-encode group t))
|
||||
(let ((sequence
|
||||
(nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id))
|
||||
article result)
|
||||
(setq result (nnimap-wait-for-response sequence))
|
||||
(when (and result
|
||||
(car (setq result (nnimap-parse-response))))
|
||||
;; Select the last instance of the message in the group.
|
||||
(and (setq article
|
||||
(car (last (assoc "SEARCH" (cdr result)))))
|
||||
(string-to-number article))))))
|
||||
|
||||
(defun nnimap-delete-article (articles)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
|
|
@ -796,10 +827,10 @@ textual parts.")
|
|||
(deffoo nnimap-request-accept-article (group &optional server last)
|
||||
(when (nnimap-possibly-change-group nil server)
|
||||
(nnmail-check-syntax)
|
||||
(nnimap-add-cr)
|
||||
(let ((message (buffer-string))
|
||||
(message-id (message-field-value "message-id"))
|
||||
sequence)
|
||||
(let ((message-id (message-field-value "message-id"))
|
||||
sequence message)
|
||||
(nnimap-add-cr)
|
||||
(setq message (buffer-string))
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(setq sequence (nnimap-send-command
|
||||
"APPEND %S {%d}" (utf7-encode group t)
|
||||
|
|
@ -1183,11 +1214,11 @@ textual parts.")
|
|||
(goto-char (point-min))
|
||||
(while (and (memq (process-status process)
|
||||
'(open run))
|
||||
(not (re-search-forward "^\\* .*\n" nil t)))
|
||||
(not (re-search-forward "^[*.] .*\n" nil t)))
|
||||
(nnheader-accept-process-output process)
|
||||
(goto-char (point-min)))
|
||||
(forward-line -1)
|
||||
(and (looking-at "\\* \\([A-Z0-9]+\\)")
|
||||
(and (looking-at "[*.] \\([A-Z0-9]+\\)")
|
||||
(match-string 1))))
|
||||
|
||||
(defun nnimap-wait-for-response (sequence &optional messagep)
|
||||
|
|
@ -1299,6 +1330,8 @@ textual parts.")
|
|||
(nnmail-split-methods (if (eq nnimap-split-methods 'default)
|
||||
nnmail-split-methods
|
||||
nnimap-split-methods))
|
||||
(nnmail-split-fancy (or nnimap-split-fancy
|
||||
nnmail-split-fancy))
|
||||
(nnmail-inhibit-default-split-group t)
|
||||
(groups (nnimap-get-groups))
|
||||
new-articles)
|
||||
|
|
|
|||
|
|
@ -881,7 +881,9 @@ ready to be added to the list of search results."
|
|||
(when (file-readable-p (concat prefix dirnam article))
|
||||
;; remove trailing slash and, for nnmaildir, cur/new/tmp
|
||||
(setq dirnam
|
||||
(substring dirnam 0 (if (string= server "nnmaildir:") -5 -1)))
|
||||
(substring dirnam 0
|
||||
(if (string= (gnus-group-server server) "nnmaildir")
|
||||
-5 -1)))
|
||||
|
||||
;; Set group to dirnam without any leading dots or slashes,
|
||||
;; and with all subsequent slashes replaced by dots
|
||||
|
|
@ -890,7 +892,7 @@ ready to be added to the list of search results."
|
|||
"[/\\]" "." t)))
|
||||
|
||||
(vector (nnir-group-full-name group server)
|
||||
(if (string= server "nnmaildir:")
|
||||
(if (string= (gnus-group-server server) "nnmaildir")
|
||||
(nnmaildir-base-name-to-article-number
|
||||
(substring article 0 (string-match ":" article))
|
||||
group nil)
|
||||
|
|
@ -1200,7 +1202,7 @@ Windows NT 4.0."
|
|||
;; is sufficient. Note that we can't only use the value of
|
||||
;; nnml-use-compressed-files because old articles might have been
|
||||
;; saved with a different value.
|
||||
(article-pattern (if (string= server "nnmaildir:")
|
||||
(article-pattern (if (string= (gnus-group-server server) "nnmaildir")
|
||||
":[0-9]+"
|
||||
"^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
|
||||
score artno dirnam filenam)
|
||||
|
|
@ -1450,7 +1452,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
|
|||
(when group
|
||||
(error "The Namazu backend cannot search specific groups"))
|
||||
(save-excursion
|
||||
(let ((article-pattern (if (string= server "nnmaildir:")
|
||||
(let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")
|
||||
":[0-9]+"
|
||||
"^[0-9]+$"))
|
||||
artlist
|
||||
|
|
|
|||
|
|
@ -77,7 +77,8 @@ this variable to the list of fields to be ignored.")
|
|||
(defvar nnrss-group-alist '()
|
||||
"List of RSS addresses.")
|
||||
|
||||
(defvar nnrss-use-local nil)
|
||||
(defvar nnrss-use-local nil
|
||||
"If non-nil nnrss will read the feeds from local files in nnrss-directory.")
|
||||
|
||||
(defvar nnrss-description-field 'X-Gnus-Description
|
||||
"Field name used for DESCRIPTION.
|
||||
|
|
|
|||
|
|
@ -267,6 +267,11 @@ NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
|
|||
"*Hook run just before posting an article. It is supposed to be used
|
||||
to insert Cancel-Lock headers.")
|
||||
|
||||
(defvoo nntp-server-list-active-group 'try
|
||||
"If nil, then always use GROUP instead of LIST ACTIVE.
|
||||
This is usually slower, but on misconfigured servers that don't
|
||||
update their active files often, this can help.")
|
||||
|
||||
;;; Internal variables.
|
||||
|
||||
(defvar nntp-record-commands nil
|
||||
|
|
@ -296,7 +301,6 @@ to insert Cancel-Lock headers.")
|
|||
(defvoo nntp-inhibit-output nil)
|
||||
|
||||
(defvoo nntp-server-xover 'try)
|
||||
(defvoo nntp-server-list-active-group 'try)
|
||||
|
||||
(defvar nntp-async-timer nil)
|
||||
(defvar nntp-async-process-list nil)
|
||||
|
|
|
|||
|
|
@ -1,836 +0,0 @@
|
|||
;;; webmail.el --- interface of web mail
|
||||
|
||||
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
|
||||
;; Keywords: hotmail netaddress
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Note: Now mail.yahoo.com provides POP3 service, the webmail
|
||||
;; fetching is not going to be supported.
|
||||
|
||||
;; Note: You need to have `url' and `w3' installed for this backend to
|
||||
;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
|
||||
;; `url'.
|
||||
|
||||
;; Todo: To support more web mail servers.
|
||||
|
||||
;; Known bugs:
|
||||
;; 1. Net@ddress may corrupt `X-Face'.
|
||||
|
||||
;; Warning:
|
||||
;; Webmail is an experimental function, which means NO WARRANTY.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'nnoo)
|
||||
(require 'message)
|
||||
(require 'gnus-util)
|
||||
(require 'gnus)
|
||||
(require 'nnmail)
|
||||
(require 'mm-util)
|
||||
(require 'mm-url)
|
||||
(require 'mml)
|
||||
(eval-when-compile
|
||||
(ignore-errors
|
||||
(require 'url)
|
||||
(require 'url-cookie)))
|
||||
;; Report failure to find w3 at load time if appropriate.
|
||||
(eval '(progn
|
||||
(require 'url)
|
||||
(require 'url-cookie)))
|
||||
|
||||
;;;
|
||||
|
||||
(defvar webmail-type-definition
|
||||
'((hotmail
|
||||
;; Hotmail hate other HTTP user agents and use one line cookie
|
||||
(paranoid agent cookie post)
|
||||
(address . "www.hotmail.com")
|
||||
(open-url "http://www.hotmail.com/")
|
||||
(open-snarf . webmail-hotmail-open)
|
||||
;; W3 hate redirect POST
|
||||
(login-url
|
||||
"http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
|
||||
webmail-aux user password)
|
||||
;;(login-snarf . webmail-hotmail-login)
|
||||
;;(list-url "%s" webmail-aux)
|
||||
(list-snarf . webmail-hotmail-list)
|
||||
(article-snarf . webmail-hotmail-article)
|
||||
(trash-url
|
||||
"%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
|
||||
webmail-aux user id))
|
||||
(yahoo
|
||||
(paranoid agent cookie post)
|
||||
(address . "mail.yahoo.com")
|
||||
(open-url "http://mail.yahoo.com/")
|
||||
(open-snarf . webmail-yahoo-open)
|
||||
(login-url;; yahoo will not accept GET
|
||||
content
|
||||
("%s" webmail-aux)
|
||||
".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s"
|
||||
user password)
|
||||
(login-snarf . webmail-yahoo-login)
|
||||
(list-url "%s&rb=Inbox&YN=1" webmail-aux)
|
||||
(list-snarf . webmail-yahoo-list)
|
||||
(article-snarf . webmail-yahoo-article)
|
||||
(trash-url
|
||||
"%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2="
|
||||
webmail-aux id))
|
||||
(netaddress
|
||||
(paranoid cookie post)
|
||||
(address . "www.netaddress.com")
|
||||
(open-url "http://www.netaddress.com/")
|
||||
(open-snarf . webmail-netaddress-open)
|
||||
(login-url
|
||||
content
|
||||
("%s" webmail-aux)
|
||||
"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"
|
||||
user password)
|
||||
(login-snarf . webmail-netaddress-login)
|
||||
(list-url
|
||||
"http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
|
||||
webmail-session)
|
||||
(list-snarf . webmail-netaddress-list)
|
||||
(article-url "http://www.netaddress.com/")
|
||||
(article-snarf . webmail-netaddress-article)
|
||||
(trash-url
|
||||
"http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
|
||||
webmail-session id))))
|
||||
|
||||
(defvar webmail-variables
|
||||
'(address article-snarf article-url list-snarf list-url
|
||||
login-url login-snarf open-url open-snarf site articles
|
||||
post-process paranoid trash-url))
|
||||
|
||||
(defconst webmail-version "webmail 1.0")
|
||||
|
||||
(defvar webmail-newmail-only nil
|
||||
"Only fetch new mails.")
|
||||
|
||||
(defvar webmail-move-to-trash-can t
|
||||
"Move mail to trash can after fetch it.")
|
||||
|
||||
;;; Internal variables
|
||||
|
||||
(defvar webmail-address nil)
|
||||
(defvar webmail-paranoid nil)
|
||||
(defvar webmail-aux nil)
|
||||
(defvar webmail-session nil)
|
||||
(defvar webmail-article-snarf nil)
|
||||
(defvar webmail-article-url nil)
|
||||
(defvar webmail-list-snarf nil)
|
||||
(defvar webmail-list-url nil)
|
||||
(defvar webmail-login-url nil)
|
||||
(defvar webmail-login-snarf nil)
|
||||
(defvar webmail-open-snarf nil)
|
||||
(defvar webmail-open-url nil)
|
||||
(defvar webmail-trash-url nil)
|
||||
(defvar webmail-articles nil)
|
||||
(defvar webmail-post-process nil)
|
||||
|
||||
(defvar webmail-buffer nil)
|
||||
(defvar webmail-buffer-list nil)
|
||||
|
||||
(defvar webmail-type nil)
|
||||
|
||||
(defvar webmail-error-function nil)
|
||||
|
||||
(defvar webmail-debug-file "~/.emacs-webmail-debug")
|
||||
|
||||
;;; Interface functions
|
||||
|
||||
(defun webmail-debug (str)
|
||||
(with-temp-buffer
|
||||
(insert "\n---------------- A bug at " str " ------------------\n")
|
||||
(dolist (sym '(webmail-type user))
|
||||
(if (boundp sym)
|
||||
(gnus-pp `(setq ,sym ',(eval sym)))))
|
||||
(insert "---------------- webmail buffer ------------------\n\n")
|
||||
(insert-buffer-substring webmail-buffer)
|
||||
(insert "\n---------------- end of buffer ------------------\n\n")
|
||||
(append-to-file (point-min) (point-max) webmail-debug-file)))
|
||||
|
||||
(defun webmail-error (str)
|
||||
(if webmail-error-function
|
||||
(funcall webmail-error-function str))
|
||||
(message "%s HTML has changed or your w3 package is too old.(%s)"
|
||||
webmail-type str)
|
||||
(error "%s HTML has changed or your w3 package is too old.(%s)"
|
||||
webmail-type str))
|
||||
|
||||
(defun webmail-setdefault (type)
|
||||
(let ((type-def (cdr (assq type webmail-type-definition)))
|
||||
(vars webmail-variables)
|
||||
pair)
|
||||
(setq webmail-type type)
|
||||
(dolist (var vars)
|
||||
(if (setq pair (assq var type-def))
|
||||
(set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
|
||||
(set (intern (concat "webmail-" (symbol-name var))) nil)))))
|
||||
|
||||
(defun webmail-eval (expr)
|
||||
(cond
|
||||
((consp expr)
|
||||
(cons (webmail-eval (car expr)) (webmail-eval (cdr expr))))
|
||||
((symbolp expr)
|
||||
(eval expr))
|
||||
(t
|
||||
expr)))
|
||||
|
||||
(defun webmail-url (xurl)
|
||||
(mm-with-unibyte-current-buffer
|
||||
(cond
|
||||
((eq (car xurl) 'content)
|
||||
(pop xurl)
|
||||
(mm-url-fetch-simple (if (stringp (car xurl))
|
||||
(car xurl)
|
||||
(apply 'format (webmail-eval (car xurl))))
|
||||
(apply 'format (webmail-eval (cdr xurl)))))
|
||||
((eq (car xurl) 'post)
|
||||
(pop xurl)
|
||||
(mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl))))
|
||||
(t
|
||||
(mm-url-insert (apply 'format (webmail-eval xurl)))))))
|
||||
|
||||
(defun webmail-init ()
|
||||
"Initialize buffers and such."
|
||||
(if (gnus-buffer-live-p webmail-buffer)
|
||||
(set-buffer webmail-buffer)
|
||||
(setq webmail-buffer
|
||||
(nnheader-set-temp-buffer " *webmail*"))
|
||||
(mm-disable-multibyte)))
|
||||
|
||||
(defvar url-package-name)
|
||||
(defvar url-package-version)
|
||||
(defvar url-cookie-multiple-line)
|
||||
(defvar url-confirmation-func)
|
||||
|
||||
;; Hack W3 POST redirect. See `url-parse-mime-headers'.
|
||||
;;
|
||||
;; Netscape uses "GET" as redirect method when orignal method is POST
|
||||
;; and status is 302, .i.e no security risks by default without
|
||||
;; confirmation.
|
||||
;;
|
||||
;; Some web servers (at least Apache used by yahoo) return status 302
|
||||
;; instead of 303, though they mean 303.
|
||||
|
||||
(defun webmail-url-confirmation-func (prompt)
|
||||
(cond
|
||||
((equal prompt (concat "Honor redirection with non-GET method "
|
||||
"(possible security risks)? "))
|
||||
nil)
|
||||
((equal prompt "Continue (with method of GET)? ")
|
||||
t)
|
||||
(t (error prompt))))
|
||||
|
||||
(defun webmail-refresh-redirect ()
|
||||
"Redirect refresh url in META."
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
|
||||
nil t)
|
||||
(let ((url (match-string 1)))
|
||||
(erase-buffer)
|
||||
(mm-with-unibyte-current-buffer
|
||||
(mm-url-insert url)))
|
||||
(goto-char (point-min))))
|
||||
|
||||
(defun webmail-fetch (file subtype user password)
|
||||
(save-excursion
|
||||
(webmail-setdefault subtype)
|
||||
(let ((url-package-name (if (memq 'agent webmail-paranoid)
|
||||
"Mozilla"
|
||||
url-package-name))
|
||||
(url-package-version (if (memq 'agent webmail-paranoid)
|
||||
"4.0"
|
||||
url-package-version))
|
||||
(url-cookie-multiple-line (if (memq 'cookie webmail-paranoid)
|
||||
nil
|
||||
url-cookie-multiple-line))
|
||||
(url-confirmation-func (if (memq 'post webmail-paranoid)
|
||||
'webmail-url-confirmation-func
|
||||
url-confirmation-func))
|
||||
(url-http-silence-on-insecure-redirection t)
|
||||
url-cookie-storage url-cookie-secure-storage
|
||||
url-cookie-confirmation
|
||||
item id (n 0))
|
||||
(webmail-init)
|
||||
(setq webmail-articles nil)
|
||||
(when webmail-open-url
|
||||
(erase-buffer)
|
||||
(webmail-url webmail-open-url))
|
||||
(if webmail-open-snarf (funcall webmail-open-snarf))
|
||||
(when webmail-login-url
|
||||
(erase-buffer)
|
||||
(webmail-url webmail-login-url))
|
||||
(if webmail-login-snarf
|
||||
(funcall webmail-login-snarf))
|
||||
(when webmail-list-url
|
||||
(erase-buffer)
|
||||
(webmail-url webmail-list-url))
|
||||
(if webmail-list-snarf
|
||||
(funcall webmail-list-snarf))
|
||||
(while (setq item (pop webmail-articles))
|
||||
(message "Fetching mail #%d..." (setq n (1+ n)))
|
||||
(erase-buffer)
|
||||
(mm-with-unibyte-current-buffer
|
||||
(mm-url-insert (cdr item)))
|
||||
(setq id (car item))
|
||||
(if webmail-article-snarf
|
||||
(funcall webmail-article-snarf file id))
|
||||
(when (and webmail-trash-url webmail-move-to-trash-can)
|
||||
(message "Move mail #%d to trash can..." n)
|
||||
(condition-case err
|
||||
(progn
|
||||
(webmail-url webmail-trash-url)
|
||||
(let (buf)
|
||||
(while (setq buf (pop webmail-buffer-list))
|
||||
(kill-buffer buf))))
|
||||
(error
|
||||
(let (buf)
|
||||
(while (setq buf (pop webmail-buffer-list))
|
||||
(kill-buffer buf)))
|
||||
(error err))))))
|
||||
(if webmail-post-process
|
||||
(funcall webmail-post-process))))
|
||||
|
||||
(defun webmail-encode-8bit ()
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward "^\200-\377")
|
||||
(while (not (eobp))
|
||||
(insert (format "&%d;" (mm-char-int (char-after))))
|
||||
(delete-char 1)
|
||||
(skip-chars-forward "^\200-\377")))
|
||||
|
||||
;;; hotmail
|
||||
|
||||
(defun webmail-hotmail-open ()
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
|
||||
(setq webmail-aux (match-string 1))
|
||||
(webmail-error "open@1")))
|
||||
|
||||
(defun webmail-hotmail-login ()
|
||||
(let (site)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
|
||||
(setq site (match-string 1))
|
||||
(webmail-error "login@1"))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
|
||||
(setq webmail-aux (concat "http://" site (match-string 1)))
|
||||
(webmail-error "login@2"))))
|
||||
|
||||
(defun webmail-hotmail-list ()
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward " \t\n\r")
|
||||
(let (site url newp (total "0"))
|
||||
(if (eobp)
|
||||
(setq total "0")
|
||||
(if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
|
||||
(message "Found %s (%s new)" (setq total (match-string 1))
|
||||
(match-string 2))
|
||||
(if (re-search-forward "\\([0-9]+\\) new" nil t)
|
||||
(message "Found %s new" (setq total (match-string 1)))
|
||||
(webmail-error "list@0"))))
|
||||
(unless (equal total "0")
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
|
||||
(setq site (match-string 1))
|
||||
(webmail-error "list@1"))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "disk=\\([^&]*\\)&" nil t)
|
||||
(setq webmail-aux
|
||||
(concat "http://" site "/cgi-bin/HoTMaiL?disk="
|
||||
(match-string 1)))
|
||||
(webmail-error "list@2"))
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward
|
||||
"newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
|
||||
nil t)
|
||||
(if (setq url (match-string 1))
|
||||
(progn
|
||||
(if (or newp (not webmail-newmail-only))
|
||||
(let (id)
|
||||
(if (string-match "msg=\\([^&]+\\)" url)
|
||||
(setq id (match-string 1 url)))
|
||||
(push (cons id (concat "http://" site url "&raw=0"))
|
||||
webmail-articles)))
|
||||
(setq newp nil))
|
||||
(setq newp t))))))
|
||||
|
||||
;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
|
||||
|
||||
(defun webmail-hotmail-article (file id)
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward " \t\n\r")
|
||||
(unless (eobp)
|
||||
(if (not (search-forward "<pre>" nil t))
|
||||
(webmail-error "article@3"))
|
||||
(skip-chars-forward "\n\r\t ")
|
||||
(delete-region (point-min) (point))
|
||||
(if (not (search-forward "</pre>" nil t))
|
||||
(webmail-error "article@3.1"))
|
||||
(delete-region (match-beginning 0) (point-max))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\r\n?" nil t)
|
||||
(replace-match "\n"))
|
||||
(goto-char (point-min))
|
||||
(insert "\n\n")
|
||||
(if (not (looking-at "\n*From "))
|
||||
(insert "From nobody " (current-time-string) "\n")
|
||||
(forward-line))
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
(defun webmail-hotmail-article-old (file id)
|
||||
(let (p attachment count mime hotmail-direct)
|
||||
(save-restriction
|
||||
(webmail-encode-8bit)
|
||||
(goto-char (point-min))
|
||||
(if (not (search-forward "<DIV>" nil t))
|
||||
(if (not (search-forward "Reply All" nil t))
|
||||
(webmail-error "article@1")
|
||||
(setq hotmail-direct t))
|
||||
(goto-char (match-beginning 0)))
|
||||
(narrow-to-region (point-min) (point))
|
||||
(if (not (search-backward "<table" nil t 2))
|
||||
(webmail-error "article@1.1"))
|
||||
(delete-region (point-min) (match-beginning 0))
|
||||
(while (search-forward "<a href=" nil t)
|
||||
(setq p (match-beginning 0))
|
||||
(search-forward "</a>" nil t)
|
||||
(delete-region p (match-end 0)))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(delete-blank-lines)
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "\n\n" nil t)
|
||||
(backward-char)
|
||||
(delete-region (point) (point-max)))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(insert "\n")
|
||||
(setq p (point))
|
||||
(while (re-search-forward
|
||||
"<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
|
||||
nil t)
|
||||
(if (setq attachment (match-string 1))
|
||||
(let ((filename (match-string 2))
|
||||
bufname);; Attachment
|
||||
(delete-region p (match-end 0))
|
||||
(save-excursion
|
||||
(set-buffer (generate-new-buffer " *webmail-att*"))
|
||||
(mm-url-insert attachment)
|
||||
(push (current-buffer) webmail-buffer-list)
|
||||
(setq bufname (buffer-name)))
|
||||
(setq mime t)
|
||||
(insert "<#part type="
|
||||
(or (and filename
|
||||
(string-match "\\.[^\\.]+$" filename)
|
||||
(mailcap-extension-to-mime
|
||||
(match-string 0 filename)))
|
||||
"application/octet-stream"))
|
||||
(insert " buffer=\"" bufname "\"")
|
||||
(insert " filename=\"" filename "\"")
|
||||
(insert " disposition=\"inline\"")
|
||||
(insert "><#/part>\n")
|
||||
(setq p (point)))
|
||||
(delete-region p (match-end 0))
|
||||
(if hotmail-direct
|
||||
(if (not (search-forward "</tt>" nil t))
|
||||
(webmail-error "article@1.2")
|
||||
(delete-region (match-beginning 0) (match-end 0)))
|
||||
(setq count 1)
|
||||
(while (and (> count 0)
|
||||
(re-search-forward "</div>\\|\\(<div>\\)" nil t))
|
||||
(if (match-string 1)
|
||||
(setq count (1+ count))
|
||||
(if (= (setq count (1- count)) 0)
|
||||
(delete-region (match-beginning 0)
|
||||
(match-end 0))))))
|
||||
(narrow-to-region p (point))
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
((looking-at "<pre>")
|
||||
(goto-char (match-end 0))
|
||||
(if (looking-at "$") (forward-char))
|
||||
(delete-region (point-min) (point))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
nil)
|
||||
(t
|
||||
(setq mime t)
|
||||
(insert "<#part type=\"text/html\" disposition=inline>")
|
||||
(goto-char (point-max))
|
||||
(insert "<#/part>")))
|
||||
(goto-char (point-max))
|
||||
(setq p (point))
|
||||
(widen)))
|
||||
(delete-region p (point-max))
|
||||
(goto-char (point-min))
|
||||
;; Some blank line to separate mails.
|
||||
(insert "\n\nFrom nobody " (current-time-string) "\n")
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(if id
|
||||
(insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
|
||||
(unless (looking-at "$")
|
||||
(if (search-forward "\n\n" nil t)
|
||||
(forward-line -1)
|
||||
(webmail-error "article@2")))
|
||||
(narrow-to-region (point) (point-max))
|
||||
(if mime
|
||||
(insert "MIME-Version: 1.0\n"
|
||||
(prog1
|
||||
(mml-generate-mime)
|
||||
(delete-region (point-min) (point-max)))))
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(let (case-fold-search)
|
||||
(while (re-search-forward "^From " nil t)
|
||||
(beginning-of-line)
|
||||
(insert ">"))))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
;;; yahoo
|
||||
|
||||
(defun webmail-yahoo-open ()
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
|
||||
(setq webmail-aux (match-string 1))
|
||||
(webmail-error "open@1")))
|
||||
|
||||
(defun webmail-yahoo-login ()
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t)
|
||||
(setq webmail-aux (match-string 0))
|
||||
(webmail-error "login@1"))
|
||||
(if (re-search-forward "YY=[0-9]+" nil t)
|
||||
(setq webmail-aux (concat webmail-aux "ym/ShowFolder?"
|
||||
(match-string 0)))
|
||||
(webmail-error "login@2")))
|
||||
|
||||
(defun webmail-yahoo-list ()
|
||||
(let (url (newp t) (tofetch 0))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
|
||||
;;(setq listed (match-string 1))
|
||||
(message "Found %s mail(s)" (match-string 2)))
|
||||
(if (string-match "http://[^/]+" webmail-aux)
|
||||
(setq webmail-aux (match-string 0 webmail-aux))
|
||||
(webmail-error "list@1"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
|
||||
nil t)
|
||||
(if (setq url (match-string 1))
|
||||
(progn
|
||||
(when (or newp (not webmail-newmail-only))
|
||||
(push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
|
||||
webmail-articles)
|
||||
(setq tofetch (1+ tofetch)))
|
||||
(setq newp t))
|
||||
(setq newp nil)))
|
||||
(setq webmail-articles (nreverse webmail-articles))
|
||||
(message "Fetching %d mail(s)" tofetch)))
|
||||
|
||||
(defun webmail-yahoo-article (file id)
|
||||
(let (p attachment)
|
||||
(save-restriction
|
||||
(goto-char (point-min))
|
||||
(if (not (search-forward "value=\"Done\"" nil t))
|
||||
(webmail-error "article@1"))
|
||||
(if (not (search-forward "<table" nil t))
|
||||
(webmail-error "article@2"))
|
||||
(delete-region (point-min) (match-beginning 0))
|
||||
(if (not (search-forward "</table>" nil t))
|
||||
(webmail-error "article@3"))
|
||||
(narrow-to-region (point-min) (match-end 0))
|
||||
(while (search-forward "<a href=" nil t)
|
||||
(setq p (match-beginning 0))
|
||||
(search-forward "</a>" nil t)
|
||||
(delete-region p (match-end 0)))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(delete-blank-lines)
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(insert "\n")
|
||||
(setq p (point))
|
||||
(while (re-search-forward "[^\"]*/ShowLetter/[^\?]+\?[^\"]*" nil t)
|
||||
(setq attachment (match-string 0))
|
||||
(let (bufname ct ctl cd description)
|
||||
(if (not (search-forward "<table" nil t))
|
||||
(webmail-error "article@4"))
|
||||
(delete-region p (match-beginning 0))
|
||||
(if (not (search-forward "</table>" nil t))
|
||||
(webmail-error "article@5"))
|
||||
(narrow-to-region p (match-end 0))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(delete-blank-lines)
|
||||
(setq ct (mail-fetch-field "content-type")
|
||||
ctl (and ct (mail-header-parse-content-type ct))
|
||||
;;cte (mail-fetch-field "content-transfer-encoding")
|
||||
cd (mail-fetch-field "content-disposition")
|
||||
description (mail-fetch-field "content-description")
|
||||
id (mail-fetch-field "content-id"))
|
||||
(delete-region (point-min) (point-max))
|
||||
(widen)
|
||||
(save-excursion
|
||||
(set-buffer (generate-new-buffer " *webmail-att*"))
|
||||
(mm-url-insert (concat webmail-aux attachment))
|
||||
(push (current-buffer) webmail-buffer-list)
|
||||
(setq bufname (buffer-name)))
|
||||
(insert "<#part")
|
||||
(if (and ctl (not (equal (car ctl) "text/")))
|
||||
(insert " type=\"" (car ctl) "\""))
|
||||
(insert " buffer=\"" bufname "\"")
|
||||
(if cd
|
||||
(insert " disposition=\"" cd "\""))
|
||||
(if description
|
||||
(insert " description=\"" description "\""))
|
||||
(insert "><#/part>\n")
|
||||
(setq p (point))))
|
||||
(delete-region p (point-max))
|
||||
(goto-char (point-min))
|
||||
;; Some blank line to separate mails.
|
||||
(insert "\n\nFrom nobody " (current-time-string) "\n")
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(if id
|
||||
(insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
|
||||
(unless (looking-at "$")
|
||||
(if (search-forward "\n\n" nil t)
|
||||
(forward-line -1)
|
||||
(webmail-error "article@2")))
|
||||
(narrow-to-region (point) (point-max))
|
||||
(insert "MIME-Version: 1.0\n"
|
||||
(prog1
|
||||
(mml-generate-mime)
|
||||
(delete-region (point-min) (point-max))))
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(let (case-fold-search)
|
||||
(while (re-search-forward "^From " nil t)
|
||||
(beginning-of-line)
|
||||
(insert ">"))))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
;;; netaddress
|
||||
|
||||
(defun webmail-netaddress-open ()
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
|
||||
(setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
|
||||
(webmail-error "open@1")))
|
||||
|
||||
(defun webmail-netaddress-login ()
|
||||
(webmail-refresh-redirect)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "tpl/[^/]+/\\([^/]+\\)" nil t)
|
||||
(setq webmail-session (match-string 1))
|
||||
(webmail-error "login@1")))
|
||||
|
||||
(defun webmail-netaddress-list ()
|
||||
(webmail-refresh-redirect)
|
||||
(let (item id)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
|
||||
(message "Found %s mail(s), %s unread"
|
||||
(match-string 2) (match-string 1)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
"MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
|
||||
(if (setq id (match-string 2))
|
||||
(setq item
|
||||
(cons id
|
||||
(format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
|
||||
(car webmail-article-url)
|
||||
webmail-session id)))
|
||||
(if (or (not webmail-newmail-only)
|
||||
(equal (match-string 1) "True"))
|
||||
(push item webmail-articles))))
|
||||
(setq webmail-articles (nreverse webmail-articles))))
|
||||
|
||||
(defun webmail-netaddress-single-part ()
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
|
||||
;; text/plain
|
||||
(replace-match "")
|
||||
(while (re-search-forward "[\t\040\r\n]+" nil t)
|
||||
(replace-match " "))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "<br>" nil t)
|
||||
(replace-match "\n"))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
nil)
|
||||
(t
|
||||
(insert "<#part type=\"text/html\" disposition=inline>")
|
||||
(goto-char (point-max))
|
||||
(insert "<#/part>")
|
||||
t)))
|
||||
|
||||
(defun webmail-netaddress-article (file id)
|
||||
(webmail-refresh-redirect)
|
||||
(let (p p1 attachment count mime type)
|
||||
(save-restriction
|
||||
(webmail-encode-8bit)
|
||||
(goto-char (point-min))
|
||||
(if (not (search-forward "Trash" nil t))
|
||||
(webmail-error "article@1"))
|
||||
(if (not (search-forward "<form>" nil t))
|
||||
(webmail-error "article@2"))
|
||||
(delete-region (point-min) (match-beginning 0))
|
||||
(if (not (search-forward "</form>" nil t))
|
||||
(webmail-error "article@3"))
|
||||
(narrow-to-region (point-min) (match-end 0))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[\040\t\r\n]+" nil t)
|
||||
(replace-match " "))
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "<b>" nil t)
|
||||
(replace-match "\n"))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities-nbsp)
|
||||
(goto-char (point-min))
|
||||
(delete-blank-lines)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\040+\\|\040+$" nil t)
|
||||
(replace-match ""))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\040+" nil t)
|
||||
(replace-match " "))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(insert "\n\n")
|
||||
(setq p (point))
|
||||
(unless (search-forward "<!-- Data -->" nil t)
|
||||
(webmail-error "article@4"))
|
||||
(forward-line 14)
|
||||
(delete-region p (point))
|
||||
(goto-char (point-max))
|
||||
(unless (re-search-backward
|
||||
"[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
|
||||
(webmail-error "article@5"))
|
||||
(delete-region (point) (point-max))
|
||||
(goto-char p)
|
||||
(while (search-forward
|
||||
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
|
||||
nil t 2)
|
||||
(setq mime t)
|
||||
(unless (search-forward "</TABLE>" nil t)
|
||||
(webmail-error "article@6"))
|
||||
(setq p1 (point))
|
||||
(if (search-backward "<IMG " p t)
|
||||
(progn
|
||||
(unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
|
||||
(webmail-error "article@7"))
|
||||
(setq attachment (match-string 1))
|
||||
(setq type (match-string 2))
|
||||
(unless (search-forward "</TABLE>" nil t)
|
||||
(webmail-error "article@8"))
|
||||
(delete-region p (point))
|
||||
(let (bufname);; Attachment
|
||||
(save-excursion
|
||||
(set-buffer (generate-new-buffer " *webmail-att*"))
|
||||
(mm-url-insert (concat (car webmail-open-url) attachment))
|
||||
(push (current-buffer) webmail-buffer-list)
|
||||
(setq bufname (buffer-name)))
|
||||
(insert "<#part type=" type)
|
||||
(insert " buffer=\"" bufname "\"")
|
||||
(insert " disposition=\"inline\"")
|
||||
(insert "><#/part>\n")
|
||||
(setq p (point))))
|
||||
(delete-region p p1)
|
||||
(narrow-to-region
|
||||
p
|
||||
(if (search-forward
|
||||
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
|
||||
nil t)
|
||||
(match-beginning 0)
|
||||
(point-max)))
|
||||
(webmail-netaddress-single-part)
|
||||
(goto-char (point-max))
|
||||
(setq p (point))
|
||||
(widen)))
|
||||
(unless mime
|
||||
(narrow-to-region p (point-max))
|
||||
(setq mime (webmail-netaddress-single-part))
|
||||
(widen))
|
||||
(goto-char (point-min))
|
||||
;; Some blank line to separate mails.
|
||||
(insert "\n\nFrom nobody " (current-time-string) "\n")
|
||||
(insert "X-Gnus-Webmail: " (symbol-value 'user)
|
||||
"@" (symbol-name webmail-type) "\n")
|
||||
(if id
|
||||
(insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
|
||||
(unless (looking-at "$")
|
||||
(if (search-forward "\n\n" nil t)
|
||||
(forward-line -1)
|
||||
(webmail-error "article@2")))
|
||||
(when mime
|
||||
(narrow-to-region (point-min) (point))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (looking-at "MIME-Version\\|Content-Type")
|
||||
(delete-region (point)
|
||||
(progn
|
||||
(forward-line 1)
|
||||
(if (re-search-forward "^[^ \t]" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(point-max))))
|
||||
(forward-line 1)))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(narrow-to-region (point) (point-max))
|
||||
(insert "MIME-Version: 1.0\n"
|
||||
(prog1
|
||||
(mml-generate-mime)
|
||||
(delete-region (point-min) (point-max))))
|
||||
(goto-char (point-min))
|
||||
(widen))
|
||||
(let (case-fold-search)
|
||||
(while (re-search-forward "^From " nil t)
|
||||
(beginning-of-line)
|
||||
(insert ">"))))
|
||||
(mm-append-to-file (point-min) (point-max) file)))
|
||||
|
||||
(provide 'webmail)
|
||||
|
||||
;;; webmail.el ends here
|
||||
|
|
@ -131,19 +131,23 @@ Entries without port tokens default to DEFAULTPORT."
|
|||
;; No machine name matches, so we look for default entries.
|
||||
(while rest
|
||||
(when (assoc "default" (car rest))
|
||||
(push (car rest) result))
|
||||
(let ((elem (car rest)))
|
||||
(setq elem (delete (assoc "default" elem) elem))
|
||||
(push elem result)))
|
||||
(pop rest)))
|
||||
(when result
|
||||
(setq result (nreverse result))
|
||||
(while (and result
|
||||
(not (netrc-port-equal
|
||||
(or port defaultport "nntp")
|
||||
;; when port is not given in the netrc file,
|
||||
;; it should mean "any port"
|
||||
(or (netrc-get (car result) "port")
|
||||
defaultport port))))
|
||||
(pop result))
|
||||
(car result))))
|
||||
(if (not port)
|
||||
(car result)
|
||||
(while (and result
|
||||
(not (netrc-port-equal
|
||||
(or port defaultport "nntp")
|
||||
;; when port is not given in the netrc file,
|
||||
;; it should mean "any port"
|
||||
(or (netrc-get (car result) "port")
|
||||
defaultport port))))
|
||||
(pop result))
|
||||
(car result)))))
|
||||
|
||||
(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
|
||||
"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
|
|||
listed in the PORTS list."
|
||||
(let ((list (netrc-parse))
|
||||
found)
|
||||
(while (and ports
|
||||
(not found))
|
||||
(setq found (netrc-machine list machine (pop ports))))
|
||||
(if (not ports)
|
||||
(setq found (netrc-machine list machine))
|
||||
(while (and ports
|
||||
(not found))
|
||||
(setq found (netrc-machine list machine (pop ports)))))
|
||||
(when found
|
||||
(list (cdr (assoc "login" found))
|
||||
(cdr (assoc "password" found))))))
|
||||
|
|
|
|||
|
|
@ -75,9 +75,14 @@ and `gnutls-cli' (version 2.0.1) output."
|
|||
:type 'regexp
|
||||
:group 'tls)
|
||||
|
||||
(defcustom tls-program '("gnutls-cli -p %p %h"
|
||||
"gnutls-cli -p %p %h --protocols ssl3"
|
||||
"openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
|
||||
(defvar tls-starttls-switches
|
||||
'(("gnutls-cli" "-s")
|
||||
("openssl" "-starttls imap"))
|
||||
"Alist of programs and the switches necessary to get starttls behaviour.")
|
||||
|
||||
(defcustom tls-program '("gnutls-cli %s -p %p %h"
|
||||
"gnutls-cli %s -p %p %h --protocols ssl3"
|
||||
"openssl s_client %s -connect %h:%p -no_ssl2 -ign_eof")
|
||||
"List of strings containing commands to start TLS stream to a host.
|
||||
Each entry in the list is tried until a connection is successful.
|
||||
%h is replaced with server hostname, %p with port to connect to.
|
||||
|
|
@ -199,7 +204,7 @@ Used by `tls-certificate-information'."
|
|||
(push (cons (match-string 1) (match-string 2)) vals))
|
||||
(nreverse vals))))))
|
||||
|
||||
(defun open-tls-stream (name buffer host port)
|
||||
(defun open-tls-stream (name buffer host port &optional starttlsp)
|
||||
"Open a TLS connection for a port to a host.
|
||||
Returns a subprocess-object to represent the connection.
|
||||
Input 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."
|
|||
(format-spec
|
||||
cmd
|
||||
(format-spec-make
|
||||
?s (if starttlsp
|
||||
(tls-find-starttls-argument cmd)
|
||||
"")
|
||||
?h host
|
||||
?p (if (integerp port)
|
||||
(int-to-string port)
|
||||
|
|
@ -300,6 +308,11 @@ match `%s'. Connect anyway? " host))))))
|
|||
(kill-buffer buffer))
|
||||
done))
|
||||
|
||||
(defun tls-find-starttls-argument (command)
|
||||
(let ((command (car (split-string command))))
|
||||
(or (cadr (assoc command tls-starttls-switches))
|
||||
"")))
|
||||
|
||||
(provide 'tls)
|
||||
|
||||
;;; tls.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue