procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge changes made in Gnus trunk.

Browse source 
auth.texi (Help for users): Mention ~/.netrc is also searched by default now.
gnus-start.el (gnus-dribble-read-file): Set buffer-save-without-query, since we always want to save the dribble file, probably.
nnmail.el (nnmail-article-group): Allow a final "" split to work on nnimap.
gnus-sum.el (gnus-user-date-format-alist): Renamed back again from -summary- since it's a user-visible variable.
nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the first time you use the new Gnus.
auth-source.el: Don't load netrc.el.
 (auth-sources): Search ~/.netrc as well by default.
 (auth-source-debug): Add 'trivia option for extra output.
 (auth-source-do-trivia): Use it.
 (auth-source-search): Simplify logic to use `auth-source-search-backends'.  Use `auth-source-do-trivia' where appropriate.  Don't keep a running count at this level.  Layer :create and :delete options appropriately on the first and second passes.  Don't track the backend with the search results.
 (auth-source-search-backends): New function to search a list of backends for a processed spec.
 (auth-source-netrc-parse): Cache all netrc files, making auth-source-netrc-cache an alist keyed by the file name and using the file mtime as the caching criterion.  Keep the obfuscated data secret with a lexical bind.
 (auth-source-netrc-search): Don't calculate the length of the results unnecessarily.
 (auth-source-search-backends): Fix bug.
 (auth-source-netrc-create): Rework prompts.
nnir.el (nnir-imap-search-arguments,nnir-imap-default-search-key): Lower case names of search constraints.
 (nnir-run-query): Cache and reuse search constraints for all imap servers.
gnus-msg.el (gnus-setup-message): Define missing variable from last checkin.
This commit is contained in:
Gnus developers 2011-02-23 13:35:35 +00:00 • committed by Katsumi Yamaoka
parent 0d327994db
commit 4a3988d518
10 changed files with 218 additions and 166 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
doc/misc/ChangeLog
View file

@ -19,6 +19,11 @@
(Local Variables): Say this is obsolete. Fix description of
dired-enable-local-variables possible values.
2011-02-22 Teodor Zlatanov <tzz@lifelogs.com>
* auth.texi (Help for users): Mention ~/.netrc is also searched by
default now.
2011-02-21 Lars Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Article Date): Clarify gnus-article-update-date-headers.

10
doc/misc/auth.texi
View file

