;;; 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 <tzz@lifelogs.com>
;; Keywords: news
(autoload 'plstore-save "plstore")
(autoload 'plstore-get-file "plstore")
-(autoload 'epa-passphrase-callback-function "epa")
-
-(autoload 'epg-context-operation "epg")
(autoload 'epg-make-context "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-decrypt-string "epg")
(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
"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)
(const :tag "30 Minutes" 1800)
(integer :tag "Seconds")))
+;;; The slots below correspond with the `auth-source-search' spec,
+;;; so a backend with :host set, for instance, would match only
+;;; searches for that host. Normally they are nil.
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
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))
;; (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))
(defvar auth-source-passphrase-alist nil)
-(defun auth-source-passphrase-callback-function (context key-id handback
- &optional sym-detail)
- "Exactly like `epa-passphrase-callback-function' but takes an
-extra SYM-DETAIL parameter which will be printed at the end of
-the symmetric passphrase prompt, and assumes symmetric
-encryption."
- (read-passwd
- (format "Passphrase for symmetric encryption%s%s: "
- ;; Add the file name to the prompt, if any.
- (if (stringp handback)
- (format " for %s" handback)
- "")
- (if (stringp sym-detail)
- sym-detail
- ""))
- (eq (epg-context-operation context) 'encrypt)))
-
(defun auth-source-token-passphrase-callback-function (context key-id file)
- (if (eq key-id 'SYM)
- (let* ((file (file-truename file))
- (entry (assoc file auth-source-passphrase-alist))
- passphrase)
- ;; return the saved passphrase, calling a function if needed
- (or (copy-sequence (if (functionp (cdr entry))
- (funcall (cdr entry))
- (cdr entry)))
- (progn
- (unless entry
- (setq entry (list file))
- (push entry auth-source-passphrase-alist))
- (setq passphrase (auth-source-passphrase-callback-function context
- key-id
- file
- " tokens"))
- (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
- (lambda () p)))
- passphrase)))
- (epa-passphrase-callback-function context key-id file)))
+ (let* ((file (file-truename file))
+ (entry (assoc file auth-source-passphrase-alist))
+ passphrase)
+ ;; return the saved passphrase, calling a function if needed
+ (or (copy-sequence (if (functionp (cdr entry))
+ (funcall (cdr entry))
+ (cdr entry)))
+ (progn
+ (unless entry
+ (setq entry (list file))
+ (push entry auth-source-passphrase-alist))
+ (setq passphrase
+ (read-passwd
+ (format "Passphrase for %s tokens: " file)
+ t))
+ (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+ (lambda () p)))
+ passphrase))))
;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
(defun auth-source-epa-extract-gpg-token (secret file)
(?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
(insert "\n"))
(insert add "\n")
(write-region (point-min) (point-max) file nil 'silent)
+ ;; Make the .authinfo file non-world-readable.
+ (set-file-modes file #o600)
(auth-source-do-debug
"auth-source-netrc-create: wrote 1 new line to %s"
file)
(?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)
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
projects / gnus / blobdiff