LCOV - code coverage report
Current view: top level - lisp - auth-source.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 3 956 0.3 %
Date: 2017-08-30 10:12:24 Functions: 3 81 3.7 %

          Line data    Source code
       1             : ;;; auth-source.el --- authentication sources for Gnus and Emacs -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Ted Zlatanov <tzz@lifelogs.com>
       6             : ;; Keywords: news
       7             : 
       8             : ;; This file is part of GNU Emacs.
       9             : 
      10             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      11             : ;; it under the terms of the GNU General Public License as published by
      12             : ;; the Free Software Foundation, either version 3 of the License, or
      13             : ;; (at your option) any later version.
      14             : 
      15             : ;; GNU Emacs is distributed in the hope that it will be useful,
      16             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      17             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      18             : ;; GNU General Public License for more details.
      19             : 
      20             : ;; You should have received a copy of the GNU General Public License
      21             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : 
      25             : ;; This is the auth-source.el package.  It lets users tell Gnus how to
      26             : ;; authenticate in a single place.  Simplicity is the goal.  Instead
      27             : ;; of providing 5000 options, we'll stick to simple, easy to
      28             : ;; understand options.
      29             : 
      30             : ;; See the auth.info Info documentation for details.
      31             : 
      32             : ;; TODO:
      33             : 
      34             : ;; - never decode the backend file unless it's necessary
      35             : ;; - a more generic way to match backends and search backend contents
      36             : ;; - absorb netrc.el and simplify it
      37             : ;; - protect passwords better
      38             : ;; - allow creating and changing netrc lines (not files) e.g. change a password
      39             : 
      40             : ;;; Code:
      41             : 
      42             : (require 'password-cache)
      43             : 
      44             : (eval-when-compile (require 'cl-lib))
      45             : (require 'eieio)
      46             : 
      47             : (autoload 'secrets-create-item "secrets")
      48             : (autoload 'secrets-delete-item "secrets")
      49             : (autoload 'secrets-get-alias "secrets")
      50             : (autoload 'secrets-get-attributes "secrets")
      51             : (autoload 'secrets-get-secret "secrets")
      52             : (autoload 'secrets-list-collections "secrets")
      53             : (autoload 'secrets-search-items "secrets")
      54             : 
      55             : (autoload 'rfc2104-hash "rfc2104")
      56             : 
      57             : (autoload 'plstore-open "plstore")
      58             : (autoload 'plstore-find "plstore")
      59             : (autoload 'plstore-put "plstore")
      60             : (autoload 'plstore-delete "plstore")
      61             : (autoload 'plstore-save "plstore")
      62             : (autoload 'plstore-get-file "plstore")
      63             : 
      64             : (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
      65             : (autoload 'epg-make-context "epg")
      66             : (autoload 'epg-context-set-passphrase-callback "epg")
      67             : (autoload 'epg-decrypt-string "epg")
      68             : (autoload 'epg-encrypt-string "epg")
      69             : 
      70             : (autoload 'help-mode "help-mode" nil t)
      71             : 
      72             : (defvar secrets-enabled)
      73             : 
      74             : (defgroup auth-source nil
      75             :   "Authentication sources."
      76             :   :version "23.1" ;; No Gnus
      77             :   :group 'gnus)
      78             : 
      79             : ;;;###autoload
      80             : (defcustom auth-source-cache-expiry 7200
      81             :   "How many seconds passwords are cached, or nil to disable
      82             : expiring.  Overrides `password-cache-expiry' through a
      83             : let-binding."
      84             :   :version "24.1"
      85             :   :group 'auth-source
      86             :   :type '(choice (const :tag "Never" nil)
      87             :                  (const :tag "All Day" 86400)
      88             :                  (const :tag "2 Hours" 7200)
      89             :                  (const :tag "30 Minutes" 1800)
      90             :                  (integer :tag "Seconds")))
      91             : 
      92             : ;; The slots below correspond with the `auth-source-search' spec,
      93             : ;; so a backend with :host set, for instance, would match only
      94             : ;; searches for that host.  Normally they are nil.
      95             : (defclass auth-source-backend ()
      96             :   ((type :initarg :type
      97             :          :initform 'netrc
      98             :          :type symbol
      99             :          :custom symbol
     100             :          :documentation "The backend type.")
     101             :    (source :initarg :source
     102             :            :type string
     103             :            :custom string
     104             :            :documentation "The backend source.")
     105             :    (host :initarg :host
     106             :          :initform t
     107             :          :type t
     108             :          :custom string
     109             :          :documentation "The backend host.")
     110             :    (user :initarg :user
     111             :          :initform t
     112             :          :type t
     113             :          :custom string
     114             :          :documentation "The backend user.")
     115             :    (port :initarg :port
     116             :          :initform t
     117             :          :type t
     118             :          :custom string
     119             :          :documentation "The backend protocol.")
     120             :    (data :initarg :data
     121             :          :initform nil
     122             :          :documentation "Internal backend data.")
     123             :    (create-function :initarg :create-function
     124             :                     :initform ignore
     125             :                     :type function
     126             :                     :custom function
     127             :                     :documentation "The create function.")
     128             :    (search-function :initarg :search-function
     129             :                     :initform ignore
     130             :                     :type function
     131             :                     :custom function
     132             :                     :documentation "The search function.")))
     133             : 
     134             : (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
     135             :                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
     136             :                                    (ssh  "ssh" "22")
     137             :                                    (sftp "sftp" "115")
     138             :                                    (smtp "smtp" "25"))
     139             :   "List of authentication protocols and their names"
     140             : 
     141             :   :group 'auth-source
     142             :   :version "23.2" ;; No Gnus
     143             :   :type '(repeat :tag "Authentication Protocols"
     144             :                  (cons :tag "Protocol Entry"
     145             :                        (symbol :tag "Protocol")
     146             :                        (repeat :tag "Names"
     147             :                                (string :tag "Name")))))
     148             : 
     149             : ;; Generate all the protocols in a format Customize can use.
     150             : ;; TODO: generate on the fly from auth-source-protocols
     151             : (defconst auth-source-protocols-customize
     152             :   (mapcar (lambda (a)
     153             :             (let ((p (car-safe a)))
     154             :               (list 'const
     155             :                     :tag (upcase (symbol-name p))
     156             :                     p)))
     157             :           auth-source-protocols))
     158             : 
     159             : (defvar auth-source-creation-defaults nil
     160             :   ;; FIXME: AFAICT this is not set (or let-bound) anywhere!
     161             :   "Defaults for creating token values.  Usually let-bound.")
     162             : 
     163             : (defvar auth-source-creation-prompts nil
     164             :   "Default prompts for token values.  Usually let-bound.")
     165             : 
     166             : (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
     167             : 
     168             : (defcustom auth-source-save-behavior 'ask
     169             :   "If set, auth-source will respect it for save behavior."
     170             :   :group 'auth-source
     171             :   :version "23.2" ;; No Gnus
     172             :   :type `(choice
     173             :           :tag "auth-source new token save behavior"
     174             :           (const :tag "Always save" t)
     175             :           (const :tag "Never save" nil)
     176             :           (const :tag "Ask" ask)))
     177             : 
     178             : ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") never) (t gpg)))
     179             : ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
     180             : 
     181             : (defcustom auth-source-netrc-use-gpg-tokens 'never
     182             :   "Set this to tell auth-source when to create GPG password
     183             : tokens in netrc files.  It's either an alist or `never'.
     184             : Note that if EPA/EPG is not available, this should NOT be used."
     185             :   :group 'auth-source
     186             :   :version "23.2" ;; No Gnus
     187             :   :type `(choice
     188             :           (const :tag "Always use GPG password tokens" (t gpg))
     189             :           (const :tag "Never use GPG password tokens" never)
     190             :           (repeat :tag "Use a lookup list"
     191             :                   (list
     192             :                    (choice :tag "Matcher"
     193             :                            (const :tag "Match anything" t)
     194             :                            (const :tag "The EPA encrypted file extensions"
     195             :                                   ,(if (boundp 'epa-file-auto-mode-alist-entry)
     196             :                                        (car epa-file-auto-mode-alist-entry)
     197             :                                      "\\.gpg\\'"))
     198             :                            (regexp :tag "Regular expression"))
     199             :                    (choice :tag "What to do"
     200             :                            (const :tag "Save GPG-encrypted password tokens" gpg)
     201             :                            (const :tag "Don't encrypt tokens" never))))))
     202             : 
     203             : (defcustom auth-source-do-cache t
     204             :   "Whether auth-source should cache information with `password-cache'."
     205             :   :group 'auth-source
     206             :   :version "23.2" ;; No Gnus
     207             :   :type `boolean)
     208             : 
     209             : (defcustom auth-source-debug nil
     210             :   "Whether auth-source should log debug messages.
     211             : 
     212             : If the value is nil, debug messages are not logged.
     213             : 
     214             : If the value is t, debug messages are logged with `message'.  In
     215             : that case, your authentication data will be in the clear (except
     216             : for passwords).
     217             : 
     218             : If the value is a function, debug messages are logged by calling
     219             :  that function using the same arguments as `message'."
     220             :   :group 'auth-source
     221             :   :version "23.2" ;; No Gnus
     222             :   :type `(choice
     223             :           :tag "auth-source debugging mode"
     224             :           (const :tag "Log using `message' to the *Messages* buffer" t)
     225             :           (const :tag "Log all trivia with `message' to the *Messages* buffer"
     226             :                  trivia)
     227             :           (function :tag "Function that takes arguments like `message'")
     228             :           (const :tag "Don't log anything" nil)))
     229             : 
     230             : (defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
     231             :   "List of authentication sources.
     232             : Each entry is the authentication type with optional properties.
     233             : Entries are tried in the order in which they appear.
     234             : See Info node `(auth)Help for users' for details.
     235             : 
     236             : If an entry names a file with the \".gpg\" extension and you have
     237             : EPA/EPG set up, the file will be encrypted and decrypted
     238             : automatically.  See Info node `(epa)Encrypting/decrypting gpg files'
     239             : for details.
     240             : 
     241             : It's best to customize this with `\\[customize-variable]' because the choices
     242             : can get pretty complex."
     243             :   :group 'auth-source
     244             :   :version "24.1" ;; No Gnus
     245             :   :type `(repeat :tag "Authentication Sources"
     246             :                  (choice
     247             :                   (string :tag "Just a file")
     248             :                   (const :tag "Default Secrets API Collection" default)
     249             :                   (const :tag "Login Secrets API Collection" "secrets:Login")
     250             :                   (const :tag "Temp Secrets API Collection" "secrets:session")
     251             : 
     252             :                   (const :tag "Default internet Mac OS Keychain"
     253             :                          macos-keychain-internet)
     254             : 
     255             :                   (const :tag "Default generic Mac OS Keychain"
     256             :                          macos-keychain-generic)
     257             : 
     258             :                   (list :tag "Source definition"
     259             :                         (const :format "" :value :source)
     260             :                         (choice :tag "Authentication backend choice"
     261             :                                 (string :tag "Authentication Source (file)")
     262             :                                 (list
     263             :                                  :tag "Secret Service API/KWallet/GNOME Keyring"
     264             :                                  (const :format "" :value :secrets)
     265             :                                  (choice :tag "Collection to use"
     266             :                                          (string :tag "Collection name")
     267             :                                          (const :tag "Default" default)
     268             :                                          (const :tag "Login" "Login")
     269             :                                          (const
     270             :                                           :tag "Temporary" "session")))
     271             :                                 (list
     272             :                                  :tag "Mac OS internet Keychain"
     273             :                                  (const :format ""
     274             :                                         :value :macos-keychain-internet)
     275             :                                  (choice :tag "Collection to use"
     276             :                                          (string :tag "internet Keychain path")
     277             :                                          (const :tag "default" default)))
     278             :                                 (list
     279             :                                  :tag "Mac OS generic Keychain"
     280             :                                  (const :format ""
     281             :                                         :value :macos-keychain-generic)
     282             :                                  (choice :tag "Collection to use"
     283             :                                          (string :tag "generic Keychain path")
     284             :                                          (const :tag "default" default))))
     285             :                         (repeat :tag "Extra Parameters" :inline t
     286             :                                 (choice :tag "Extra parameter"
     287             :                                         (list
     288             :                                          :tag "Host"
     289             :                                          (const :format "" :value :host)
     290             :                                          (choice :tag "Host (machine) choice"
     291             :                                                  (const :tag "Any" t)
     292             :                                                  (regexp
     293             :                                                   :tag "Regular expression")))
     294             :                                         (list
     295             :                                          :tag "Protocol"
     296             :                                          (const :format "" :value :port)
     297             :                                          (choice
     298             :                                           :tag "Protocol"
     299             :                                           (const :tag "Any" t)
     300             :                                           ,@auth-source-protocols-customize))
     301             :                                         (list :tag "User" :inline t
     302             :                                               (const :format "" :value :user)
     303             :                                               (choice
     304             :                                                :tag "Personality/Username"
     305             :                                                (const :tag "Any" t)
     306             :                                                (string
     307             :                                                 :tag "Name")))))))))
     308             : 
     309             : (defcustom auth-source-gpg-encrypt-to t
     310             :   "List of recipient keys that `authinfo.gpg' encrypted to.
     311             : If the value is not a list, symmetric encryption will be used."
     312             :   :group 'auth-source
     313             :   :version "24.1" ;; No Gnus
     314             :   :type '(choice (const :tag "Symmetric encryption" t)
     315             :                  (repeat :tag "Recipient public keys"
     316             :                          (string :tag "Recipient public key"))))
     317             : 
     318             : (defun auth-source-do-debug (&rest msg)
     319           0 :   (when auth-source-debug
     320           0 :     (apply #'auth-source-do-warn msg)))
     321             : 
     322             : (defun auth-source-do-trivia (&rest msg)
     323           0 :   (when (or (eq auth-source-debug 'trivia)
     324           0 :             (functionp auth-source-debug))
     325           0 :     (apply #'auth-source-do-warn msg)))
     326             : 
     327             : (defun auth-source-do-warn (&rest msg)
     328           0 :   (apply
     329             :    ;; set logger to either the function in auth-source-debug or 'message
     330             :    ;; note that it will be 'message if auth-source-debug is nil
     331           0 :    (if (functionp auth-source-debug)
     332           0 :        auth-source-debug
     333           0 :      'message)
     334           0 :    msg))
     335             : 
     336             : (defun auth-source-read-char-choice (prompt choices)
     337             :   "Read one of CHOICES by `read-char-choice', or `read-char'.
     338             : `dropdown-list' support is disabled because it doesn't work reliably.
     339             : Only one of CHOICES will be returned.  The PROMPT is augmented
     340             : with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)."
     341           0 :   (when choices
     342           0 :     (let* ((prompt-choices
     343           0 :             (apply #'concat
     344           0 :                    (cl-loop for c in choices collect (format "%c/" c))))
     345           0 :            (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
     346           0 :            (full-prompt (concat prompt prompt-choices))
     347             :            k)
     348             : 
     349           0 :       (while (not (memq k choices))
     350           0 :         (setq k (read-char-choice full-prompt choices)))
     351           0 :       k)))
     352             : 
     353             : (defvar auth-source-backend-parser-functions nil
     354             :   "List of auth-source parser functions.
     355             : Each function takes an entry from `auth-sources' as parameter and
     356             : returns a backend or nil if the entry is not supported.  Add a
     357             : parser function to this list with `add-hook'.  Searching for a
     358             : backend starts with the first element on the list and stops as
     359             : soon as a function returns non-nil.")
     360             : 
     361             : (defun auth-source-backend-parse (entry)
     362             :   "Create an auth-source-backend from an ENTRY in `auth-sources'."
     363             : 
     364           0 :   (let (backend)
     365           0 :     (cl-dolist (f auth-source-backend-parser-functions)
     366           0 :       (when (setq backend (funcall f entry))
     367           0 :         (cl-return)))
     368             : 
     369           0 :     (unless backend
     370             :       ;; none of the parsers worked
     371           0 :       (auth-source-do-warn
     372           0 :        "auth-source-backend-parse: invalid backend spec: %S" entry)
     373           0 :       (setq backend (make-instance 'auth-source-backend
     374             :                                    :source ""
     375           0 :                                    :type 'ignore)))
     376           0 :     (auth-source-backend-parse-parameters entry backend)))
     377             : 
     378             : (defun auth-source-backends-parser-file (entry)
     379             :   ;; take just a file name use it as a netrc/plist file
     380             :   ;; matching any user, host, and protocol
     381           0 :   (when (stringp entry)
     382           0 :     (setq entry `(:source ,entry)))
     383           0 :   (cond
     384             :    ;; a file name with parameters
     385           0 :    ((stringp (plist-get entry :source))
     386           0 :     (if (equal (file-name-extension (plist-get entry :source)) "plist")
     387           0 :         (auth-source-backend
     388           0 :          (plist-get entry :source)
     389           0 :          :source (plist-get entry :source)
     390             :          :type 'plstore
     391           0 :          :search-function #'auth-source-plstore-search
     392           0 :          :create-function #'auth-source-plstore-create
     393           0 :          :data (plstore-open (plist-get entry :source)))
     394           0 :       (auth-source-backend
     395           0 :        (plist-get entry :source)
     396           0 :        :source (plist-get entry :source)
     397             :        :type 'netrc
     398           0 :        :search-function #'auth-source-netrc-search
     399           0 :        :create-function #'auth-source-netrc-create)))))
     400             : 
     401             : ;; Note this function should be last in the parser functions, so we add it first
     402             : (add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file)
     403             : 
     404             : (defun auth-source-backends-parser-macos-keychain (entry)
     405             :   ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS
     406             :   ;; Keychain "XYZ" matching any user, host, and protocol
     407           0 :   (when (and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
     408           0 :                                            entry))
     409           0 :     (setq entry `(:source (:macos-keychain-internet
     410           0 :                            ,(match-string 1 entry)))))
     411           0 :   (when (and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
     412           0 :                                            entry))
     413           0 :     (setq entry `(:source (:macos-keychain-generic
     414           0 :                            ,(match-string 1 entry)))))
     415             :   ;; take 'macos-keychain-internet or generic and use it as a Mac OS
     416             :   ;; Keychain collection matching any user, host, and protocol
     417           0 :   (when (eq entry 'macos-keychain-internet)
     418           0 :     (setq entry '(:source (:macos-keychain-internet default))))
     419           0 :   (when (eq entry 'macos-keychain-generic)
     420           0 :     (setq entry '(:source (:macos-keychain-generic default))))
     421           0 :   (cond
     422             :    ;; the macOS Keychain
     423           0 :    ((and
     424           0 :      (not (null (plist-get entry :source))) ; the source must not be nil
     425           0 :      (listp (plist-get entry :source))      ; and it must be a list
     426           0 :      (or
     427           0 :       (plist-get (plist-get entry :source) :macos-keychain-generic)
     428           0 :       (plist-get (plist-get entry :source) :macos-keychain-internet)))
     429             : 
     430           0 :     (let* ((source-spec (plist-get entry :source))
     431           0 :            (keychain-generic (plist-get source-spec :macos-keychain-generic))
     432           0 :            (keychain-type (if keychain-generic
     433             :                               'macos-keychain-generic
     434           0 :                             'macos-keychain-internet))
     435           0 :            (source (plist-get source-spec (if keychain-generic
     436             :                                               :macos-keychain-generic
     437           0 :                                             :macos-keychain-internet))))
     438             : 
     439           0 :       (when (symbolp source)
     440           0 :         (setq source (symbol-name source)))
     441             : 
     442           0 :       (auth-source-backend
     443           0 :        (format "Mac OS Keychain (%s)" source)
     444           0 :        :source source
     445           0 :        :type keychain-type
     446           0 :        :search-function #'auth-source-macos-keychain-search
     447           0 :        :create-function #'auth-source-macos-keychain-create)))))
     448             : 
     449             : (add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-macos-keychain)
     450             : 
     451             : (defun auth-source-backends-parser-secrets (entry)
     452             :   ;; take secrets:XYZ and use it as Secrets API collection "XYZ"
     453             :   ;; matching any user, host, and protocol
     454           0 :   (when (and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
     455           0 :     (setq entry `(:source (:secrets ,(match-string 1 entry)))))
     456             :   ;; take 'default and use it as a Secrets API default collection
     457             :   ;; matching any user, host, and protocol
     458           0 :   (when (eq entry 'default)
     459           0 :     (setq entry '(:source (:secrets default))))
     460           0 :   (cond
     461             :    ;; the Secrets API.  We require the package, in order to have a
     462             :    ;; defined value for `secrets-enabled'.
     463           0 :    ((and
     464           0 :      (not (null (plist-get entry :source))) ; the source must not be nil
     465           0 :      (listp (plist-get entry :source))      ; and it must be a list
     466           0 :      (not (null (plist-get
     467           0 :                  (plist-get entry :source)
     468           0 :                  :secrets))) ; the source must have :secrets
     469           0 :      (require 'secrets nil t)               ; and we must load the Secrets API
     470           0 :      secrets-enabled)                       ; and that API must be enabled
     471             : 
     472             :     ;; the source is either the :secrets key in ENTRY or
     473             :     ;; if that's missing or nil, it's "session"
     474           0 :     (let ((source (plist-get (plist-get entry :source) :secrets)))
     475             : 
     476             :       ;; if the source is a symbol, we look for the alias named so,
     477             :       ;; and if that alias is missing, we use "Login"
     478           0 :       (when (symbolp source)
     479           0 :         (setq source (or (secrets-get-alias (symbol-name source))
     480           0 :                          "Login")))
     481             : 
     482           0 :       (if (featurep 'secrets)
     483           0 :           (auth-source-backend
     484           0 :            (format "Secrets API (%s)" source)
     485           0 :            :source source
     486             :            :type 'secrets
     487           0 :            :search-function #'auth-source-secrets-search
     488           0 :            :create-function #'auth-source-secrets-create)
     489           0 :         (auth-source-do-warn
     490           0 :          "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
     491           0 :         (auth-source-backend
     492           0 :          (format "Ignored Secrets API (%s)" source)
     493             :          :source ""
     494           0 :          :type 'ignore))))))
     495             : 
     496             : (add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-secrets)
     497             : 
     498             : (defun auth-source-backend-parse-parameters (entry backend)
     499             :   "Fills in the extra auth-source-backend parameters of ENTRY.
     500             : Using the plist ENTRY, get the :host, :port, and :user search
     501             : parameters."
     502           0 :   (let ((entry (if (stringp entry)
     503             :                    nil
     504           0 :                  entry))
     505             :         val)
     506           0 :     (when (setq val (plist-get entry :host))
     507           0 :       (oset backend host val))
     508           0 :     (when (setq val (plist-get entry :user))
     509           0 :       (oset backend user val))
     510           0 :     (when (setq val (plist-get entry :port))
     511           0 :       (oset backend port val)))
     512           0 :   backend)
     513             : 
     514             : ;; (mapcar 'auth-source-backend-parse auth-sources)
     515             : 
     516             : (cl-defun auth-source-search (&rest spec
     517             :                               &key max require create delete
     518             :                               &allow-other-keys)
     519             :   "Search or modify authentication backends according to SPEC.
     520             : 
     521             : This function parses `auth-sources' for matches of the SPEC
     522             : plist.  It can optionally create or update an authentication
     523             : token if requested.  A token is just a standard Emacs property
     524             : list with a :secret property that can be a function; all the
     525             : other properties will always hold scalar values.
     526             : 
     527             : Typically the :secret property, if present, contains a password.
     528             : 
     529             : Common search keys are :max, :host, :port, and :user.  In
     530             : addition, :create specifies if and how tokens will be created.
     531             : Finally, :type can specify which backend types you want to check.
     532             : 
     533             : A string value is always matched literally.  A symbol is matched
     534             : as its string value, literally.  All the SPEC values can be
     535             : single values (symbol or string) or lists thereof (in which case
     536             : any of the search terms matches).
     537             : 
     538             : :create t means to create a token if possible.
     539             : 
     540             : A new token will be created if no matching tokens were found.
     541             : The new token will have only the keys the backend requires.  For
     542             : the netrc backend, for instance, that's the user, host, and
     543             : port keys.
     544             : 
     545             : Here's an example:
     546             : 
     547             : \(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
     548             :                                         (A    . \"default A\"))))
     549             :   (auth-source-search :host \"mine\" :type \\='netrc :max 1
     550             :                       :P \"pppp\" :Q \"qqqq\"
     551             :                       :create t))
     552             : 
     553             : which says:
     554             : 
     555             : \"Search for any entry matching host `mine' in backends of type
     556             :  `netrc', maximum one result.
     557             : 
     558             :  Create a new entry if you found none.  The netrc backend will
     559             :  automatically require host, user, and port.  The host will be
     560             :  `mine'.  We prompt for the user with default `defaultUser' and
     561             :  for the port without a default.  We will not prompt for A, Q,
     562             :  or P.  The resulting token will only have keys user, host, and
     563             :  port.\"
     564             : 
     565             : :create \\='(A B C) also means to create a token if possible.
     566             : 
     567             : The behavior is like :create t but if the list contains any
     568             : parameter, that parameter will be required in the resulting
     569             : token.  The value for that parameter will be obtained from the
     570             : search parameters or from user input.  If any queries are needed,
     571             : the alist `auth-source-creation-defaults' will be checked for the
     572             : default value.  If the user, host, or port are missing, the alist
     573             : `auth-source-creation-prompts' will be used to look up the
     574             : prompts IN THAT ORDER (so the `user' prompt will be queried first,
     575             : then `host', then `port', and finally `secret').  Each prompt string
     576             : can use %u, %h, and %p to show the user, host, and port.
     577             : 
     578             : Here's an example:
     579             : 
     580             : \(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
     581             :                                         (A    . \"default A\")))
     582             :        (auth-source-creation-prompts
     583             :         \\='((password . \"Enter IMAP password for %h:%p: \"))))
     584             :   (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
     585             :                       :P \"pppp\" :Q \"qqqq\"
     586             :                       :create \\='(A B Q)))
     587             : 
     588             : which says:
     589             : 
     590             : \"Search for any entry matching host `nonesuch'
     591             :  or `twosuch' in backends of type `netrc', maximum one result.
     592             : 
     593             :  Create a new entry if you found none.  The netrc backend will
     594             :  automatically require host, user, and port.  The host will be
     595             :  `nonesuch' and Q will be `qqqq'.  We prompt for the password
     596             :  with the shown prompt.  We will not prompt for Q.  The resulting
     597             :  token will have keys user, host, port, A, B, and Q.  It will not
     598             :  have P with any value, even though P is used in the search to
     599             :  find only entries that have P set to `pppp'.\"
     600             : 
     601             : When multiple values are specified in the search parameter, the
     602             : user is prompted for which one.  So :host (X Y Z) would ask the
     603             : user to choose between X, Y, and Z.
     604             : 
     605             : This creation can fail if the search was not specific enough to
     606             : create a new token (it's up to the backend to decide that).  You
     607             : should `catch' the backend-specific error as usual.  Some
     608             : backends (netrc, at least) will prompt the user rather than throw
     609             : an error.
     610             : 
     611             : :require (A B C) means that only results that contain those
     612             : tokens will be returned.  Thus for instance requiring :secret
     613             : will ensure that any results will actually have a :secret
     614             : property.
     615             : 
     616             : :delete t means to delete any found entries.  nil by default.
     617             : Use `auth-source-delete' in ELisp code instead of calling
     618             : `auth-source-search' directly with this parameter.
     619             : 
     620             : :type (X Y Z) will check only those backend types.  `netrc' and
     621             : `secrets' are the only ones supported right now.
     622             : 
     623             : :max N means to try to return at most N items (defaults to 1).
     624             : More than N items may be returned, depending on the search and
     625             : the backend.
     626             : 
     627             : When :max is 0 the function will return just t or nil to indicate
     628             : if any matches were found.
     629             : 
     630             : :host (X Y Z) means to match only hosts X, Y, or Z according to
     631             : the match rules above.  Defaults to t.
     632             : 
     633             : :user (X Y Z) means to match only users X, Y, or Z according to
     634             : the match rules above.  Defaults to t.
     635             : 
     636             : :port (P Q R) means to match only protocols P, Q, or R.
     637             : Defaults to t.
     638             : 
     639             : :K (V1 V2 V3) for any other key K will match values V1, V2, or
     640             : V3 (note the match rules above).
     641             : 
     642             : The return value is a list with at most :max tokens.  Each token
     643             : is a plist with keys :backend :host :port :user, plus any other
     644             : keys provided by the backend (notably :secret).  But note the
     645             : exception for :max 0, which see above.
     646             : 
     647             : The token can hold a :save-function key.  If you call that, the
     648             : user will be prompted to save the data to the backend.  You can't
     649             : request that this should happen right after creation, because
     650             : `auth-source-search' has no way of knowing if the token is
     651             : actually useful.  So the caller must arrange to call this function.
     652             : 
     653             : The token's :secret key can hold a function.  In that case you
     654             : must call it to obtain the actual value."
     655           0 :   (let* ((backends (mapcar #'auth-source-backend-parse auth-sources))
     656           0 :          (max (or max 1))
     657             :          (ignored-keys '(:require :create :delete :max))
     658           0 :          (keys (cl-loop for i below (length spec) by 2
     659           0 :                         unless (memq (nth i spec) ignored-keys)
     660           0 :                         collect (nth i spec)))
     661           0 :          (cached (auth-source-remembered-p spec))
     662             :          ;; note that we may have cached results but found is still nil
     663             :          ;; (there were no results from the search)
     664           0 :          (found (auth-source-recall spec))
     665             :          filtered-backends)
     666             : 
     667           0 :     (if (and cached auth-source-do-cache)
     668           0 :         (auth-source-do-debug
     669             :          "auth-source-search: found %d CACHED results matching %S"
     670           0 :          (length found) spec)
     671             : 
     672           0 :       (cl-assert
     673           0 :        (or (eq t create) (listp create)) t
     674           0 :        "Invalid auth-source :create parameter (must be t or a list): %s %s")
     675             : 
     676           0 :       (cl-assert
     677           0 :        (listp require) t
     678           0 :        "Invalid auth-source :require parameter (must be a list): %s")
     679             : 
     680           0 :       (setq filtered-backends (copy-sequence backends))
     681           0 :       (dolist (backend backends)
     682           0 :         (cl-dolist (key keys)
     683             :           ;; ignore invalid slots
     684           0 :           (condition-case nil
     685           0 :               (unless (auth-source-search-collection
     686           0 :                        (plist-get spec key)
     687           0 :                        (slot-value backend key))
     688           0 :                 (setq filtered-backends (delq backend filtered-backends))
     689           0 :                 (cl-return))
     690           0 :             (invalid-slot-name nil))))
     691             : 
     692           0 :       (auth-source-do-trivia
     693             :        "auth-source-search: found %d backends matching %S"
     694           0 :        (length filtered-backends) spec)
     695             : 
     696             :       ;; (debug spec "filtered" filtered-backends)
     697             :       ;; First go through all the backends without :create, so we can
     698             :       ;; query them all.
     699           0 :       (setq found (auth-source-search-backends filtered-backends
     700           0 :                                                spec
     701             :                                                ;; to exit early
     702           0 :                                                max
     703             :                                                ;; create is always nil here
     704           0 :                                                nil delete
     705           0 :                                                require))
     706             : 
     707           0 :       (auth-source-do-debug
     708             :        "auth-source-search: found %d results (max %d) matching %S"
     709           0 :        (length found) max spec)
     710             : 
     711             :       ;; If we didn't find anything, then we allow the backend(s) to
     712             :       ;; create the entries.
     713           0 :       (when (and create
     714           0 :                  (not found))
     715           0 :         (setq found (auth-source-search-backends filtered-backends
     716           0 :                                                  spec
     717             :                                                  ;; to exit early
     718           0 :                                                  max
     719           0 :                                                  create delete
     720           0 :                                                  require))
     721           0 :         (auth-source-do-debug
     722             :          "auth-source-search: CREATED %d results (max %d) matching %S"
     723           0 :          (length found) max spec))
     724             : 
     725             :       ;; note we remember the lack of result too, if it's applicable
     726           0 :       (when auth-source-do-cache
     727           0 :         (auth-source-remember spec found)))
     728             : 
     729           0 :     (if (zerop max)
     730           0 :         (not (null found))
     731           0 :       found)))
     732             : 
     733             : (defun auth-source-search-backends (backends spec max create delete require)
     734           0 :   (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero
     735             :         matches)
     736           0 :     (dolist (backend backends)
     737           0 :       (when (> max (length matches)) ; if we need more matches...
     738           0 :         (let* ((bmatches (apply
     739           0 :                           (slot-value backend 'search-function)
     740           0 :                           :backend backend
     741           0 :                           :type (slot-value backend 'type)
     742             :                           ;; note we're overriding whatever the spec
     743             :                           ;; has for :max, :require, :create, and :delete
     744           0 :                           :max max
     745           0 :                           :require require
     746           0 :                           :create create
     747           0 :                           :delete delete
     748           0 :                           spec)))
     749           0 :           (when bmatches
     750           0 :             (auth-source-do-trivia
     751             :              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
     752           0 :              (length bmatches) max
     753           0 :              (slot-value backend 'type)
     754           0 :              (slot-value backend 'source)
     755           0 :              spec)
     756           0 :             (setq matches (append matches bmatches))))))
     757           0 :     matches))
     758             : 
     759             : (defun auth-source-delete (&rest spec)
     760             :   "Delete entries from the authentication backends according to SPEC.
     761             : Calls `auth-source-search' with the :delete property in SPEC set to t.
     762             : The backend may not actually delete the entries.
     763             : 
     764             : Returns the deleted entries."
     765           0 :   (auth-source-search (plist-put spec :delete t)))
     766             : 
     767             : (defun auth-source-search-collection (collection value)
     768             :   "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE."
     769           0 :   (when (and (atom collection) (not (eq t collection)))
     770           0 :     (setq collection (list collection)))
     771             : 
     772             :   ;; (debug :collection collection :value value)
     773           0 :   (or (eq collection t)
     774           0 :       (eq value t)
     775           0 :       (equal collection value)
     776           0 :       (member value collection)))
     777             : 
     778             : (defvar auth-source-netrc-cache nil)
     779             : 
     780             : (defun auth-source-forget-all-cached ()
     781             :   "Forget all cached auth-source data."
     782             :   (interactive)
     783           0 :   (maphash (lambda (key _password)
     784           0 :              (when (eq 'auth-source (car-safe key))
     785             :                ;; remove that key
     786           0 :                (password-cache-remove key)))
     787           0 :            password-data)
     788           0 :   (setq auth-source-netrc-cache nil))
     789             : 
     790             : (defun auth-source-format-cache-entry (spec)
     791             :   "Format SPEC entry to put it in the password cache."
     792           2 :   `(auth-source . ,spec))
     793             : 
     794             : (defun auth-source-remember (spec found)
     795             :   "Remember FOUND search results for SPEC."
     796           0 :   (let ((password-cache-expiry auth-source-cache-expiry))
     797           0 :     (password-cache-add
     798           0 :      (auth-source-format-cache-entry spec) found)))
     799             : 
     800             : (defun auth-source-recall (spec)
     801             :   "Recall FOUND search results for SPEC."
     802           0 :   (password-read-from-cache (auth-source-format-cache-entry spec)))
     803             : 
     804             : (defun auth-source-remembered-p (spec)
     805             :   "Check if SPEC is remembered."
     806           0 :   (password-in-cache-p
     807           0 :    (auth-source-format-cache-entry spec)))
     808             : 
     809             : (defun auth-source-forget (spec)
     810             :   "Forget any cached data matching SPEC exactly.
     811             : 
     812             : This is the same SPEC you passed to `auth-source-search'.
     813             : Returns t or nil for forgotten or not found."
     814           2 :   (password-cache-remove (auth-source-format-cache-entry spec)))
     815             : 
     816             : (defun auth-source-forget+ (&rest spec)
     817             :   "Forget any cached data matching SPEC.  Returns forgotten count.
     818             : 
     819             : This is not a full `auth-source-search' spec but works similarly.
     820             : For instance, \(:host \"myhost\" \"yourhost\") would find all the
     821             : cached data that was found with a search for those two hosts,
     822             : while \(:host t) would find all host entries."
     823           0 :   (let ((count 0))
     824           0 :     (maphash
     825             :      (lambda (key _password)
     826           0 :        (when (and (eq 'auth-source (car-safe key))
     827             :                   ;; and the spec matches what was stored in the cache
     828           0 :                   (auth-source-specmatchp spec (cdr key)))
     829             :          ;; remove that key
     830           0 :          (password-cache-remove key)
     831           0 :          (cl-incf count)))
     832           0 :      password-data)
     833           0 :     count))
     834             : 
     835             : (defun auth-source-specmatchp (spec stored)
     836           0 :   (let ((keys (cl-loop for i below (length spec) by 2
     837           0 :                        collect (nth i spec))))
     838           0 :     (not (eq
     839           0 :           (cl-dolist (key keys)
     840           0 :             (unless (auth-source-search-collection (plist-get stored key)
     841           0 :                                                    (plist-get spec key))
     842           0 :               (cl-return 'no)))
     843           0 :           'no))))
     844             : 
     845             : (defun auth-source-pick-first-password (&rest spec)
     846             :   "Pick the first secret found from applying SPEC to `auth-source-search'."
     847           0 :   (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
     848           0 :          (secret (plist-get result :secret)))
     849             : 
     850           0 :     (if (functionp secret)
     851           0 :         (funcall secret)
     852           0 :       secret)))
     853             : 
     854             : (defun auth-source-format-prompt (prompt alist)
     855             :   "Format PROMPT using %x (for any character x) specifiers in ALIST."
     856           0 :   (dolist (cell alist)
     857           0 :     (let ((c (nth 0 cell))
     858           0 :           (v (nth 1 cell)))
     859           0 :       (when (and c v)
     860           0 :         (setq prompt (replace-regexp-in-string (format "%%%c" c)
     861           0 :                                                (format "%s" v)
     862           0 :                                                prompt nil t)))))
     863           0 :   prompt)
     864             : 
     865             : (defun auth-source-ensure-strings (values)
     866           0 :   (if (eq values t)
     867           0 :       values
     868           0 :     (unless (listp values)
     869           0 :       (setq values (list values)))
     870           0 :     (mapcar (lambda (value)
     871           0 :               (if (numberp value)
     872           0 :                   (format "%s" value)
     873           0 :                 value))
     874           0 :             values)))
     875             : 
     876             : ;;; Backend specific parsing: netrc/authinfo backend
     877             : 
     878             : (defun auth-source--aput-1 (alist key val)
     879           0 :   (let ((seen ())
     880           0 :         (rest alist))
     881           0 :     (while (and (consp rest) (not (equal key (caar rest))))
     882           0 :       (push (pop rest) seen))
     883           0 :     (cons (cons key val)
     884           0 :           (if (null rest) alist
     885           0 :             (nconc (nreverse seen)
     886           0 :                    (if (equal key (caar rest)) (cdr rest) rest))))))
     887             : (defmacro auth-source--aput (var key val)
     888           6 :   `(setq ,var (auth-source--aput-1 ,var ,key ,val)))
     889             : 
     890             : (defun auth-source--aget (alist key)
     891           0 :   (cdr (assoc key alist)))
     892             : 
     893             : ;; (auth-source-netrc-parse :file "~/.authinfo.gpg")
     894             : (cl-defun auth-source-netrc-parse (&key file max host user port require
     895             :                                    &allow-other-keys)
     896             :   "Parse FILE and return a list of all entries in the file.
     897             : Note that the MAX parameter is used so we can exit the parse early."
     898           0 :   (if (listp file)
     899             :       ;; We got already parsed contents; just return it.
     900           0 :       file
     901           0 :     (when (file-exists-p file)
     902           0 :       (setq port (auth-source-ensure-strings port))
     903           0 :       (with-temp-buffer
     904           0 :         (let* ((max (or max 5000))       ; sanity check: default to stop at 5K
     905             :                (modified 0)
     906           0 :                (cached (cdr-safe (assoc file auth-source-netrc-cache)))
     907           0 :                (cached-mtime (plist-get cached :mtime))
     908           0 :                (cached-secrets (plist-get cached :secret))
     909             :                (check (lambda(alist)
     910           0 :                         (and alist
     911           0 :                              (auth-source-search-collection
     912           0 :                               host
     913           0 :                               (or
     914           0 :                                (auth-source--aget alist "machine")
     915           0 :                                (auth-source--aget alist "host")
     916           0 :                                t))
     917           0 :                              (auth-source-search-collection
     918           0 :                               user
     919           0 :                               (or
     920           0 :                                (auth-source--aget alist "login")
     921           0 :                                (auth-source--aget alist "account")
     922           0 :                                (auth-source--aget alist "user")
     923           0 :                                t))
     924           0 :                              (auth-source-search-collection
     925           0 :                               port
     926           0 :                               (or
     927           0 :                                (auth-source--aget alist "port")
     928           0 :                                (auth-source--aget alist "protocol")
     929           0 :                                t))
     930           0 :                              (or
     931             :                               ;; the required list of keys is nil, or
     932           0 :                               (null require)
     933             :                               ;; every element of require is in n (normalized)
     934           0 :                               (let ((n (nth 0 (auth-source-netrc-normalize
     935           0 :                                                (list alist) file))))
     936           0 :                                 (cl-loop for req in require
     937           0 :                                          always (plist-get n req)))))))
     938             :                result)
     939             : 
     940           0 :           (if (and (functionp cached-secrets)
     941           0 :                    (equal cached-mtime
     942           0 :                           (nth 5 (file-attributes file))))
     943           0 :               (progn
     944           0 :                 (auth-source-do-trivia
     945             :                  "auth-source-netrc-parse: using CACHED file data for %s"
     946           0 :                  file)
     947           0 :                 (insert (funcall cached-secrets)))
     948           0 :             (insert-file-contents file)
     949             :             ;; cache all netrc files (used to be just .gpg files)
     950             :             ;; Store the contents of the file heavily encrypted in memory.
     951             :             ;; (note for the irony-impaired: they are just obfuscated)
     952           0 :             (auth-source--aput
     953             :              auth-source-netrc-cache file
     954             :              (list :mtime (nth 5 (file-attributes file))
     955             :                    :secret (let ((v (mapcar #'1+ (buffer-string))))
     956           0 :                              (lambda () (apply #'string (mapcar #'1- v)))))))
     957           0 :           (goto-char (point-min))
     958           0 :           (let ((entries (auth-source-netrc-parse-entries check max))
     959             :                 alist)
     960           0 :             (while (setq alist (pop entries))
     961           0 :                 (push (nreverse alist) result)))
     962             : 
     963           0 :           (when (< 0 modified)
     964           0 :             (when auth-source-gpg-encrypt-to
     965             :               ;; (see bug#7487) making `epa-file-encrypt-to' local to
     966             :               ;; this buffer lets epa-file skip the key selection query
     967             :               ;; (see the `local-variable-p' check in
     968             :               ;; `epa-file-write-region').
     969           0 :               (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
     970           0 :                 (make-local-variable 'epa-file-encrypt-to))
     971           0 :               (if (listp auth-source-gpg-encrypt-to)
     972           0 :                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
     973             : 
     974             :             ;; ask AFTER we've successfully opened the file
     975           0 :             (when (y-or-n-p (format "Save file %s? (%d deletions)"
     976           0 :                                     file modified))
     977           0 :               (write-region (point-min) (point-max) file nil 'silent)
     978           0 :               (auth-source-do-debug
     979             :                "auth-source-netrc-parse: modified %d lines in %s"
     980           0 :                modified file)))
     981             : 
     982           0 :           (nreverse result))))))
     983             : 
     984             : (defun auth-source-netrc-parse-next-interesting ()
     985             :   "Advance to the next interesting position in the current buffer."
     986             :   ;; If we're looking at a comment or are at the end of the line, move forward
     987           0 :   (while (or (looking-at "#")
     988           0 :              (and (eolp)
     989           0 :                   (not (eobp))))
     990           0 :     (forward-line 1))
     991           0 :   (skip-chars-forward "\t "))
     992             : 
     993             : (defun auth-source-netrc-parse-one ()
     994             :   "Read one thing from the current buffer."
     995           0 :   (auth-source-netrc-parse-next-interesting)
     996             : 
     997           0 :   (when (or (looking-at "'\\([^']*\\)'")
     998           0 :             (looking-at "\"\\([^\"]*\\)\"")
     999           0 :             (looking-at "\\([^ \t\n]+\\)"))
    1000           0 :     (forward-char (length (match-string 0)))
    1001           0 :     (auth-source-netrc-parse-next-interesting)
    1002           0 :     (match-string-no-properties 1)))
    1003             : 
    1004             : ;; with thanks to org-mode
    1005             : (defsubst auth-source-current-line (&optional pos)
    1006           0 :   (save-excursion
    1007           0 :     (and pos (goto-char pos))
    1008             :     ;; works also in narrowed buffer, because we start at 1, not point-min
    1009           0 :     (+ (if (bolp) 1 0) (count-lines 1 (point)))))
    1010             : 
    1011             : (defun auth-source-netrc-parse-entries(check max)
    1012             :   "Parse up to MAX netrc entries, passed by CHECK, from the current buffer."
    1013           0 :   (let ((adder (lambda(check alist all)
    1014           0 :                  (when (and
    1015           0 :                         alist
    1016           0 :                         (> max (length all))
    1017           0 :                         (funcall check alist))
    1018           0 :                    (push alist all))
    1019           0 :                  all))
    1020             :         item item2 all alist default)
    1021           0 :     (while (setq item (auth-source-netrc-parse-one))
    1022           0 :       (setq default (equal item "default"))
    1023             :       ;; We're starting a new machine.  Save the old one.
    1024           0 :       (when (and alist
    1025           0 :                  (or default
    1026           0 :                      (equal item "machine")))
    1027             :         ;; (auth-source-do-trivia
    1028             :         ;;  "auth-source-netrc-parse-entries: got entry %S" alist)
    1029           0 :         (setq all (funcall adder check alist all)
    1030           0 :               alist nil))
    1031             :       ;; In default entries, we don't have a next token.
    1032             :       ;; We store them as ("machine" . t)
    1033           0 :       (if default
    1034           0 :           (push (cons "machine" t) alist)
    1035             :         ;; Not a default entry.  Grab the next item.
    1036           0 :         (when (setq item2 (auth-source-netrc-parse-one))
    1037             :           ;; Did we get a "machine" value?
    1038           0 :           (if (equal item2 "machine")
    1039           0 :               (error
    1040             :                "%s: Unexpected `machine' token at line %d"
    1041             :                "auth-source-netrc-parse-entries"
    1042           0 :                (auth-source-current-line))
    1043           0 :             (push (cons item item2) alist)))))
    1044             : 
    1045             :     ;; Clean up: if there's an entry left over, use it.
    1046           0 :     (when alist
    1047           0 :       (setq all (funcall adder check alist all))
    1048             :       ;; (auth-source-do-trivia
    1049             :       ;;  "auth-source-netrc-parse-entries: got2 entry %S" alist)
    1050           0 :       )
    1051           0 :     (nreverse all)))
    1052             : 
    1053             : (defvar auth-source-passphrase-alist nil)
    1054             : 
    1055             : (defun auth-source-token-passphrase-callback-function (_context _key-id file)
    1056           0 :   (let* ((file (file-truename file))
    1057           0 :          (entry (assoc file auth-source-passphrase-alist))
    1058             :          passphrase)
    1059             :     ;; return the saved passphrase, calling a function if needed
    1060           0 :     (or (copy-sequence (if (functionp (cdr entry))
    1061           0 :                            (funcall (cdr entry))
    1062           0 :                          (cdr entry)))
    1063           0 :         (progn
    1064           0 :           (unless entry
    1065           0 :             (setq entry (list file))
    1066           0 :             (push entry auth-source-passphrase-alist))
    1067           0 :           (setq passphrase
    1068           0 :                 (read-passwd
    1069           0 :                  (format "Passphrase for %s tokens: " file)
    1070           0 :                  t))
    1071           0 :           (setcdr entry (let ((p (copy-sequence passphrase)))
    1072           0 :                           (lambda () p)))
    1073           0 :           passphrase))))
    1074             : 
    1075             : (defun auth-source-epa-extract-gpg-token (secret file)
    1076             :   "Pass either the decoded SECRET or the gpg:BASE64DATA version.
    1077             : FILE is the file from which we obtained this token."
    1078           0 :   (when (string-match "^gpg:\\(.+\\)" secret)
    1079           0 :     (setq secret (base64-decode-string (match-string 1 secret))))
    1080           0 :   (let ((context (epg-make-context 'OpenPGP)))
    1081           0 :     (epg-context-set-passphrase-callback
    1082           0 :      context
    1083           0 :      (cons #'auth-source-token-passphrase-callback-function
    1084           0 :            file))
    1085           0 :     (epg-decrypt-string context secret)))
    1086             : 
    1087             : (defvar pp-escape-newlines)
    1088             : 
    1089             : (defun auth-source-epa-make-gpg-token (secret file)
    1090           0 :   (let ((context (epg-make-context 'OpenPGP))
    1091             :         (pp-escape-newlines nil)
    1092             :         cipher)
    1093           0 :     (setf (epg-context-armor context) t)
    1094           0 :     (epg-context-set-passphrase-callback
    1095           0 :      context
    1096           0 :      (cons #'auth-source-token-passphrase-callback-function
    1097           0 :            file))
    1098           0 :     (setq cipher (epg-encrypt-string context secret nil))
    1099           0 :     (with-temp-buffer
    1100           0 :       (insert cipher)
    1101           0 :       (base64-encode-region (point-min) (point-max) t)
    1102           0 :       (concat "gpg:" (buffer-substring-no-properties
    1103           0 :                       (point-min)
    1104           0 :                       (point-max))))))
    1105             : 
    1106             : (defun auth-source--symbol-keyword (symbol)
    1107           0 :   (intern (format ":%s" symbol)))
    1108             : 
    1109             : (defun auth-source-netrc-normalize (alist filename)
    1110           0 :   (mapcar (lambda (entry)
    1111           0 :             (let (ret item)
    1112           0 :               (while (setq item (pop entry))
    1113           0 :                 (let ((k (car item))
    1114           0 :                       (v (cdr item)))
    1115             : 
    1116             :                   ;; apply key aliases
    1117           0 :                   (setq k (cond ((member k '("machine")) "host")
    1118           0 :                                 ((member k '("login" "account")) "user")
    1119           0 :                                 ((member k '("protocol")) "port")
    1120           0 :                                 ((member k '("password")) "secret")
    1121           0 :                                 (t k)))
    1122             : 
    1123             :                   ;; send back the secret in a function (lexical binding)
    1124           0 :                   (when (equal k "secret")
    1125           0 :                     (setq v (let ((lexv v)
    1126             :                                   (token-decoder nil))
    1127           0 :                               (when (string-match "^gpg:" lexv)
    1128             :                                 ;; it's a GPG token: create a token decoder
    1129             :                                 ;; which unsets itself once
    1130           0 :                                 (setq token-decoder
    1131             :                                       (lambda (val)
    1132           0 :                                         (prog1
    1133           0 :                                             (auth-source-epa-extract-gpg-token
    1134           0 :                                              val
    1135           0 :                                              filename)
    1136           0 :                                           (setq token-decoder nil)))))
    1137             :                               (lambda ()
    1138           0 :                                 (when token-decoder
    1139           0 :                                   (setq lexv (funcall token-decoder lexv)))
    1140           0 :                                 lexv))))
    1141           0 :                   (setq ret (plist-put ret
    1142           0 :                                        (auth-source--symbol-keyword k)
    1143           0 :                                        v))))
    1144           0 :               ret))
    1145           0 :           alist))
    1146             : 
    1147             : (cl-defun auth-source-netrc-search (&rest spec
    1148             :                                     &key backend require create
    1149             :                                     type max host user port
    1150             :                                     &allow-other-keys)
    1151             :   "Given a property list SPEC, return search matches from the :backend.
    1152             : See `auth-source-search' for details on SPEC."
    1153             :   ;; just in case, check that the type is correct (null or same as the backend)
    1154           0 :   (cl-assert (or (null type) (eq type (oref backend type)))
    1155           0 :              t "Invalid netrc search: %s %s")
    1156             : 
    1157           0 :   (let ((results (auth-source-netrc-normalize
    1158           0 :                   (auth-source-netrc-parse
    1159           0 :                    :max max
    1160           0 :                    :require require
    1161           0 :                    :file (oref backend source)
    1162           0 :                    :host (or host t)
    1163           0 :                    :user (or user t)
    1164           0 :                    :port (or port t))
    1165           0 :                   (oref backend source))))
    1166             : 
    1167             :     ;; if we need to create an entry AND none were found to match
    1168           0 :     (when (and create
    1169           0 :                (not results))
    1170             : 
    1171             :       ;; create based on the spec and record the value
    1172           0 :       (setq results (or
    1173             :                      ;; if the user did not want to create the entry
    1174             :                      ;; in the file, it will be returned
    1175           0 :                      (apply (slot-value backend 'create-function) spec)
    1176             :                      ;; if not, we do the search again without :create
    1177             :                      ;; to get the updated data.
    1178             : 
    1179             :                      ;; the result will be returned, even if the search fails
    1180           0 :                      (apply #'auth-source-netrc-search
    1181           0 :                             (plist-put spec :create nil)))))
    1182           0 :     results))
    1183             : 
    1184             : (defun auth-source-netrc-element-or-first (v)
    1185           0 :   (if (listp v)
    1186           0 :       (nth 0 v)
    1187           0 :     v))
    1188             : 
    1189             : ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
    1190             : ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
    1191             : 
    1192             : (cl-defun auth-source-netrc-create (&rest spec
    1193             :                                     &key backend host port create
    1194             :                                     &allow-other-keys)
    1195           0 :   (let* ((base-required '(host user port secret))
    1196             :          ;; we know (because of an assertion in auth-source-search) that the
    1197             :          ;; :create parameter is either t or a list (which includes nil)
    1198           0 :          (create-extra (if (eq t create) nil create))
    1199           0 :          (current-data (car (auth-source-search :max 1
    1200           0 :                                                 :host host
    1201           0 :                                                 :port port)))
    1202           0 :          (required (append base-required create-extra))
    1203           0 :          (file (oref backend source))
    1204             :          (add "")
    1205             :          ;; `valist' is an alist
    1206             :          valist
    1207             :          ;; `artificial' will be returned if no creation is needed
    1208             :          artificial)
    1209             : 
    1210             :     ;; only for base required elements (defined as function parameters):
    1211             :     ;; fill in the valist with whatever data we may have from the search
    1212             :     ;; we complete the first value if it's a list and use the value otherwise
    1213           0 :     (dolist (br base-required)
    1214           0 :       (let ((val (plist-get spec (auth-source--symbol-keyword br))))
    1215           0 :         (when val
    1216           0 :           (let ((br-choice (cond
    1217             :                             ;; all-accepting choice (predicate is t)
    1218           0 :                             ((eq t val) nil)
    1219             :                             ;; just the value otherwise
    1220           0 :                             (t val))))
    1221           0 :             (when br-choice
    1222           0 :               (auth-source--aput valist br br-choice))))))
    1223             : 
    1224             :     ;; for extra required elements, see if the spec includes a value for them
    1225           0 :     (dolist (er create-extra)
    1226           0 :       (let ((k (auth-source--symbol-keyword er))
    1227           0 :             (keys (cl-loop for i below (length spec) by 2
    1228           0 :                            collect (nth i spec))))
    1229           0 :         (when (memq k keys)
    1230           0 :           (auth-source--aput valist er (plist-get spec k)))))
    1231             : 
    1232             :     ;; for each required element
    1233           0 :     (dolist (r required)
    1234           0 :       (let* ((data (auth-source--aget valist r))
    1235             :              ;; take the first element if the data is a list
    1236           0 :              (data (or (auth-source-netrc-element-or-first data)
    1237           0 :                        (plist-get current-data
    1238           0 :                                   (auth-source--symbol-keyword r))))
    1239             :              ;; this is the default to be offered
    1240           0 :              (given-default (auth-source--aget
    1241           0 :                              auth-source-creation-defaults r))
    1242             :              ;; the default supplementals are simple:
    1243             :              ;; for the user, try `given-default' and then (user-login-name);
    1244             :              ;; otherwise take `given-default'
    1245           0 :              (default (cond
    1246           0 :                        ((and (not given-default) (eq r 'user))
    1247           0 :                         (user-login-name))
    1248           0 :                        (t given-default)))
    1249           0 :              (printable-defaults (list
    1250           0 :                                   (cons 'user
    1251           0 :                                         (or
    1252           0 :                                          (auth-source-netrc-element-or-first
    1253           0 :                                           (auth-source--aget valist 'user))
    1254           0 :                                          (plist-get artificial :user)
    1255           0 :                                          "[any user]"))
    1256           0 :                                   (cons 'host
    1257           0 :                                         (or
    1258           0 :                                          (auth-source-netrc-element-or-first
    1259           0 :                                           (auth-source--aget valist 'host))
    1260           0 :                                          (plist-get artificial :host)
    1261           0 :                                          "[any host]"))
    1262           0 :                                   (cons 'port
    1263           0 :                                         (or
    1264           0 :                                          (auth-source-netrc-element-or-first
    1265           0 :                                           (auth-source--aget valist 'port))
    1266           0 :                                          (plist-get artificial :port)
    1267           0 :                                          "[any port]"))))
    1268           0 :              (prompt (or (auth-source--aget auth-source-creation-prompts r)
    1269           0 :                          (cl-case r
    1270             :                            (secret "%p password for %u@%h: ")
    1271             :                            (user "%p user name for %h: ")
    1272             :                            (host "%p host name for user %u: ")
    1273           0 :                            (port "%p port for %u@%h: "))
    1274           0 :                          (format "Enter %s (%%u@%%h:%%p): " r)))
    1275           0 :              (prompt (auth-source-format-prompt
    1276           0 :                       prompt
    1277           0 :                       `((?u ,(auth-source--aget printable-defaults 'user))
    1278           0 :                         (?h ,(auth-source--aget printable-defaults 'host))
    1279           0 :                         (?p ,(auth-source--aget printable-defaults 'port))))))
    1280             : 
    1281             :         ;; Store the data, prompting for the password if needed.
    1282           0 :         (setq data (or data
    1283           0 :                        (if (eq r 'secret)
    1284             :                            ;; Special case prompt for passwords.
    1285             :                            ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") nil) (t gpg)))
    1286             :                            ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
    1287           0 :                            (let* ((ep (format "Use GPG password tokens in %s?" file))
    1288             :                                   (gpg-encrypt
    1289           0 :                                    (cond
    1290           0 :                                     ((eq auth-source-netrc-use-gpg-tokens 'never)
    1291             :                                      'never)
    1292           0 :                                     ((listp auth-source-netrc-use-gpg-tokens)
    1293           0 :                                      (let ((check (copy-sequence
    1294           0 :                                                    auth-source-netrc-use-gpg-tokens))
    1295             :                                            item ret)
    1296           0 :                                        (while check
    1297           0 :                                          (setq item (pop check))
    1298           0 :                                          (when (or (eq (car item) t)
    1299           0 :                                                    (string-match (car item) file))
    1300           0 :                                            (setq ret (cdr item))
    1301           0 :                                            (setq check nil)))
    1302             :                                        ;; FIXME: `ret' unused.
    1303             :                                        ;; Should we return it here?
    1304           0 :                                        ))
    1305           0 :                                     (t 'never)))
    1306           0 :                                   (plain (or (eval default) (read-passwd prompt))))
    1307             :                              ;; ask if we don't know what to do (in which case
    1308             :                              ;; auth-source-netrc-use-gpg-tokens must be a list)
    1309           0 :                              (unless gpg-encrypt
    1310           0 :                                (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
    1311             :                                ;; TODO: save the defcustom now? or ask?
    1312           0 :                                (setq auth-source-netrc-use-gpg-tokens
    1313           0 :                                      (cons `(,file ,gpg-encrypt)
    1314           0 :                                            auth-source-netrc-use-gpg-tokens)))
    1315           0 :                              (if (eq gpg-encrypt 'gpg)
    1316           0 :                                  (auth-source-epa-make-gpg-token plain file)
    1317           0 :                                plain))
    1318           0 :                          (if (stringp default)
    1319           0 :                              (read-string (if (string-match ": *\\'" prompt)
    1320           0 :                                               (concat (substring prompt 0 (match-beginning 0))
    1321           0 :                                                       " (default " default "): ")
    1322           0 :                                             (concat prompt "(default " default ") "))
    1323           0 :                                           nil nil default)
    1324           0 :                            (eval default)))))
    1325             : 
    1326           0 :         (when data
    1327           0 :           (setq artificial (plist-put artificial
    1328           0 :                                       (auth-source--symbol-keyword r)
    1329           0 :                                       (if (eq r 'secret)
    1330           0 :                                           (let ((data data))
    1331           0 :                                             (lambda () data))
    1332           0 :                                         data))))
    1333             : 
    1334             :         ;; When r is not an empty string...
    1335           0 :         (when (and (stringp data)
    1336           0 :                    (< 0 (length data)))
    1337             :           ;; this function is not strictly necessary but I think it
    1338             :           ;; makes the code clearer -tzz
    1339           0 :           (let ((printer (lambda ()
    1340             :                            ;; append the key (the symbol name of r)
    1341             :                            ;; and the value in r
    1342           0 :                            (format "%s%s %s"
    1343             :                                    ;; prepend a space
    1344           0 :                                    (if (zerop (length add)) "" " ")
    1345             :                                    ;; remap auth-source tokens to netrc
    1346           0 :                                    (cl-case r
    1347             :                                      (user   "login")
    1348             :                                      (host   "machine")
    1349             :                                      (secret "password")
    1350             :                                      (port   "port") ; redundant but clearer
    1351           0 :                                      (t (symbol-name r)))
    1352           0 :                                    (if (string-match "[\"# ]" data)
    1353           0 :                                        (format "%S" data)
    1354           0 :                                      data)))))
    1355           0 :             (setq add (concat add (funcall printer)))))))
    1356             : 
    1357           0 :     (plist-put
    1358           0 :      artificial
    1359             :      :save-function
    1360           0 :      (let ((file file)
    1361           0 :            (add add))
    1362           0 :        (lambda () (auth-source-netrc-saver file add))))
    1363             : 
    1364           0 :     (list artificial)))
    1365             : 
    1366             : (defun auth-source-netrc-saver (file add)
    1367             :   "Save a line ADD in FILE, prompting along the way.
    1368             : Respects `auth-source-save-behavior'.  Uses
    1369             : `auth-source-netrc-cache' to avoid prompting more than once."
    1370           0 :   (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add)))
    1371           0 :          (cached (assoc key auth-source-netrc-cache)))
    1372             : 
    1373           0 :     (if cached
    1374           0 :         (auth-source-do-trivia
    1375             :          "auth-source-netrc-saver: found previous run for key %s, returning"
    1376           0 :          key)
    1377           0 :       (with-temp-buffer
    1378           0 :         (when (file-exists-p file)
    1379           0 :           (insert-file-contents file))
    1380           0 :         (when auth-source-gpg-encrypt-to
    1381             :           ;; (see bug#7487) making `epa-file-encrypt-to' local to
    1382             :           ;; this buffer lets epa-file skip the key selection query
    1383             :           ;; (see the `local-variable-p' check in
    1384             :           ;; `epa-file-write-region').
    1385           0 :           (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
    1386           0 :             (make-local-variable 'epa-file-encrypt-to))
    1387           0 :           (if (listp auth-source-gpg-encrypt-to)
    1388           0 :               (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
    1389             :         ;; we want the new data to be found first, so insert at beginning
    1390           0 :         (goto-char (point-min))
    1391             : 
    1392             :         ;; Ask AFTER we've successfully opened the file.
    1393           0 :         (let ((prompt (format "Save auth info to file %s? " file))
    1394           0 :               (done (not (eq auth-source-save-behavior 'ask)))
    1395             :               (bufname "*auth-source Help*")
    1396             :               k)
    1397           0 :           (while (not done)
    1398           0 :             (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
    1399           0 :             (cl-case k
    1400           0 :               (?y (setq done t))
    1401           0 :               (?? (save-excursion
    1402           0 :                     (with-output-to-temp-buffer bufname
    1403           0 :                       (princ
    1404           0 :                        (concat "(y)es, save\n"
    1405             :                                "(n)o but use the info\n"
    1406             :                                "(N)o and don't ask to save again\n"
    1407             :                                "(e)dit the line\n"
    1408           0 :                                "(?) for help as you can see.\n"))
    1409             :                       ;; Why?  Doesn't with-output-to-temp-buffer already do
    1410             :                       ;; the exact same thing anyway?  --Stef
    1411           0 :                       (set-buffer standard-output)
    1412           0 :                       (help-mode))))
    1413           0 :               (?n (setq add ""
    1414           0 :                         done t))
    1415             :               (?N
    1416           0 :                (setq add ""
    1417           0 :                      done t)
    1418           0 :                (customize-save-variable 'auth-source-save-behavior nil))
    1419           0 :               (?e (setq add (read-string "Line to add: " add)))
    1420           0 :               (t nil)))
    1421             : 
    1422           0 :           (when (get-buffer-window bufname)
    1423           0 :             (delete-window (get-buffer-window bufname)))
    1424             : 
    1425             :           ;; Make sure the info is not saved.
    1426           0 :           (when (null auth-source-save-behavior)
    1427           0 :             (setq add ""))
    1428             : 
    1429           0 :           (when (< 0 (length add))
    1430           0 :             (progn
    1431           0 :               (unless (bolp)
    1432           0 :                 (insert "\n"))
    1433           0 :               (insert add "\n")
    1434           0 :               (write-region (point-min) (point-max) file nil 'silent)
    1435             :               ;; Make the .authinfo file non-world-readable.
    1436           0 :               (set-file-modes file #o600)
    1437           0 :               (auth-source-do-debug
    1438             :                "auth-source-netrc-create: wrote 1 new line to %s"
    1439           0 :                file)
    1440           0 :               (message "Saved new authentication information to %s" file)
    1441           0 :               nil))))
    1442           0 :       (auth-source--aput auth-source-netrc-cache key "ran"))))
    1443             : 
    1444             : ;;; Backend specific parsing: Secrets API backend
    1445             : 
    1446             : (defun auth-source-secrets-listify-pattern (pattern)
    1447             :   "Convert a pattern with lists to a list of string patterns.
    1448             : 
    1449             : auth-source patterns can have values of the form :foo (\"bar\"
    1450             : \"qux\"), which means to match any secret with :foo equal to
    1451             : \"bar\" or :foo equal to \"qux\".  The secrets backend supports
    1452             : only string values for patterns, so this routine returns a list
    1453             : of patterns that is equivalent to the single original pattern
    1454             : when interpreted such that if a secret matches any pattern in the
    1455             : list, it matches the original pattern."
    1456           0 :   (if (null pattern)
    1457             :       '(nil)
    1458           0 :     (let* ((key (pop pattern))
    1459           0 :            (value (pop pattern))
    1460           0 :            (tails (auth-source-secrets-listify-pattern pattern))
    1461           0 :            (heads (if (stringp value)
    1462           0 :                       (list (list key value))
    1463           0 :                     (mapcar (lambda (v) (list key v)) value))))
    1464           0 :       (cl-loop for h in heads
    1465           0 :                nconc (cl-loop for tl in tails collect (append h tl))))))
    1466             : 
    1467             : (cl-defun auth-source-secrets-search (&rest spec
    1468             :                                       &key backend create delete label max
    1469             :                                       &allow-other-keys)
    1470             :   "Search the Secrets API; spec is like `auth-source'.
    1471             : 
    1472             : The :label key specifies the item's label.  It is the only key
    1473             : that can specify a substring.  Any :label value besides a string
    1474             : will allow any label.
    1475             : 
    1476             : All other search keys must match exactly.  If you need substring
    1477             : matching, do a wider search and narrow it down yourself.
    1478             : 
    1479             : You'll get back all the properties of the token as a plist.
    1480             : 
    1481             : Here's an example that looks for the first item in the `Login'
    1482             : Secrets collection:
    1483             : 
    1484             :  (let ((auth-sources \\='(\"secrets:Login\")))
    1485             :     (auth-source-search :max 1)
    1486             : 
    1487             : Here's another that looks for the first item in the `Login'
    1488             : Secrets collection whose label contains `gnus':
    1489             : 
    1490             :  (let ((auth-sources \\='(\"secrets:Login\")))
    1491             :     (auth-source-search :max 1 :label \"gnus\")
    1492             : 
    1493             : And this one looks for the first item in the `Login' Secrets
    1494             : collection that's a Google Chrome entry for the git.gnus.org site
    1495             : authentication tokens:
    1496             : 
    1497             :  (let ((auth-sources \\='(\"secrets:Login\")))
    1498             :     (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
    1499             : "
    1500             : 
    1501             :   ;; TODO
    1502           0 :   (cl-assert (not create) nil
    1503           0 :              "The Secrets API auth-source backend doesn't support creation yet")
    1504             :   ;; TODO
    1505             :   ;; (secrets-delete-item coll elt)
    1506           0 :   (cl-assert (not delete) nil
    1507           0 :              "The Secrets API auth-source backend doesn't support deletion yet")
    1508             : 
    1509           0 :   (let* ((coll (oref backend source))
    1510           0 :          (max (or max 5000))     ; sanity check: default to stop at 5K
    1511             :          (ignored-keys '(:create :delete :max :backend :label :require :type))
    1512           0 :          (search-keys (cl-loop for i below (length spec) by 2
    1513           0 :                                unless (memq (nth i spec) ignored-keys)
    1514           0 :                                collect (nth i spec)))
    1515             :          ;; build a search spec without the ignored keys
    1516             :          ;; if a search key is nil or t (match anything), we skip it
    1517           0 :          (search-specs (auth-source-secrets-listify-pattern
    1518           0 :                         (apply #'append (mapcar
    1519             :                                       (lambda (k)
    1520           0 :                                         (if (or (null (plist-get spec k))
    1521           0 :                                                 (eq t (plist-get spec k)))
    1522             :                                             nil
    1523           0 :                                           (list k (plist-get spec k))))
    1524           0 :                                       search-keys))))
    1525             :          ;; needed keys (always including host, login, port, and secret)
    1526           0 :          (returned-keys (delete-dups (append
    1527             :                                       '(:host :login :port :secret)
    1528           0 :                                       search-keys)))
    1529             :          (items
    1530           0 :           (cl-loop
    1531           0 :            for search-spec in search-specs
    1532             :            nconc
    1533           0 :            (cl-loop for item in (apply #'secrets-search-items coll search-spec)
    1534           0 :                     unless (and (stringp label)
    1535           0 :                                 (not (string-match label item)))
    1536           0 :                     collect item)))
    1537             :          ;; TODO: respect max in `secrets-search-items', not after the fact
    1538           0 :          (items (butlast items (- (length items) max)))
    1539             :          ;; convert the item name to a full plist
    1540           0 :          (items (mapcar (lambda (item)
    1541           0 :                           (append
    1542             :                            ;; make an entry for the secret (password) element
    1543           0 :                            (list
    1544             :                             :secret
    1545           0 :                             (let ((v (secrets-get-secret coll item)))
    1546           0 :                               (lambda () v)))
    1547             :                            ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
    1548           0 :                            (apply #'append
    1549           0 :                                   (mapcar (lambda (entry)
    1550           0 :                                             (list (car entry) (cdr entry)))
    1551           0 :                                           (secrets-get-attributes coll item)))))
    1552           0 :                         items))
    1553             :          ;; ensure each item has each key in `returned-keys'
    1554           0 :          (items (mapcar (lambda (plist)
    1555           0 :                           (append
    1556           0 :                            (apply #'append
    1557           0 :                                   (mapcar (lambda (req)
    1558           0 :                                             (if (plist-get plist req)
    1559             :                                                 nil
    1560           0 :                                               (list req nil)))
    1561           0 :                                           returned-keys))
    1562           0 :                            plist))
    1563           0 :                         items)))
    1564           0 :     items))
    1565             : 
    1566             : (defun auth-source-secrets-create (&rest spec)
    1567             :   ;; TODO
    1568             :   ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
    1569           0 :   (debug spec))
    1570             : 
    1571             : ;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend
    1572             : 
    1573             : (cl-defun auth-source-macos-keychain-search (&rest spec
    1574             :                                              &key backend create delete type max
    1575             :                                              &allow-other-keys)
    1576             :   "Search the macOS Keychain; spec is like `auth-source'.
    1577             : 
    1578             : All search keys must match exactly.  If you need substring
    1579             : matching, do a wider search and narrow it down yourself.
    1580             : 
    1581             : You'll get back all the properties of the token as a plist.
    1582             : 
    1583             : The :type key is either `macos-keychain-internet' or
    1584             : `macos-keychain-generic'.
    1585             : 
    1586             : For the internet keychain type, the :label key searches the
    1587             : item's labels (\"-l LABEL\" passed to \"/usr/bin/security\").
    1588             : Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\",
    1589             : and :port maps to \"-P PORT\" or \"-r PROT\"
    1590             : \(note PROT has to be a 4-character string).
    1591             : 
    1592             : For the generic keychain type, the :label key searches the item's
    1593             : labels (\"-l LABEL\" passed to \"/usr/bin/security\").
    1594             : Similarly, :host maps to \"-c HOST\" (the \"creator\" keychain
    1595             : field), :user maps to \"-a USER\", and :port maps to \"-s PORT\".
    1596             : 
    1597             : Here's an example that looks for the first item in the default
    1598             : generic macOS Keychain:
    1599             : 
    1600             :  (let ((auth-sources \\='(macos-keychain-generic)))
    1601             :     (auth-source-search :max 1)
    1602             : 
    1603             : Here's another that looks for the first item in the internet
    1604             : macOS Keychain collection whose label is `gnus':
    1605             : 
    1606             :  (let ((auth-sources \\='(macos-keychain-internet)))
    1607             :     (auth-source-search :max 1 :label \"gnus\")
    1608             : 
    1609             : And this one looks for the first item in the internet keychain
    1610             : entries for git.gnus.org:
    1611             : 
    1612             :  (let ((auth-sources \\='(macos-keychain-internet\")))
    1613             :     (auth-source-search :max 1 :host \"git.gnus.org\"))
    1614             : "
    1615             :   ;; TODO
    1616           0 :   (cl-assert (not create) nil
    1617           0 :           "The macOS Keychain auth-source backend doesn't support creation yet")
    1618             :   ;; TODO
    1619             :   ;; (macos-keychain-delete-item coll elt)
    1620           0 :   (cl-assert (not delete) nil
    1621           0 :           "The macOS Keychain auth-source backend doesn't support deletion yet")
    1622             : 
    1623           0 :   (let* ((coll (oref backend source))
    1624           0 :          (max (or max 5000))     ; sanity check: default to stop at 5K
    1625             :          ;; Filter out ignored keys from the spec
    1626             :          (ignored-keys '(:create :delete :max :backend :label :host :port))
    1627             :          ;; Build a search spec without the ignored keys
    1628             :          ;; FIXME make this loop a function? it's used in at least 3 places
    1629           0 :          (search-keys (cl-loop for i below (length spec) by 2
    1630           0 :                                unless (memq (nth i spec) ignored-keys)
    1631           0 :                                collect (nth i spec)))
    1632             :          ;; If a search key value is nil or t (match anything), we skip it
    1633           0 :          (search-spec (apply #'append (mapcar
    1634             :                                       (lambda (k)
    1635           0 :                                         (if (or (null (plist-get spec k))
    1636           0 :                                                 (eq t (plist-get spec k)))
    1637             :                                             nil
    1638           0 :                                           (list k (plist-get spec k))))
    1639           0 :                                       search-keys)))
    1640             :          ;; needed keys (always including host, login, port, and secret)
    1641           0 :          (returned-keys (delete-dups (append
    1642             :                                       '(:host :login :port :secret)
    1643           0 :                                       search-keys)))
    1644             :          ;; Extract host and port from spec
    1645           0 :          (hosts (plist-get spec :host))
    1646           0 :          (hosts (if (and hosts (listp hosts)) hosts `(,hosts)))
    1647           0 :          (ports (plist-get spec :port))
    1648           0 :          (ports (if (and ports (listp ports)) ports `(,ports)))
    1649             :          ;; Loop through all combinations of host/port and pass each of these to
    1650             :          ;; auth-source-macos-keychain-search-items
    1651           0 :          (items (catch 'match
    1652           0 :                   (dolist (host hosts)
    1653           0 :                     (dolist (port ports)
    1654           0 :                       (let* ((port (if port (format "%S" port)))
    1655           0 :                              (items (apply #'auth-source-macos-keychain-search-items
    1656           0 :                                            coll
    1657           0 :                                            type
    1658           0 :                                            max
    1659           0 :                                            host port
    1660           0 :                                            search-spec)))
    1661           0 :                         (when items
    1662           0 :                           (throw 'match items)))))))
    1663             : 
    1664             :          ;; ensure each item has each key in `returned-keys'
    1665           0 :          (items (mapcar (lambda (plist)
    1666           0 :                           (append
    1667           0 :                            (apply #'append
    1668           0 :                                   (mapcar (lambda (req)
    1669           0 :                                             (if (plist-get plist req)
    1670             :                                                 nil
    1671           0 :                                               (list req nil)))
    1672           0 :                                           returned-keys))
    1673           0 :                            plist))
    1674           0 :                         items)))
    1675           0 :     items))
    1676             : 
    1677             : 
    1678             : (defun auth-source--decode-octal-string (string)
    1679             :   "Convert octal string to utf-8 string. E.g: 'a\134b' to 'a\b'"
    1680           0 :   (let ((list (string-to-list string))
    1681           0 :         (size (length string)))
    1682           0 :     (decode-coding-string
    1683           0 :      (apply #'unibyte-string
    1684           0 :             (cl-loop for i = 0 then (+ i (if (eq (nth i list) ?\\) 4 1))
    1685           0 :                      for var = (nth i list)
    1686           0 :                      while (< i size)
    1687           0 :                      if (eq var ?\\)
    1688           0 :                      collect (string-to-number
    1689           0 :                               (concat (cl-subseq list (+ i 1) (+ i 4))) 8)
    1690             :                      else
    1691           0 :                      collect var))
    1692           0 :      'utf-8)))
    1693             : 
    1694             : (cl-defun auth-source-macos-keychain-search-items (coll _type _max host port
    1695             :                                                    &key label type user
    1696             :                                                    &allow-other-keys)
    1697           0 :   (let* ((keychain-generic (eq type 'macos-keychain-generic))
    1698           0 :          (args `(,(if keychain-generic
    1699             :                       "find-generic-password"
    1700           0 :                     "find-internet-password")
    1701           0 :                  "-g"))
    1702           0 :          (ret (list :type type)))
    1703           0 :     (when label
    1704           0 :       (setq args (append args (list "-l" label))))
    1705           0 :     (when host
    1706           0 :       (setq args (append args (list (if keychain-generic "-c" "-s") host))))
    1707           0 :     (when user
    1708           0 :       (setq args (append args (list "-a" user))))
    1709             : 
    1710           0 :     (when port
    1711           0 :       (if keychain-generic
    1712           0 :           (setq args (append args (list "-s" port)))
    1713           0 :         (setq args (append args (list
    1714           0 :                                  (if (string-match "[0-9]+" port) "-P" "-r")
    1715           0 :                                  port)))))
    1716             : 
    1717           0 :       (unless (equal coll "default")
    1718           0 :         (setq args (append args (list coll))))
    1719             : 
    1720           0 :       (with-temp-buffer
    1721           0 :         (apply #'call-process "/usr/bin/security" nil t nil args)
    1722           0 :         (goto-char (point-min))
    1723           0 :         (while (not (eobp))
    1724           0 :           (cond
    1725           0 :            ((looking-at "^password: \\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
    1726           0 :             (setq ret (auth-source-macos-keychain-result-append
    1727           0 :                        ret
    1728           0 :                        keychain-generic
    1729             :                        "secret"
    1730           0 :                        (let ((v (auth-source--decode-octal-string
    1731           0 :                                  (match-string 1))))
    1732           0 :                          (lambda () v)))))
    1733             :            ;; TODO: check if this is really the label
    1734             :            ;; match 0x00000007 <blob>="AppleID"
    1735           0 :            ((looking-at
    1736           0 :              "^[ ]+0x00000007 <blob>=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
    1737           0 :             (setq ret (auth-source-macos-keychain-result-append
    1738           0 :                        ret
    1739           0 :                        keychain-generic
    1740             :                        "label"
    1741           0 :                        (auth-source--decode-octal-string (match-string 1)))))
    1742             :            ;; match "crtr"<uint32>="aapl"
    1743             :            ;; match "svce"<blob>="AppleID"
    1744           0 :            ((looking-at
    1745           0 :              "^[ ]+\"\\([a-z]+\\)\"[^=]+=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
    1746           0 :             (setq ret (auth-source-macos-keychain-result-append
    1747           0 :                        ret
    1748           0 :                        keychain-generic
    1749           0 :                        (auth-source--decode-octal-string (match-string 1))
    1750           0 :                        (auth-source--decode-octal-string (match-string 2))))))
    1751           0 :           (forward-line)))
    1752             :       ;; return `ret' iff it has the :secret key
    1753           0 :       (and (plist-get ret :secret) (list ret))))
    1754             : 
    1755             : (defun auth-source-macos-keychain-result-append (result generic k v)
    1756           0 :   (push v result)
    1757           0 :   (push (auth-source--symbol-keyword
    1758           0 :          (cond
    1759           0 :           ((equal k "acct") "user")
    1760             :           ;; for generic keychains, creator is host, service is port
    1761           0 :           ((and generic (equal k "crtr")) "host")
    1762           0 :           ((and generic (equal k "svce")) "port")
    1763             :           ;; for internet keychains, protocol is port, server is host
    1764           0 :           ((and (not generic) (equal k "ptcl")) "port")
    1765           0 :           ((and (not generic) (equal k "srvr")) "host")
    1766           0 :           (t k)))
    1767           0 :         result))
    1768             : 
    1769             : (defun auth-source-macos-keychain-create (&rest spec)
    1770             :   ;; TODO
    1771           0 :   (debug spec))
    1772             : 
    1773             : ;;; Backend specific parsing: PLSTORE backend
    1774             : 
    1775             : (cl-defun auth-source-plstore-search (&rest spec
    1776             :                                       &key backend create delete max
    1777             :                                       &allow-other-keys)
    1778             :   "Search the PLSTORE; spec is like `auth-source'."
    1779           0 :   (let* ((store (oref backend data))
    1780           0 :          (max (or max 5000))     ; sanity check: default to stop at 5K
    1781             :          (ignored-keys '(:create :delete :max :backend :label :require :type))
    1782           0 :          (search-keys (cl-loop for i below (length spec) by 2
    1783           0 :                                unless (memq (nth i spec) ignored-keys)
    1784           0 :                                collect (nth i spec)))
    1785             :          ;; build a search spec without the ignored keys
    1786             :          ;; if a search key is nil or t (match anything), we skip it
    1787           0 :          (search-spec (apply #'append (mapcar
    1788             :                                       (lambda (k)
    1789           0 :                                         (let ((v (plist-get spec k)))
    1790           0 :                                           (if (or (null v)
    1791           0 :                                                   (eq t v))
    1792             :                                               nil
    1793           0 :                                             (if (stringp v)
    1794           0 :                                                 (setq v (list v)))
    1795           0 :                                             (list k v))))
    1796           0 :                                       search-keys)))
    1797             :          ;; needed keys (always including host, login, port, and secret)
    1798           0 :          (returned-keys (delete-dups (append
    1799             :                                       '(:host :login :port :secret)
    1800           0 :                                       search-keys)))
    1801           0 :          (items (plstore-find store search-spec))
    1802           0 :          (item-names (mapcar #'car items))
    1803           0 :          (items (butlast items (- (length items) max)))
    1804             :          ;; convert the item to a full plist
    1805           0 :          (items (mapcar (lambda (item)
    1806           0 :                           (let* ((plist (copy-tree (cdr item)))
    1807           0 :                                  (secret (plist-member plist :secret)))
    1808           0 :                             (if secret
    1809           0 :                                 (setcar
    1810           0 :                                  (cdr secret)
    1811           0 :                                  (let ((v (car (cdr secret))))
    1812           0 :                                    (lambda () v))))
    1813           0 :                             plist))
    1814           0 :                         items))
    1815             :          ;; ensure each item has each key in `returned-keys'
    1816           0 :          (items (mapcar (lambda (plist)
    1817           0 :                           (append
    1818           0 :                            (apply #'append
    1819           0 :                                   (mapcar (lambda (req)
    1820           0 :                                             (if (plist-get plist req)
    1821             :                                                 nil
    1822           0 :                                               (list req nil)))
    1823           0 :                                           returned-keys))
    1824           0 :                            plist))
    1825           0 :                         items)))
    1826           0 :     (cond
    1827             :      ;; if we need to create an entry AND none were found to match
    1828           0 :      ((and create
    1829           0 :            (not items))
    1830             : 
    1831             :       ;; create based on the spec and record the value
    1832           0 :       (setq items (or
    1833             :                    ;; if the user did not want to create the entry
    1834             :                    ;; in the file, it will be returned
    1835           0 :                    (apply (slot-value backend 'create-function) spec)
    1836             :                    ;; if not, we do the search again without :create
    1837             :                    ;; to get the updated data.
    1838             : 
    1839             :                    ;; the result will be returned, even if the search fails
    1840           0 :                    (apply #'auth-source-plstore-search
    1841           0 :                           (plist-put spec :create nil)))))
    1842           0 :      ((and delete
    1843           0 :            item-names)
    1844           0 :       (dolist (item-name item-names)
    1845           0 :         (plstore-delete store item-name))
    1846           0 :       (plstore-save store)))
    1847           0 :     items))
    1848             : 
    1849             : (cl-defun auth-source-plstore-create (&rest spec
    1850             :                                       &key backend host port create
    1851             :                                       &allow-other-keys)
    1852           0 :   (let* ((base-required '(host user port secret))
    1853             :          (base-secret '(secret))
    1854             :          ;; we know (because of an assertion in auth-source-search) that the
    1855             :          ;; :create parameter is either t or a list (which includes nil)
    1856           0 :          (create-extra (if (eq t create) nil create))
    1857           0 :          (current-data (car (auth-source-search :max 1
    1858           0 :                                                 :host host
    1859           0 :                                                 :port port)))
    1860           0 :          (required (append base-required create-extra))
    1861             :          ;; `valist' is an alist
    1862             :          valist
    1863             :          ;; `artificial' will be returned if no creation is needed
    1864             :          artificial
    1865             :          secret-artificial)
    1866             : 
    1867             :     ;; only for base required elements (defined as function parameters):
    1868             :     ;; fill in the valist with whatever data we may have from the search
    1869             :     ;; we complete the first value if it's a list and use the value otherwise
    1870           0 :     (dolist (br base-required)
    1871           0 :       (let ((val (plist-get spec (auth-source--symbol-keyword br))))
    1872           0 :         (when val
    1873           0 :           (let ((br-choice (cond
    1874             :                             ;; all-accepting choice (predicate is t)
    1875           0 :                             ((eq t val) nil)
    1876             :                             ;; just the value otherwise
    1877           0 :                             (t val))))
    1878           0 :             (when br-choice
    1879           0 :               (auth-source--aput valist br br-choice))))))
    1880             : 
    1881             :     ;; for extra required elements, see if the spec includes a value for them
    1882           0 :     (dolist (er create-extra)
    1883           0 :       (let ((k (auth-source--symbol-keyword er))
    1884           0 :             (keys (cl-loop for i below (length spec) by 2
    1885           0 :                            collect (nth i spec))))
    1886           0 :         (when (memq k keys)
    1887           0 :           (auth-source--aput valist er (plist-get spec k)))))
    1888             : 
    1889             :     ;; for each required element
    1890           0 :     (dolist (r required)
    1891           0 :       (let* ((data (auth-source--aget valist r))
    1892             :              ;; take the first element if the data is a list
    1893           0 :              (data (or (auth-source-netrc-element-or-first data)
    1894           0 :                        (plist-get current-data
    1895           0 :                                   (auth-source--symbol-keyword r))))
    1896             :              ;; this is the default to be offered
    1897           0 :              (given-default (auth-source--aget
    1898           0 :                              auth-source-creation-defaults r))
    1899             :              ;; the default supplementals are simple:
    1900             :              ;; for the user, try `given-default' and then (user-login-name);
    1901             :              ;; otherwise take `given-default'
    1902           0 :              (default (cond
    1903           0 :                        ((and (not given-default) (eq r 'user))
    1904           0 :                         (user-login-name))
    1905           0 :                        (t given-default)))
    1906           0 :              (printable-defaults (list
    1907           0 :                                   (cons 'user
    1908           0 :                                         (or
    1909           0 :                                          (auth-source-netrc-element-or-first
    1910           0 :                                           (auth-source--aget valist 'user))
    1911           0 :                                          (plist-get artificial :user)
    1912           0 :                                          "[any user]"))
    1913           0 :                                   (cons 'host
    1914           0 :                                         (or
    1915           0 :                                          (auth-source-netrc-element-or-first
    1916           0 :                                           (auth-source--aget valist 'host))
    1917           0 :                                          (plist-get artificial :host)
    1918           0 :                                          "[any host]"))
    1919           0 :                                   (cons 'port
    1920           0 :                                         (or
    1921           0 :                                          (auth-source-netrc-element-or-first
    1922           0 :                                           (auth-source--aget valist 'port))
    1923           0 :                                          (plist-get artificial :port)
    1924           0 :                                          "[any port]"))))
    1925           0 :              (prompt (or (auth-source--aget auth-source-creation-prompts r)
    1926           0 :                          (cl-case r
    1927             :                            (secret "%p password for %u@%h: ")
    1928             :                            (user "%p user name for %h: ")
    1929             :                            (host "%p host name for user %u: ")
    1930           0 :                            (port "%p port for %u@%h: "))
    1931           0 :                          (format "Enter %s (%%u@%%h:%%p): " r)))
    1932           0 :              (prompt (auth-source-format-prompt
    1933           0 :                       prompt
    1934           0 :                       `((?u ,(auth-source--aget printable-defaults 'user))
    1935           0 :                         (?h ,(auth-source--aget printable-defaults 'host))
    1936           0 :                         (?p ,(auth-source--aget printable-defaults 'port))))))
    1937             : 
    1938             :         ;; Store the data, prompting for the password if needed.
    1939           0 :         (setq data (or data
    1940           0 :                        (if (eq r 'secret)
    1941           0 :                            (or (eval default) (read-passwd prompt))
    1942           0 :                          (if (stringp default)
    1943           0 :                              (read-string
    1944           0 :                               (if (string-match ": *\\'" prompt)
    1945           0 :                                   (concat (substring prompt 0 (match-beginning 0))
    1946           0 :                                           " (default " default "): ")
    1947           0 :                                 (concat prompt "(default " default ") "))
    1948           0 :                               nil nil default)
    1949           0 :                            (eval default)))))
    1950             : 
    1951           0 :         (when data
    1952           0 :           (if (member r base-secret)
    1953           0 :               (setq secret-artificial
    1954           0 :                     (plist-put secret-artificial
    1955           0 :                                (auth-source--symbol-keyword r)
    1956           0 :                                data))
    1957           0 :             (setq artificial (plist-put artificial
    1958           0 :                                         (auth-source--symbol-keyword r)
    1959           0 :                                         data))))))
    1960           0 :     (plstore-put (oref backend data)
    1961           0 :                  (sha1 (format "%s@%s:%s"
    1962           0 :                                (plist-get artificial :user)
    1963           0 :                                (plist-get artificial :host)
    1964           0 :                                (plist-get artificial :port)))
    1965           0 :                  artificial secret-artificial)
    1966           0 :     (if (y-or-n-p (format "Save auth info to file %s? "
    1967           0 :                           (plstore-get-file (oref backend data))))
    1968           0 :         (plstore-save (oref backend data)))))
    1969             : 
    1970             : ;;; older API
    1971             : 
    1972             : ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
    1973             : 
    1974             : ;; deprecate the old interface
    1975             : (make-obsolete 'auth-source-user-or-password
    1976             :                'auth-source-search "Emacs 24.1")
    1977             : (make-obsolete 'auth-source-forget-user-or-password
    1978             :                'auth-source-forget "Emacs 24.1")
    1979             : 
    1980             : (defun auth-source-user-or-password
    1981             :   (mode host port &optional username create-missing delete-existing)
    1982             :   "Find MODE (string or list of strings) matching HOST and PORT.
    1983             : 
    1984             : DEPRECATED in favor of `auth-source-search'!
    1985             : 
    1986             : USERNAME is optional and will be used as \"login\" in a search
    1987             : across the Secret Service API (see secrets.el) if the resulting
    1988             : items don't have a username.  This means that if you search for
    1989             : username \"joe\" and it matches an item but the item doesn't have
    1990             : a :user attribute, the username \"joe\" will be returned.
    1991             : 
    1992             : A non nil DELETE-EXISTING means deleting any matching password
    1993             : entry in the respective sources.  This is useful only when
    1994             : CREATE-MISSING is non nil as well; the intended use case is to
    1995             : remove wrong password entries.
    1996             : 
    1997             : If no matching entry is found, and CREATE-MISSING is non nil,
    1998             : the password will be retrieved interactively, and it will be
    1999             : stored in the password database which matches best (see
    2000             : `auth-sources').
    2001             : 
    2002             : MODE can be \"login\" or \"password\"."
    2003           0 :   (auth-source-do-debug
    2004             :    "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
    2005           0 :    mode host port username)
    2006             : 
    2007           0 :   (let* ((listy (listp mode))
    2008           0 :          (mode (if listy mode (list mode)))
    2009             :          ;; (cname (if username
    2010             :          ;;            (format "%s %s:%s %s" mode host port username)
    2011             :          ;;          (format "%s %s:%s" mode host port)))
    2012           0 :          (search (list :host host :port port))
    2013           0 :          (search (if username (append search (list :user username)) search))
    2014           0 :          (search (if create-missing
    2015           0 :                      (append search (list :create t))
    2016           0 :                    search))
    2017           0 :          (search (if delete-existing
    2018           0 :                      (append search (list :delete t))
    2019           0 :                    search))
    2020             :          ;; (found (if (not delete-existing)
    2021             :          ;;            (gethash cname auth-source-cache)
    2022             :          ;;          (remhash cname auth-source-cache)
    2023             :          ;;          nil)))
    2024             :          (found nil))
    2025           0 :     (if found
    2026           0 :         (progn
    2027           0 :           (auth-source-do-debug
    2028             :            "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
    2029           0 :            mode
    2030             :            ;; don't show the password
    2031           0 :            (if (and (member "password" mode) t)
    2032             :                "SECRET"
    2033           0 :              found)
    2034           0 :            host port username)
    2035           0 :           found)                        ; return the found data
    2036             :       ;; else, if not found, search with a max of 1
    2037           0 :       (let ((choice (nth 0 (apply #'auth-source-search
    2038           0 :                                   (append '(:max 1) search)))))
    2039           0 :         (when choice
    2040           0 :           (dolist (m mode)
    2041           0 :             (cond
    2042           0 :              ((equal "password" m)
    2043           0 :               (push (if (plist-get choice :secret)
    2044           0 :                         (funcall (plist-get choice :secret))
    2045           0 :                       nil) found))
    2046           0 :              ((equal "login" m)
    2047           0 :               (push (plist-get choice :user) found)))))
    2048           0 :         (setq found (nreverse found))
    2049           0 :         (setq found (if listy found (car-safe found)))))
    2050             : 
    2051           0 :     found))
    2052             : 
    2053             : (defun auth-source-user-and-password (host &optional user)
    2054           0 :   (let* ((auth-info (car
    2055           0 :                      (if user
    2056           0 :                          (auth-source-search
    2057           0 :                           :host host
    2058           0 :                           :user user
    2059             :                           :max 1
    2060             :                           :require '(:user :secret)
    2061           0 :                           :create nil)
    2062           0 :                        (auth-source-search
    2063           0 :                         :host host
    2064             :                         :max 1
    2065             :                         :require '(:user :secret)
    2066           0 :                         :create nil))))
    2067           0 :          (user (plist-get auth-info :user))
    2068           0 :          (password (plist-get auth-info :secret)))
    2069           0 :     (when (functionp password)
    2070           0 :       (setq password (funcall password)))
    2071           0 :     (list user password auth-info)))
    2072             : 
    2073             : (provide 'auth-source)
    2074             : 
    2075             : ;;; auth-source.el ends here

Generated by: LCOV version 1.12