@ -127,8 +127,8 @@ you will be pwned as the kids say.
``Netrc'' files are usually called @code{.authinfo} or @code{.netrc};
nowadays @code{.authinfo} seems to be more popular and the auth-source
library encourages this confusion by making it the default, as you'll
see later.
library encourages this confusion by accepting both, as you'll see
later.
If you have problems with the search, set @code{auth-source-debug} to
@code{t} and see what host, port, and user the library is checking in
@ -159,7 +159,7 @@ and simplest configuration is:
;;; mostly equivalent (see below about fallbacks) but shorter:
(setq auth-sources '((:source "~/.authinfo.gpg")))
;;; even shorter and the @emph{default}:
(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo"))
(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc"))
;;; use the Secrets API @var{Login} collection (@pxref{Secret Service API})
(setq auth-sources '("secrets:Login"))
@end lisp
@ -184,8 +184,8 @@ the defaults: any host and any port are looked up in the netrc
file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file
(@pxref{GnuPG and EasyPG Assistant Configuration}).
If that fails, the unencrypted netrc file @code{~/.authinfo} will
be used.
If that fails, the unencrypted netrc files @code{~/.authinfo} and
@code{~/.netrc} will be used.
The typical netrc line example is without a port.

45
lisp/gnus/ChangeLog
View file

@ -1,3 +1,47 @@
2011-02-23 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-dribble-read-file): Set
buffer-save-without-query, since we always want to save the dribble
file, probably.
* nnmail.el (nnmail-article-group): Allow a final "" split to work on
nnimap.
* gnus-sum.el (gnus-user-date-format-alist): Renamed back again from
-summary- since it's a user-visible variable.
* nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the
first time you use the new Gnus.
2011-02-22 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el: Don't load netrc.el.
(auth-sources): Search ~/.netrc as well by default.
(auth-source-debug): Add 'trivia option for extra output.
(auth-source-do-trivia): Use it.
(auth-source-search): Simplify logic to use
`auth-source-search-backends'. Use `auth-source-do-trivia' where
appropriate. Don't keep a running count at this level. Layer :create
and :delete options appropriately on the first and second passes.
Don't track the backend with the search results.
(auth-source-search-backends): New function to search a list of
backends for a processed spec.
(auth-source-netrc-parse): Cache all netrc files, making
auth-source-netrc-cache an alist keyed by the file name and using the
file mtime as the caching criterion. Keep the obfuscated data secret
with a lexical bind.
(auth-source-netrc-search): Don't calculate the length of the results
unnecessarily.
(auth-source-search-backends): Fix bug.
(auth-source-netrc-create): Rework prompts.
2011-02-22 Andrew Cohen <cohen@andy.bu.edu>
* nnir.el (nnir-imap-search-arguments,nnir-imap-default-search-key):
Lower case names of search constraints.
(nnir-run-query): Cache and reuse search constraints for all imap
servers.
2011-02-22 Sam Steingold <sds@gnu.org>
* gnus-msg.el (gnus-setup-message): Also bind `winconf-name'.
@ -6,6 +50,7 @@
* gnus-msg.el (gnus-inews-add-send-actions): Restore the winconf name
after exit.
(gnus-setup-message): Define missing variable from last checkin.
* gnus-sum.el (gnus-summary-show-article): When called with t as the
value, show the raw article.

275
lisp/gnus/auth-source.el
View file

@ -42,7 +42,6 @@
(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
(require 'netrc)
(require 'assoc)
(eval-when-compile (require 'cl))
(require 'eieio)
@ -164,16 +163,19 @@ If the value is a function, debug messages are logged by calling
:type `(choice
:tag "auth-source debugging mode"
(const :tag "Log using `message' to the *Messages* buffer" t)
(const :tag "Log all trivia with `message' to the *Messages* buffer"
trivia)
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
packages to be encrypted. If that file doesn't exist, it will
try the unencrypted version \"~/.authinfo\".
try the unencrypted version \"~/.authinfo\" and the famous
\"~/.netrc\" file.
See the auth.info manual for details.
@ -256,6 +258,11 @@ If the value is not a list, symmetric encryption will be used."
(when auth-source-debug
(apply 'auth-source-do-warn msg)))
(defun auth-source-do-trivia (&rest msg)
(when (or (eq auth-source-debug 'trivia)
(functionp auth-source-debug))
(apply 'auth-source-do-warn msg)))
(defun auth-source-do-warn (&rest msg)
(apply
;; set logger to either the function in auth-source-debug or 'message
@ -500,7 +507,7 @@ must call it to obtain the actual value."
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
(found (auth-source-recall spec))
filtered-backends accessor-key found-here goal matches backend)
filtered-backends accessor-key backend)
(if (and found auth-source-do-cache)
(auth-source-do-debug
@ -509,7 +516,7 @@ must call it to obtain the actual value."
(assert
(or (eq t create) (listp create)) t
"Invalid auth-source :create parameter (must be nil, t, or a list): %s %s")
"Invalid auth-source :create parameter (must be t or a list): %s %s")
(setq filtered-backends (copy-sequence backends))
(dolist (backend backends)
@ -523,66 +530,64 @@ must call it to obtain the actual value."
(return))
(invalid-slot-name))))
(auth-source-do-debug
(auth-source-do-trivia
"auth-source-search: found %d backends matching %S"
(length filtered-backends) spec)
;; (debug spec "filtered" filtered-backends)
(setq goal max)
;; First go through all the backends without :create, so we can
;; query them all.
(let ((uspec (copy-sequence spec)))
(plist-put uspec :create nil)
(dolist (backend filtered-backends)
(let ((match (apply
(slot-value backend 'search-function)
:backend backend
uspec)))
(when match
(push (list backend match) matches)))))
(setq found (auth-source-search-backends filtered-backends
spec
;; to exit early
max
;; create and delete
nil delete))
(auth-source-do-debug
"auth-source-search: found %d results (max %d) matching %S"
(length found) max spec)
;; If we didn't find anything, then we allow the backend(s) to
;; create the entries.
(when (and create
(not matches))
(dolist (backend filtered-backends)
(unless matches
(let ((match (apply
(slot-value backend 'search-function)
:backend backend
:create create
:delete delete
spec)))
(when match
(push (list backend match) matches))))))
(not found))
(setq found (auth-source-search-backends filtered-backends
spec
;; to exit early
max
;; create and delete
create delete))
(auth-source-do-warn
"auth-source-search: CREATED %d results (max %d) matching %S"
(length found) max spec))
(setq backend (caar matches)
found-here (cadar matches))
(when (and found auth-source-do-cache)
(auth-source-remember spec found)))
(block nil
;; if max is 0, as soon as we find something, return it
(when (and (zerop max) (> 0 (length found-here)))
(return t))
found))
;; decrement the goal by the number of new results
(decf goal (length found-here))
;; and append the new results to the full list
(setq found (append found found-here))
(auth-source-do-debug
"auth-source-search: found %d results (max %d/%d) in %S matching %S"
(length found-here) max goal backend spec)
;; return full list if the goal is 0 or negative
(when (zerop (max 0 goal))
(return found))
;; change the :max parameter in the spec to the goal
(setq spec (plist-put spec :max goal))
(when (and found auth-source-do-cache)
(auth-source-remember spec found))))
found))
(defun auth-source-search-backends (backends spec max create delete)
(let (matches)
(dolist (backend backends)
(when (> max (length matches)) ; when we need more matches...
(let ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
;; note we're overriding whatever the spec
;; has for :create and :delete
:create create
:delete delete
spec)))
(when bmatches
(auth-source-do-trivia
"auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
(length bmatches) max
(slot-value backend :type)
(slot-value backend :source)
spec)
(setq matches (append matches bmatches))))))
matches))
;;; (auth-source-search :max 1)
;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
@ -704,25 +709,35 @@ Note that the MAX parameter is used so we can exit the parse early."
(when (file-exists-p file)
(setq port (auth-source-ensure-strings port))
(with-temp-buffer
(let ((tokens '("machine" "host" "default" "login" "user"
"password" "account" "macdef" "force"
"port" "protocol"))
(max (or max 5000)) ; sanity check: default to stop at 5K
(modified 0)
alist elem result pair)
(if (and auth-source-netrc-cache
(equal (car auth-source-netrc-cache)
(nth 5 (file-attributes file))))
(insert (base64-decode-string
(rot13-string (cdr auth-source-netrc-cache))))
(insert-file-contents file)
(when (string-match "\\.gpg\\'" file)
;; Store the contents of the file heavily encrypted in memory.
(setq auth-source-netrc-cache
(cons (nth 5 (file-attributes file))
(rot13-string
(base64-encode-string
(buffer-string)))))))
(let* ((tokens '("machine" "host" "default" "login" "user"
"password" "account" "macdef" "force"
"port" "protocol"))
(max (or max 5000)) ; sanity check: default to stop at 5K
(modified 0)
(cached (cdr-safe (assoc file auth-source-netrc-cache)))
(cached-mtime (plist-get cached :mtime))
(cached-secrets (plist-get cached :secret))
alist elem result pair)
(if (and (functionp cached-secrets)
(equal cached-mtime
(nth 5 (file-attributes file))))
(progn
(auth-source-do-trivia
"auth-source-netrc-parse: using CACHED file data for %s"
file)
(insert (funcall cached-secrets)))
(insert-file-contents file)
;; cache all netrc files (used to be just .gpg files)
;; Store the contents of the file heavily encrypted in memory.
;; (note for the irony-impaired: they are just obfuscated)
(aput 'auth-source-netrc-cache file
(list :mtime (nth 5 (file-attributes file))
:secret (lexical-let ((v (rot13-string
(base64-encode-string
(buffer-string)))))
(lambda () (base64-decode-string
(rot13-string v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
@ -868,7 +883,7 @@ See `auth-source-search' for details on SPEC."
;; if we need to create an entry AND none were found to match
(when (and create
(= 0 (length results)))
(not results))
;; create based on the spec and record the value
(setq results (or
@ -897,7 +912,6 @@ See `auth-source-search' for details on SPEC."
(required (append base-required create-extra))
(file (oref backend source))
(add "")
(show "")
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
@ -928,63 +942,29 @@ See `auth-source-search' for details on SPEC."
;; for each required element
(dolist (r required)
(let* ((data (aget valist r))
;; take the first element if the data is a list
(data (if (listp data)
(nth 0 data)
data))
;; this is the default to be offered
(given-default (aget auth-source-creation-defaults r))
;; the defaults are simple
;; the default supplementals are simple: for the user,
;; try (user-login-name), otherwise take given-default
(default (cond
((and (not given-default) (eq r 'user))
(user-login-name))
;; note we need this empty string
((and (not given-default) (eq r 'port))
"")
(t given-default)))
;; the prompt's default string depends on the data so far
(default-string (if (and default (< 0 (length default)))
(format " (default %s)" default)
" (no default)"))
;; the prompt should also show what's entered so far
(user-value (aget valist 'user))
(host-value (aget valist 'host))
(port-value (aget valist 'port))
;; note this handles lists by just printing them
;; later we allow the user to use completing-read to pick
(info-so-far (concat (if user-value
(format "%s@" user-value)
"[USER?]")
(if host-value
(format "%s" host-value)
"[HOST?]")
(if port-value
;; this distinguishes protocol between
(if (zerop (length port-value))
"" ; 'entered as "no default"' vs.
(format ":%s" port-value)) ; given
;; and this is when the protocol is unknown
"[PORT?]"))))
(t given-default))))
;; now prompt if the search SPEC did not include a required key;
;; take the result and put it in `data' AND store it in `valist'
(aput 'valist r
(setq data
(cond
((and (null data) (eq r 'secret))
;; special case prompt for passwords
(read-passwd (format "Password for %s: " info-so-far)))
((null data)
(read-string
(format "Enter %s for %s%s: "
r info-so-far default-string)
nil nil default))
((listp data)
(completing-read
(format "Enter %s for %s (TAB to see the choices): "
r info-so-far)
data
nil ; no predicate
t ; require a match
;; note the default is nil, but if the user
;; hits RET we'll get "", which is handled OK later
nil))
(t data))))
;; store the data, prompting for the password if needed
(setq data
(cond
((and (null data) (eq r 'secret))
;; special case prompt for passwords
(read-passwd (format "Password for %s@%s:%s: "
(or (aget valist 'user) "[any user]")
(or (aget valist 'host) "[any host]")
(or (aget valist 'port) "[any port]"))))
(t data)))
(when data
(setq artificial (plist-put artificial
@ -997,7 +977,9 @@ See `auth-source-search' for details on SPEC."
;; when r is not an empty string...
(when (and (stringp data)
(< 0 (length data)))
(let ((printer (lambda (hide)
;; this function is not strictly necessary but I think it
;; makes the code clearer -tzz
(let ((printer (lambda ()
;; append the key (the symbol name of r)
;; and the value in r
(format "%s%s %S"
@ -1005,17 +987,14 @@ See `auth-source-search' for details on SPEC."
(if (zerop (length add)) "" " ")
;; remap auth-source tokens to netrc
(case r
('user "login")
('host "machine")
('user "login")
('host "machine")
('secret "password")
('port "port") ; redundant but clearer
('port "port") ; redundant but clearer
(t (symbol-name r)))
;; the value will be printed in %S format
(if (and hide (eq r 'secret))
"HIDDEN_SECRET"
data)))))
(setq add (concat add (funcall printer nil)))
(setq show (concat show (funcall printer t)))))))
data))))
(setq add (concat add (funcall printer)))))))
(with-temp-buffer
(when (file-exists-p file)
@ -1032,17 +1011,35 @@ See `auth-source-search' for details on SPEC."
(goto-char (point-max))
;; ask AFTER we've successfully opened the file
(if (y-or-n-p (format "Add to file %s: line [%s]" file show))
(let (done k)
(while (not done)
(setq k (read-char-choice
(format "Add to file %s? %s: "
file
"(y)es/(n)o but use it/(e)dit line/(s)kip file")
'(?y ?n ?e ?s)))
(case k
(?y (setq done t))
(?n (setq add ""
done t))
(?s (setq add ""
done 'skip))
(?e (setq add (read-string "Line to add: " add)))
(t nil)))
(when (< 0 (length add))
(progn
(unless (bolp)
(insert "\n"))
(insert add "\n")
(write-region (point-min) (point-max) file nil 'silent)
(auth-source-do-debug
(auth-source-do-warn
"auth-source-netrc-create: wrote 1 new line to %s"
file)
nil)
(list artificial)))))
nil))
(when (eq done t)
(list artificial))))))
;;; Backend specific parsing: Secrets API backend

6
lisp/gnus/gnus-msg.el
View file

@ -383,7 +383,7 @@ Thank you for your help in stamping out bugs.
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(winconf-name (make-symbol "gnus-setup-message-winconf"))
(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
(yanked (make-symbol "gnus-setup-yanked-articles"))
@ -434,7 +434,7 @@ Thank you for your help in stamping out bugs.
(progn
,@forms)
(gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
,yanked ,winconf-name)
,yanked ',winconf-name)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
@ -542,7 +542,7 @@ Gcc: header for archiving purposes."
(gnus-post-method arg ,gnus-newsgroup-name)))
(message-add-action
`(progn
(setq gnus-current-window-configuration ,winconf-name)
(setq gnus-current-window-configuration ',winconf-name)
(when (gnus-buffer-exists-p ,buffer)
(set-window-configuration ,winconf)))
'exit 'postpone 'kill)

5
lisp/gnus/gnus-start.el
View file

@ -864,6 +864,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-get-buffer-create
(file-name-nondirectory dribble-file)))
(set (make-local-variable 'file-precious-flag) t)
(setq buffer-save-without-query t)
(erase-buffer)
(setq buffer-file-name dribble-file)
(auto-save-mode t)
@ -1717,8 +1718,8 @@ If SCAN, request a scan of that group as well."
gnus-secondary-select-methods))
(when (and (not (assoc method type-cache))
(gnus-check-backend-function 'request-list (car method)))
(with-current-buffer nntp-server-buffer
(gnus-read-active-file-1 method nil))))
(with-current-buffer nntp-server-buffer
(gnus-read-active-file-1 method nil))))
;; Do the rest of the retrieval.
(dolist (elem type-cache)

8
lisp/gnus/gnus-sum.el
View file

@ -3853,7 +3853,7 @@ This function is intended to be used in
((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
(t (format "%dM" (/ c (* 1024.0 1024)))))))
(defcustom gnus-summary-user-date-format-alist
(defcustom gnus-user-date-format-alist
'(((gnus-seconds-today) . "Today, %H:%M")
((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
(604800 . "%A %H:%M") ; That's one week
@ -3880,11 +3880,9 @@ respectively."
:version "24.1"
:group 'gnus-summary-format
:type '(alist :key-type sexp :value-type string))
(make-obsolete-variable 'gnus-user-date-format-alist
'gnus-summary-user-date-format-alist "24.1")
(defun gnus-user-date (messy-date)
"Format the messy-date according to `gnus-summary-user-date-format-alist'.
"Format the messy-date according to `gnus-user-date-format-alist'.
Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
@ -3893,7 +3891,7 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(let* ((difference (- now messy-date))
(templist gnus-summary-user-date-format-alist)
(templist gnus-user-date-format-alist)
(top (eval (caar templist))))
(while (if (numberp top) (< top difference) (not top))
(progn

1
lisp/gnus/nnimap.el
View file

@ -1151,6 +1151,7 @@ textual parts.")
(setf (nnimap-examined nnimap-object) group)
(if (and qresyncp
uidvalidity
active
modseq)
(push
(list (nnimap-send-command "EXAMINE %S (%s (%s %s))"

26
lisp/gnus/nnir.el
View file

@ -203,11 +203,12 @@
;; Imap variables
(defvar nnir-imap-search-arguments
'(("Whole message" . "TEXT")
("Subject" . "SUBJECT")
("To" . "TO")
("From" . "FROM")
("Imap" . ""))
'(("whole message" . "TEXT")
("subject" . "SUBJECT")
("to" . "TO")
("from" . "FROM")
("body" . "BODY")
("imap" . ""))
"Mapping from user readable keys to IMAP search items for use in nnir")
(defvar nnir-imap-search-other "HEADER %S"
@ -335,7 +336,7 @@ result, `gnus-retrieve-headers' will be called instead."
:type '(function)
:group 'nnir)
(defcustom nnir-imap-default-search-key "Whole message"
(defcustom nnir-imap-default-search-key "whole message"
"*The default IMAP search key for an nnir search. Must be one of
the keys in `nnir-imap-search-arguments'. To use raw imap queries
by default set this to \"Imap\"."
@ -1500,11 +1501,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(setq search-func (cadr (assoc nnir-search-engine
nnir-engines)))
(if search-func
(funcall search-func
(if nnir-extra-parms
(nnir-read-parms q nnir-search-engine)
q)
server (cadr x))
(funcall
search-func
(if nnir-extra-parms
(or (and (eq nnir-search-engine 'imap)
(assq 'criteria q) q)
(setq q (nnir-read-parms q nnir-search-engine)))
q)
server (cadr x))
nil)))
groups))))

3
lisp/gnus/nnmail.el
View file

@ -1215,7 +1215,8 @@ FUNC will be called with the group name to determine the article number."
;; This is the final group, which is used as a
;; catch-all.
(when (and (not group-art)
(not nnmail-inhibit-default-split-group))
(or (equal "" (nth 1 method))
(not nnmail-inhibit-default-split-group)))
(setq group-art
(list (cons (car method)
(funcall func (car method))))))))