X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fauth-source.el;h=f4aa1db902ac71763575d42cbcccd2118e1038a5;hb=a127214820bcba5893da4f6e17d3cdc27d24cbc7;hp=7ac0d29bddb9e7260fa03c583a3d72bad9d45d51;hpb=8245dd3ea6eab6133b94643703cedb66d0d743a2;p=gnus diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 7ac0d29bd..f4aa1db90 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1,6 +1,6 @@ ;;; auth-source.el --- authentication sources for Gnus and Emacs -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008-2012 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news @@ -80,6 +80,8 @@ (autoload 'epg-context-set-armor "epg") (autoload 'epg-encrypt-string "epg") +(autoload 'help-mode "help-mode" nil t) + (defvar secrets-enabled) (defgroup auth-source nil @@ -92,6 +94,7 @@ "How many seconds passwords are cached, or nil to disable expiring. Overrides `password-cache-expiry' through a let-binding." + :version "24.1" :group 'auth-source :type '(choice (const :tag "Never" nil) (const :tag "All Day" 86400) @@ -757,28 +760,31 @@ Returns the deleted entries." do (password-cache-remove (symbol-name sym))) (setq auth-source-netrc-cache nil)) +(defun auth-source-format-cache-entry (spec) + "Format SPEC entry to put it in the password cache." + (concat auth-source-magic (format "%S" spec))) + (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." (let ((password-cache-expiry auth-source-cache-expiry)) (password-cache-add - (concat auth-source-magic (format "%S" spec)) found))) + (auth-source-format-cache-entry spec) found))) (defun auth-source-recall (spec) "Recall FOUND search results for SPEC." - (password-read-from-cache - (concat auth-source-magic (format "%S" spec)))) + (password-read-from-cache (auth-source-format-cache-entry spec))) (defun auth-source-remembered-p (spec) "Check if SPEC is remembered." (password-in-cache-p - (concat auth-source-magic (format "%S" spec)))) + (auth-source-format-cache-entry spec))) (defun auth-source-forget (spec) "Forget any cached data matching SPEC exactly. This is the same SPEC you passed to `auth-source-search'. Returns t or nil for forgotten or not found." - (password-cache-remove (concat auth-source-magic (format "%S" spec)))) + (password-cache-remove (auth-source-format-cache-entry spec))) ;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym)) @@ -894,11 +900,8 @@ Note that the MAX parameter is used so we can exit the parse early." ;; (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))))))) + :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) + (lambda () (apply 'string (mapcar '1- v))))))) (goto-char (point-min)) ;; Go through the file, line by line. (while (and (not (eobp)) @@ -1233,49 +1236,46 @@ See `auth-source-search' for details on SPEC." (?p ,(aget printable-defaults 'port)))))) ;; Store the data, prompting for the password if needed. - (setq data - (cond - ((and (null data) (eq r 'secret)) - ;; Special case prompt for passwords. - ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg))) - ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) - (let* ((ep (format "Use GPG password tokens in %s?" file)) - (gpg-encrypt - (cond - ((eq auth-source-netrc-use-gpg-tokens 'never) - 'never) - ((listp auth-source-netrc-use-gpg-tokens) - (let ((check (copy-sequence - auth-source-netrc-use-gpg-tokens)) - item ret) - (while check - (setq item (pop check)) - (when (or (eq (car item) t) - (string-match (car item) file)) - (setq ret (cdr item)) - (setq check nil))))) - (t 'never))) - (plain (read-passwd prompt))) - ;; ask if we don't know what to do (in which case - ;; auth-source-netrc-use-gpg-tokens must be a list) - (unless gpg-encrypt - (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never)) - ;; TODO: save the defcustom now? or ask? - (setq auth-source-netrc-use-gpg-tokens - (cons `(,file ,gpg-encrypt) - auth-source-netrc-use-gpg-tokens))) - (if (eq gpg-encrypt 'gpg) - (auth-source-epa-make-gpg-token plain file) - plain))) - ((null data) - (when default - (setq prompt - (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")))) - (read-string prompt nil nil default)) - (t (or data default)))) + (setq data (or data + (if (eq r 'secret) + ;; Special case prompt for passwords. + ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg))) + ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) + (let* ((ep (format "Use GPG password tokens in %s?" file)) + (gpg-encrypt + (cond + ((eq auth-source-netrc-use-gpg-tokens 'never) + 'never) + ((listp auth-source-netrc-use-gpg-tokens) + (let ((check (copy-sequence + auth-source-netrc-use-gpg-tokens)) + item ret) + (while check + (setq item (pop check)) + (when (or (eq (car item) t) + (string-match (car item) file)) + (setq ret (cdr item)) + (setq check nil))))) + (t 'never))) + (plain (or (eval default) (read-passwd prompt)))) + ;; ask if we don't know what to do (in which case + ;; auth-source-netrc-use-gpg-tokens must be a list) + (unless gpg-encrypt + (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never)) + ;; TODO: save the defcustom now? or ask? + (setq auth-source-netrc-use-gpg-tokens + (cons `(,file ,gpg-encrypt) + auth-source-netrc-use-gpg-tokens))) + (if (eq gpg-encrypt 'gpg) + (auth-source-epa-make-gpg-token plain file) + plain)) + (if (stringp default) + (read-string (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")) + nil nil default) + (eval default))))) (when data (setq artificial (plist-put artificial @@ -1303,7 +1303,7 @@ See `auth-source-search' for details on SPEC." (secret "password") (port "port") ; redundant but clearer (t (symbol-name r))) - (if (string-match "[\" ]" data) + (if (string-match "[\"# ]" data) (format "%S" data) data))))) (setq add (concat add (funcall printer))))))) @@ -1679,20 +1679,16 @@ authentication tokens: (?p ,(aget printable-defaults 'port)))))) ;; 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 prompt)) - ((null data) - (when default - (setq prompt - (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")))) - (read-string prompt nil nil default)) - (t (or data default)))) + (setq data (or data + (if (eq r 'secret) + (or (eval default) (read-passwd prompt)) + (if (stringp default) + (read-string (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")) + nil nil default) + (eval default))))) (when data (if (member r base-secret) @@ -1796,6 +1792,26 @@ MODE can be \"login\" or \"password\"." found)) +(defun auth-source-user-and-password (host &optional user) + (let* ((auth-info (car + (if user + (auth-source-search + :host host + :user "yourusername" + :max 1 + :require '(:user :secret) + :create nil) + (auth-source-search + :host host + :max 1 + :require '(:user :secret) + :create nil)))) + (user (plist-get auth-info :user)) + (password (plist-get auth-info :secret))) + (when (functionp password) + (setq password (funcall password))) + (list user password auth-info))) + (provide 'auth-source) ;;; auth-source.el ends here