;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'assoc)
(eval-when-compile (require 'cl))
(eval-and-compile
"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.
+;; 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
(repeat :tag "Names"
(string :tag "Name")))))
-;;; generate all the protocols in a format Customize can use
-;;; TODO: generate on the fly from auth-source-protocols
+;; Generate all the protocols in a format Customize can use.
+;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
(let ((p (car-safe a)))
(const :tag "Default Secrets API Collection" 'default)
(const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
+
+ (const :tag "Default internet Mac OS Keychain"
+ macos-keychain-internet)
+
+ (const :tag "Default generic Mac OS Keychain"
+ macos-keychain-generic)
+
(list :tag "Source definition"
(const :format "" :value :source)
(choice :tag "Authentication backend choice"
(const :tag "Default" 'default)
(const :tag "Login" "Login")
(const
- :tag "Temporary" "session"))))
+ :tag "Temporary" "session")))
+ (list
+ :tag "Mac OS internet Keychain"
+ (const :format ""
+ :value :macos-keychain-internet)
+ (choice :tag "Collection to use"
+ (string :tag "internet Keychain path")
+ (const :tag "default" 'default)))
+ (list
+ :tag "Mac OS generic Keychain"
+ (const :format ""
+ :value :macos-keychain-generic)
+ (choice :tag "Collection to use"
+ (string :tag "generic Keychain path")
+ (const :tag "default" 'default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list
msg))
-;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
(defun auth-source-read-char-choice (prompt choices)
"Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
;; (auth-source-backend-parse "secrets:Login")
+;; (auth-source-backend-parse 'macos-keychain-internet)
+;; (auth-source-backend-parse 'macos-keychain-generic)
+;; (auth-source-backend-parse "macos-keychain-internet:/path/here.keychain")
+;; (auth-source-backend-parse "macos-keychain-generic:/path/here.keychain")
(defun auth-source-backend-parse (entry)
"Creates an auth-source-backend from an ENTRY in `auth-sources'."
;; matching any user, host, and protocol
((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
(auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+
+ ;; take 'macos-keychain-internet and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-internet)
+ (auth-source-backend-parse '(:source (:macos-keychain-internet default))))
+ ;; take 'macos-keychain-generic and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-generic)
+ (auth-source-backend-parse '(:source (:macos-keychain-generic default))))
+ ;; take macos-keychain-internet:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-internet
+ ,(match-string 1 entry)))))
+ ;; take macos-keychain-generic:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-generic
+ ,(match-string 1 entry)))))
+
;; take just a file name and recurse to get it as a netrc file
;; matching any user, host, and protocol
((stringp entry)
:search-function 'auth-source-netrc-search
:create-function 'auth-source-netrc-create)))
+ ;; the MacOS Keychain
+ ((and
+ (not (null (plist-get entry :source))) ; the source must not be nil
+ (listp (plist-get entry :source)) ; and it must be a list
+ (or
+ (plist-get (plist-get entry :source) :macos-keychain-generic)
+ (plist-get (plist-get entry :source) :macos-keychain-internet)))
+
+ (let* ((source-spec (plist-get entry :source))
+ (keychain-generic (plist-get source-spec :macos-keychain-generic))
+ (keychain-type (if keychain-generic
+ 'macos-keychain-generic
+ 'macos-keychain-internet))
+ (source (plist-get source-spec (if keychain-generic
+ :macos-keychain-generic
+ :macos-keychain-internet))))
+
+ (when (symbolp source)
+ (setq source (symbol-name source)))
+
+ (auth-source-backend
+ (format "Mac OS Keychain (%s)" source)
+ :source source
+ :type keychain-type
+ :search-function 'auth-source-macos-keychain-search
+ :create-function 'auth-source-macos-keychain-create)))
+
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
((and
(let* ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
+ :type (slot-value backend :type)
;; note we're overriding whatever the spec
;; has for :require, :create, and :delete
:require require
(setq matches (append matches bmatches))))))
matches))
-;;; (auth-source-search :max 1)
-;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
-;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
-;;; (auth-source-search :host "nonesuch" :type 'secrets)
+;; (auth-source-search :max 1)
+;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
+;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
+;; (auth-source-search :host "nonesuch" :type 'secrets)
(defun* auth-source-delete (&rest spec
&key delete
(auth-source-search (plist-put spec :delete t)))
(defun auth-source-search-collection (collection value)
- "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
+ "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE."
(when (and (atom collection) (not (eq t collection)))
(setq collection (list collection)))
Returns t or nil for forgotten or not found."
(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))
+;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
-;;; (auth-source-remember '(:host "wedd") '(4 5 6))
-;;; (auth-source-remembered-p '(:host "wedd"))
-;;; (auth-source-remember '(:host "xedd") '(1 2 3))
-;;; (auth-source-remembered-p '(:host "xedd"))
-;;; (auth-source-remembered-p '(:host "zedd"))
-;;; (auth-source-recall '(:host "xedd"))
-;;;
projects / gnus / blobdiff