X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fauth-source.el;h=26994d5dca109fea4d892f84f965a509e1afd6e9;hp=39bf32f07e0ba64ef717343cc9fe0ec6e8e97a29;hb=d8b872b8a3b98292e6f3e81f5d40ba263c55ce2b;hpb=3192fb6a275b062a2cb55a72997e704eb4805da7 diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 39bf32f07..26994d5dc 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-2015 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news @@ -42,7 +42,6 @@ (require 'password-cache) (require 'mm-util) (require 'gnus-util) -(require 'assoc) (eval-when-compile (require 'cl)) (eval-and-compile @@ -94,6 +93,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) @@ -101,9 +101,9 @@ let-binding." (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 @@ -158,8 +158,8 @@ let-binding." (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))) @@ -243,16 +243,14 @@ If the value is a function, debug messages are logged by calling (defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.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\" and the famous -\"~/.netrc\" file. - -See the auth.info manual for details. - Each entry is the authentication type with optional properties. +Entries are tried in the order in which they appear. +See Info node `(auth)Help for users' for details. + +If an entry names a file with the \".gpg\" extension and you have +EPA/EPG set up, the file will be encrypted and decrypted +automatically. See Info node `(epa)Encrypting/decrypting gpg files' +for details. It's best to customize this with `M-x customize-variable' because the choices can get pretty complex." @@ -261,9 +259,16 @@ can get pretty complex." :type `(repeat :tag "Authentication Sources" (choice (string :tag "Just a file") - (const :tag "Default Secrets API Collection" 'default) + (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" @@ -273,10 +278,24 @@ can get pretty complex." (const :format "" :value :secrets) (choice :tag "Collection to use" (string :tag "Collection name") - (const :tag "Default" 'default) + (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 @@ -348,7 +367,7 @@ If the value is not a list, symmetric encryption will be used." 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. @@ -387,6 +406,10 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." ;; (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'." @@ -401,6 +424,28 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." ;; 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) @@ -423,6 +468,33 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." :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 @@ -592,9 +664,11 @@ Use `auth-source-delete' in ELisp code instead of calling 'secrets are the only ones supported right now. :max N means to try to return at most N items (defaults to 1). -When 0 the function will return just t or nil to indicate if any -matches were found. More than N items may be returned, depending -on the search and the backend. +More than N items may be returned, depending on the search and +the backend. + +When :max is 0 the function will return just t or nil to indicate +if any matches were found. :host (X Y Z) means to match only hosts X, Y, or Z according to the match rules above. Defaults to t. @@ -695,17 +769,22 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + (if (zerop max) + (not (null found)) + found))) (defun auth-source-search-backends (backends spec max create delete require) - (let (matches) + (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero + matches) (dolist (backend backends) - (when (> max (length matches)) ; when we need more matches... + (when (> max (length matches)) ; if we need more matches... (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 + ;; has for :max, :require, :create, and :delete + :max max :require require :create create :delete delete @@ -720,10 +799,11 @@ must call it to obtain the actual value." (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 0) +;; (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 @@ -736,7 +816,7 @@ Returns the deleted entries." (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))) @@ -759,39 +839,42 @@ 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)) +;; (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")) -;;; (auth-source-recall '(:host t)) -;;; (auth-source-forget+ :host t) +;; (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")) +;; (auth-source-recall '(:host t)) +;; (auth-source-forget+ :host t) (defun* auth-source-forget+ (&rest spec &allow-other-keys) "Forget any cached data matching SPEC. Returns forgotten count. @@ -825,8 +908,8 @@ while \(:host t) would find all host entries." (return 'no))) 'no)))) -;;; (auth-source-pick-first-password :host "z.lifelogs.com") -;;; (auth-source-pick-first-password :port "imap") +;; (auth-source-pick-first-password :host "z.lifelogs.com") +;; (auth-source-pick-first-password :port "imap") (defun auth-source-pick-first-password (&rest spec) "Pick the first secret found from applying SPEC to `auth-source-search'." (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1)))) @@ -845,7 +928,7 @@ while \(:host t) would find all host entries." (when (and c v) (setq prompt (replace-regexp-in-string (format "%%%c" c) (format "%s" v) - prompt))))) + prompt nil t))))) prompt) (defun auth-source-ensure-strings (values) @@ -859,7 +942,22 @@ while \(:host t) would find all host entries." ;;; Backend specific parsing: netrc/authinfo backend -;;; (auth-source-netrc-parse "~/.authinfo.gpg") +(defun auth-source--aput-1 (alist key val) + (let ((seen ()) + (rest alist)) + (while (and (consp rest) (not (equal key (caar rest)))) + (push (pop rest) seen)) + (cons (cons key val) + (if (null rest) alist + (nconc (nreverse seen) + (if (equal key (caar rest)) (cdr rest) rest)))))) +(defmacro auth-source--aput (var key val) + `(setq ,var (auth-source--aput-1 ,var ,key ,val))) + +(defun auth-source--aget (alist key) + (cdr (assoc key alist))) + +;; (auth-source-netrc-parse :file "~/.authinfo.gpg") (defun* auth-source-netrc-parse (&rest spec &key file max host user port delete require @@ -872,15 +970,41 @@ 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 + (let* ((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) + (check (lambda(alist) + (and alist + (auth-source-search-collection + host + (or + (auth-source--aget alist "machine") + (auth-source--aget alist "host") + t)) + (auth-source-search-collection + user + (or + (auth-source--aget alist "login") + (auth-source--aget alist "account") + (auth-source--aget alist "user") + t)) + (auth-source-search-collection + port + (or + (auth-source--aget alist "port") + (auth-source--aget alist "protocol") + t)) + (or + ;; the required list of keys is nil, or + (null require) + ;; every element of require is in n(ormalized) + (let ((n (nth 0 (auth-source-netrc-normalize + (list alist) file)))) + (loop for req in require + always (plist-get n req))))))) + result) (if (and (functionp cached-secrets) (equal cached-mtime @@ -894,90 +1018,16 @@ Note that the MAX parameter is used so we can exit the parse early." ;; 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 (mapcar '1+ (buffer-string)))) - (lambda () (apply 'string (mapcar '1- v))))))) + (auth-source--aput + auth-source-netrc-cache file + (list :mtime (nth 5 (file-attributes file)) + :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)) - (> max 0)) - - (narrow-to-region (point) (point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - ;; Skip lines that begin with a "#". - (if (eq (char-after) ?#) - (goto-char (point-max)) - (unless (eobp) - (setq elem - (if (= (following-char) ?\") - (read (current-buffer)) - (buffer-substring - (point) (progn (skip-chars-forward "^\t ") - (point))))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))))) - - (when (and alist - (> max 0) - (auth-source-search-collection - host - (or - (aget alist "machine") - (aget alist "host") - t)) - (auth-source-search-collection - user - (or - (aget alist "login") - (aget alist "account") - (aget alist "user") - t)) - (auth-source-search-collection - port - (or - (aget alist "port") - (aget alist "protocol") - t)) - (or - ;; the required list of keys is nil, or - (null require) - ;; every element of require is in the normalized list - (let ((normalized (nth 0 (auth-source-netrc-normalize - (list alist) file)))) - (loop for req in require - always (plist-get normalized req))))) - (decf max) - (push (nreverse alist) result) - ;; to delete a line, we just comment it out - (when delete - (goto-char (point-min)) - (insert "#") - (incf modified))) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) + (let ((entries (auth-source-netrc-parse-entries check max)) + alist) + (while (setq alist (pop entries)) + (push (nreverse alist) result))) (when (< 0 modified) (when auth-source-gpg-encrypt-to @@ -1000,6 +1050,77 @@ Note that the MAX parameter is used so we can exit the parse early." (nreverse result)))))) +(defun auth-source-netrc-parse-next-interesting () + "Advance to the next interesting position in the current buffer." + ;; If we're looking at a comment or are at the end of the line, move forward + (while (or (looking-at "#") + (and (eolp) + (not (eobp)))) + (forward-line 1)) + (skip-chars-forward "\t ")) + +(defun auth-source-netrc-parse-one () + "Read one thing from the current buffer." + (auth-source-netrc-parse-next-interesting) + + (when (or (looking-at "'\\([^']*\\)'") + (looking-at "\"\\([^\"]*\\)\"") + (looking-at "\\([^ \t\n]+\\)")) + (forward-char (length (match-string 0))) + (auth-source-netrc-parse-next-interesting) + (match-string-no-properties 1))) + +;; with thanks to org-mode +(defsubst auth-source-current-line (&optional pos) + (save-excursion + (and pos (goto-char pos)) + ;; works also in narrowed buffer, because we start at 1, not point-min + (+ (if (bolp) 1 0) (count-lines 1 (point))))) + +(defun auth-source-netrc-parse-entries(check max) + "Parse up to MAX netrc entries, passed by CHECK, from the current buffer." + (let ((adder (lambda(check alist all) + (when (and + alist + (> max (length all)) + (funcall check alist)) + (push alist all)) + all)) + item item2 all alist default) + (while (setq item (auth-source-netrc-parse-one)) + (setq default (equal item "default")) + ;; We're starting a new machine. Save the old one. + (when (and alist + (or default + (equal item "machine"))) + ;; (auth-source-do-trivia + ;; "auth-source-netrc-parse-entries: got entry %S" alist) + (setq all (funcall adder check alist all) + alist nil)) + ;; In default entries, we don't have a next token. + ;; We store them as ("machine" . t) + (if default + (push (cons "machine" t) alist) + ;; Not a default entry. Grab the next item. + (when (setq item2 (auth-source-netrc-parse-one)) + ;; Did we get a "machine" value? + (if (equal item2 "machine") + (progn + (gnus-error 1 + "%s: Unexpected 'machine' token at line %d" + "auth-source-netrc-parse-entries" + (auth-source-current-line)) + (forward-line 1)) + (push (cons item item2) alist))))) + + ;; Clean up: if there's an entry left over, use it. + (when alist + (setq all (funcall adder check alist all)) + ;; (auth-source-do-trivia + ;; "auth-source-netrc-parse-entries: got2 entry %S" alist) + ) + (nreverse all))) + (defvar auth-source-passphrase-alist nil) (defun auth-source-token-passphrase-callback-function (context key-id file) @@ -1092,8 +1213,8 @@ FILE is the file from which we obtained this token." ret)) alist)) -;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) -;;; (funcall secret) +;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) +;; (funcall secret) (defun* auth-source-netrc-search (&rest spec @@ -1139,8 +1260,8 @@ See `auth-source-search' for details on SPEC." (nth 0 v) v)) -;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) -;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) +;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) +;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) (defun* auth-source-netrc-create (&rest spec &key backend @@ -1172,7 +1293,7 @@ See `auth-source-search' for details on SPEC." ;; just the value otherwise (t (symbol-value br))))) (when br-choice - (aput 'valist br br-choice))))) + (auth-source--aput valist br br-choice))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) @@ -1181,17 +1302,18 @@ See `auth-source-search' for details on SPEC." collect (nth i spec)))) (dolist (k keys) (when (equal (symbol-name k) name) - (aput 'valist er (plist-get spec k)))))) + (auth-source--aput valist er (plist-get spec k)))))) ;; for each required element (dolist (r required) - (let* ((data (aget valist r)) + (let* ((data (auth-source--aget valist r)) ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data (intern (format ":%s" r) obarray)))) ;; this is the default to be offered - (given-default (aget auth-source-creation-defaults r)) + (given-default (auth-source--aget + auth-source-creation-defaults r)) ;; the default supplementals are simple: ;; for the user, try `given-default' and then (user-login-name); ;; otherwise take `given-default' @@ -1203,22 +1325,22 @@ See `auth-source-search' for details on SPEC." (cons 'user (or (auth-source-netrc-element-or-first - (aget valist 'user)) + (auth-source--aget valist 'user)) (plist-get artificial :user) "[any user]")) (cons 'host (or (auth-source-netrc-element-or-first - (aget valist 'host)) + (auth-source--aget valist 'host)) (plist-get artificial :host) "[any host]")) (cons 'port (or (auth-source-netrc-element-or-first - (aget valist 'port)) + (auth-source--aget valist 'port)) (plist-get artificial :port) "[any port]")))) - (prompt (or (aget auth-source-creation-prompts r) + (prompt (or (auth-source--aget auth-source-creation-prompts r) (case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") @@ -1227,54 +1349,51 @@ See `auth-source-search' for details on SPEC." (format "Enter %s (%%u@%%h:%%p): " r))) (prompt (auth-source-format-prompt prompt - `((?u ,(aget printable-defaults 'user)) - (?h ,(aget printable-defaults 'host)) - (?p ,(aget printable-defaults 'port)))))) + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--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 @@ -1302,7 +1421,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))))))) @@ -1393,16 +1512,41 @@ Respects `auth-source-save-behavior'. Uses file) (message "Saved new authentication information to %s" file) nil)))) - (aput 'auth-source-netrc-cache key "ran")))) + (auth-source--aput auth-source-netrc-cache key "ran")))) ;;; Backend specific parsing: Secrets API backend -;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t)) -;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t)) -;;; (let ((auth-sources '(default))) (auth-source-search :max 1)) -;;; (let ((auth-sources '(default))) (auth-source-search)) -;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1)) -;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) +;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t)) +;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t)) +;; (let ((auth-sources '(default))) (auth-source-search :max 1)) +;; (let ((auth-sources '(default))) (auth-source-search)) +;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1)) +;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) + +(defun auth-source-secrets-listify-pattern (pattern) + "Convert a pattern with lists to a list of string patterns. + +auth-source patterns can have values of the form :foo (\"bar\" +\"qux\"), which means to match any secret with :foo equal to +\"bar\" or :foo equal to \"qux\". The secrets backend supports +only string values for patterns, so this routine returns a list +of patterns that is equivalent to the single original pattern +when interpreted such that if a secret matches any pattern in the +list, it matches the original pattern." + (if (null pattern) + '(nil) + (let* ((key (pop pattern)) + (value (pop pattern)) + (tails (auth-source-secrets-listify-pattern pattern)) + (heads (if (stringp value) + (list (list key value)) + (mapcar (lambda (v) (list key v)) value)))) + (loop + for h in heads + nconc + (loop + for tl in tails + collect (append h tl)))))) (defun* auth-source-secrets-search (&rest spec @@ -1450,27 +1594,31 @@ authentication tokens: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it - (search-spec (apply 'append (mapcar + (search-specs (auth-source-secrets-listify-pattern + (apply 'append (mapcar (lambda (k) (if (or (null (plist-get spec k)) (eq t (plist-get spec k))) nil (list k (plist-get spec k)))) - search-keys))) + search-keys)))) ;; needed keys (always including host, login, port, and secret) (returned-keys (mm-delete-duplicates (append '(:host :login :port :secret) search-keys))) - (items (loop for item in (apply 'secrets-search-items coll search-spec) - unless (and (stringp label) - (not (string-match label item))) - collect item)) + (items + (loop for search-spec in search-specs + nconc + (loop for item in (apply 'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item))) ;; TODO: respect max in `secrets-search-items', not after the fact (items (butlast items (- (length items) max))) ;; convert the item name to a full plist @@ -1508,6 +1656,194 @@ authentication tokens: ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) (debug spec)) +;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend + +;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :create t)) +;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :delete t)) +;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1)) +;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search)) + +;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :create t)) +;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :delete t)) +;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1)) +;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search)) + +;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1)) +;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) +;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) + +(defun* auth-source-macos-keychain-search (&rest + spec + &key backend create delete label + type max host user port + &allow-other-keys) + "Search the MacOS Keychain; spec is like `auth-source'. + +All search keys must match exactly. If you need substring +matching, do a wider search and narrow it down yourself. + +You'll get back all the properties of the token as a plist. + +The :type key is either 'macos-keychain-internet or +'macos-keychain-generic. + +For the internet keychain type, the :label key searches the +item's labels (\"-l LABEL\" passed to \"/usr/bin/security\"). +Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\", +and :port maps to \"-P PORT\" or \"-r PROT\" +(note PROT has to be a 4-character string). + +For the generic keychain type, the :label key searches the item's +labels (\"-l LABEL\" passed to \"/usr/bin/security\"). +Similarly, :host maps to \"-c HOST\" (the \"creator\" keychain +field), :user maps to \"-a USER\", and :port maps to \"-s PORT\". + +Here's an example that looks for the first item in the default +generic MacOS Keychain: + + \(let ((auth-sources '(macos-keychain-generic))) + (auth-source-search :max 1) + +Here's another that looks for the first item in the internet +MacOS Keychain collection whose label is 'gnus': + + \(let ((auth-sources '(macos-keychain-internet))) + (auth-source-search :max 1 :label \"gnus\") + +And this one looks for the first item in the internet keychain +entries for git.gnus.org: + + \(let ((auth-sources '(macos-keychain-internet\"))) + (auth-source-search :max 1 :host \"git.gnus.org\")) +" + ;; TODO + (assert (not create) nil + "The MacOS Keychain auth-source backend doesn't support creation yet") + ;; TODO + ;; (macos-keychain-delete-item coll elt) + (assert (not delete) nil + "The MacOS Keychain auth-source backend doesn't support deletion yet") + + (let* ((coll (oref backend source)) + (max (or max 5000)) ; sanity check: default to stop at 5K + (ignored-keys '(:create :delete :max :backend :label)) + (search-keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + ;; build a search spec without the ignored keys + ;; if a search key is nil or t (match anything), we skip it + (search-spec (apply 'append (mapcar + (lambda (k) + (if (or (null (plist-get spec k)) + (eq t (plist-get spec k))) + nil + (list k (plist-get spec k)))) + search-keys))) + ;; needed keys (always including host, login, port, and secret) + (returned-keys (mm-delete-duplicates (append + '(:host :login :port :secret) + search-keys))) + (items (apply 'auth-source-macos-keychain-search-items + coll + type + max + search-spec)) + + ;; ensure each item has each key in `returned-keys' + (items (mapcar (lambda (plist) + (append + (apply 'append + (mapcar (lambda (req) + (if (plist-get plist req) + nil + (list req nil))) + returned-keys)) + plist)) + items))) + items)) + +(defun* auth-source-macos-keychain-search-items (coll type max + &rest spec + &key label type + host user port + &allow-other-keys) + + (let* ((keychain-generic (eq type 'macos-keychain-generic)) + (args `(,(if keychain-generic + "find-generic-password" + "find-internet-password") + "-g")) + (ret (list :type type))) + (when label + (setq args (append args (list "-l" label)))) + (when host + (setq args (append args (list (if keychain-generic "-c" "-s") host)))) + (when user + (setq args (append args (list "-a" user)))) + + (when port + (if keychain-generic + (setq args (append args (list "-s" port))) + (setq args (append args (list + (if (string-match "[0-9]+" port) "-P" "-r") + port))))) + + (unless (equal coll "default") + (setq args (append args (list coll)))) + + (with-temp-buffer + (apply 'call-process "/usr/bin/security" nil t nil args) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((looking-at "^password: \"\\(.+\\)\"$") + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + "secret" + (lexical-let ((v (match-string 1))) + (lambda () v))))) + ;; TODO: check if this is really the label + ;; match 0x00000007 ="AppleID" + ((looking-at "^[ ]+0x00000007 =\"\\(.+\\)\"") + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + "label" + (match-string 1)))) + ;; match "crtr"="aapl" + ;; match "svce"="AppleID" + ((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"") + (setq ret (auth-source-macos-keychain-result-append + ret + keychain-generic + (match-string 1) + (match-string 2))))) + (forward-line))) + ;; return `ret' iff it has the :secret key + (and (plist-get ret :secret) (list ret)))) + +(defun auth-source-macos-keychain-result-append (result generic k v) + (push v result) + (setq k (cond + ((equal k "acct") "user") + ;; for generic keychains, creator is host, service is port + ((and generic (equal k "crtr")) "host") + ((and generic (equal k "svce")) "port") + ;; for internet keychains, protocol is port, server is host + ((and (not generic) (equal k "ptcl")) "port") + ((and (not generic) (equal k "srvr")) "host") + (t k))) + + (push (intern (format ":%s" k)) result)) + +(defun* auth-source-macos-keychain-create (&rest + spec + &key backend type max host user port + &allow-other-keys) + ;; TODO + (debug spec)) + ;;; Backend specific parsing: PLSTORE backend (defun* auth-source-plstore-search (&rest @@ -1518,7 +1854,7 @@ authentication tokens: "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :require)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) @@ -1618,7 +1954,7 @@ authentication tokens: ;; just the value otherwise (t (symbol-value br))))) (when br-choice - (aput 'valist br br-choice))))) + (auth-source--aput valist br br-choice))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) @@ -1627,17 +1963,18 @@ authentication tokens: collect (nth i spec)))) (dolist (k keys) (when (equal (symbol-name k) name) - (aput 'valist er (plist-get spec k)))))) + (auth-source--aput valist er (plist-get spec k)))))) ;; for each required element (dolist (r required) - (let* ((data (aget valist r)) + (let* ((data (auth-source--aget valist r)) ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data (intern (format ":%s" r) obarray)))) ;; this is the default to be offered - (given-default (aget auth-source-creation-defaults r)) + (given-default (auth-source--aget + auth-source-creation-defaults r)) ;; the default supplementals are simple: ;; for the user, try `given-default' and then (user-login-name); ;; otherwise take `given-default' @@ -1649,22 +1986,22 @@ authentication tokens: (cons 'user (or (auth-source-netrc-element-or-first - (aget valist 'user)) + (auth-source--aget valist 'user)) (plist-get artificial :user) "[any user]")) (cons 'host (or (auth-source-netrc-element-or-first - (aget valist 'host)) + (auth-source--aget valist 'host)) (plist-get artificial :host) "[any host]")) (cons 'port (or (auth-source-netrc-element-or-first - (aget valist 'port)) + (auth-source--aget valist 'port)) (plist-get artificial :port) "[any port]")))) - (prompt (or (aget auth-source-creation-prompts r) + (prompt (or (auth-source--aget auth-source-creation-prompts r) (case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") @@ -1673,25 +2010,22 @@ authentication tokens: (format "Enter %s (%%u@%%h:%%p): " r))) (prompt (auth-source-format-prompt prompt - `((?u ,(aget printable-defaults 'user)) - (?h ,(aget printable-defaults 'host)) - (?p ,(aget printable-defaults 'port)))))) + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--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) @@ -1714,7 +2048,7 @@ authentication tokens: ;;; older API -;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") +;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") ;; deprecate the old interface (make-obsolete 'auth-source-user-or-password @@ -1795,6 +2129,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