From ed778fada51bffe8e6d69aefe9279f6f64f7b508 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Thu, 6 Nov 2008 00:49:23 +0000 Subject: [PATCH] Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1464 --- lisp/gnus/ChangeLog | 18 ++++++++++++++++ lisp/gnus/auth-source.el | 55 +++++++++++++++++++++++++++++++++++------------- lisp/gnus/starttls.el | 20 +++++++++++++++--- 3 files changed, 75 insertions(+), 18 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f311f4fdd30..82ace1a8ee9 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,21 @@ +2008-11-04 Katsumi Yamaoka + + * starttls.el (starttls-any-program-available): Rewritten so it doesn't + require itself and to remove `with-no-warnings'. + +2008-11-03 Teodor Zlatanov + + * starttls.el (starttls-any-program-available): Get the name of the + available TLS layer program. + (starttls-open-steam-gnutls, starttls-open-stream): Put port number as + well as the host name in the "opening" message. + + * auth-source.el (auth-source-cache, auth-source-do-cache) + (auth-source-user-or-password): Cache passwords and logins by default, + allow override with `auth-source-do-cache'. + (auth-source-forget-user-or-password): Allow users to remove cache + entries if needed. + 2008-10-31 Teodor Zlatanov * ietf-drums.el (ietf-drums-remove-comments): Localize second diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index a19327e79fb..523c901f764 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -91,6 +91,15 @@ p))) auth-source-protocols)) +(defvar auth-source-cache (make-hash-table :test 'equal) + "Cache for auth-source data") + +(defcustom auth-source-do-cache t + "Whether auth-source should cache information." + :group 'auth-source + :version "23.1" ;; No Gnus + :type `boolean) + (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)) "List of authentication sources. @@ -150,26 +159,42 @@ Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t." (unless fallback (auth-source-pick host protocol t))))) +(defun auth-source-forget-user-or-password (mode host protocol) + (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing + (remhash (format "%s %s:%s" mode host protocol) auth-source-cache)) + (defun auth-source-user-or-password (mode host protocol) "Find user or password (from the string MODE) matching HOST and PROTOCOL." (gnus-message 9 "auth-source-user-or-password: get %s for %s (%s)" mode host protocol) - (let (found) - (dolist (choice (auth-source-pick host protocol)) - (setq found (netrc-machine-user-or-password - mode - (plist-get choice :source) - (list host) - (list (format "%s" protocol)) - (auth-source-protocol-defaults protocol))) - (when found - (gnus-message 9 - "auth-source-user-or-password: found %s=%s for %s (%s)" - mode - ;; don't show the password - (if (equal mode "password") "SECRET" found) - host protocol) + (let* ((cname (format "%s %s:%s" mode host protocol)) + (found (gethash cname auth-source-cache))) + (if found + (progn + (gnus-message 9 + "auth-source-user-or-password: cached %s=%s for %s (%s)" + mode + ;; don't show the password + (if (equal mode "password") "SECRET" found) + host protocol) + found) + (dolist (choice (auth-source-pick host protocol)) + (setq found (netrc-machine-user-or-password + mode + (plist-get choice :source) + (list host) + (list (format "%s" protocol)) + (auth-source-protocol-defaults protocol))) + (when found + (gnus-message 9 + "auth-source-user-or-password: found %s=%s for %s (%s)" + mode + ;; don't show the password + (if (equal mode "password") "SECRET" found) + host protocol) + (when auth-source-do-cache + (puthash cname found auth-source-cache))) (return found))))) (defun auth-source-protocol-defaults (protocol) diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index 7aa13c26dcd..03d85226492 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el @@ -241,7 +241,7 @@ handshake, or nil on failure." 'process-kill-without-query))) (defun starttls-open-stream-gnutls (name buffer host port) - (message "Opening STARTTLS connection to `%s'..." host) + (message "Opening STARTTLS connection to `%s:%s'..." host port) (let* (done (old-max (with-current-buffer buffer (point-max))) (process-connection-type starttls-process-connection-type) @@ -266,8 +266,8 @@ handshake, or nil on failure." (delete-region old-max done)) (delete-process process) (setq process nil)) - (message "Opening STARTTLS connection to `%s'...%s" - host (if done "done" "failed")) + (message "Opening STARTTLS connection to `%s:%s'...%s" + host port (if done "done" "failed")) process)) (defun starttls-open-stream (name buffer host port) @@ -287,6 +287,7 @@ If `starttls-use-gnutls' is nil, this may also be a service name, but GNUTLS requires a port number." (if starttls-use-gnutls (starttls-open-stream-gnutls name buffer host port) + (message "Opening STARTTLS connection to `%s:%s'" host (format "%s" port)) (let* ((process-connection-type starttls-process-connection-type) (process (apply #'start-process name buffer starttls-program @@ -295,6 +296,19 @@ GNUTLS requires a port number." (starttls-set-process-query-on-exit-flag process nil) process))) +(defun starttls-any-program-available () + (let ((program (if starttls-use-gnutls + starttls-gnutls-program + starttls-program))) + (condition-case () + (progn + (call-process program) + program) + (error (progn + (message "No STARTTLS program was available (tried '%s')" + program) + nil))))) + (provide 'starttls) ;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297 -- 2.11.4.GIT