cgit.sxemacs.org Git - gnus/blob - lisp/auth-source.el

   1 ;;; auth-source.el --- authentication sources for Gnus and Emacs
   2
   3 ;; Copyright (C) 2008-2011 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 (require 'mm-util)
  44 (require 'gnus-util)
  45 (require 'assoc)
  46 (eval-when-compile (require 'cl))
  47 (eval-and-compile
  48   (or (ignore-errors (require 'eieio))
  49       ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
  50       (ignore-errors
  51         (let ((load-path (cons (expand-file-name
  52                                 "gnus-fallback-lib/eieio"
  53                                 (file-name-directory (locate-library "gnus")))
  54                                load-path)))
  55           (require 'eieio)))
  56       (error
  57        "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
  58
  59 (autoload 'secrets-create-item "secrets")
  60 (autoload 'secrets-delete-item "secrets")
  61 (autoload 'secrets-get-alias "secrets")
  62 (autoload 'secrets-get-attributes "secrets")
  63 (autoload 'secrets-get-secret "secrets")
  64 (autoload 'secrets-list-collections "secrets")
  65 (autoload 'secrets-search-items "secrets")
  66
  67 (defvar secrets-enabled)
  68
  69 (defgroup auth-source nil
  70   "Authentication sources."
  71   :version "23.1" ;; No Gnus
  72   :group 'gnus)
  73
  74 ;;;###autoload
  75 (defcustom auth-source-cache-expiry 7200
  76   "How many seconds passwords are cached, or nil to disable
  77 expiring.  Overrides `password-cache-expiry' through a
  78 let-binding."
  79   :group 'auth-source
  80   :type '(choice (const :tag "Never" nil)
  81                  (const :tag "All Day" 86400)
  82                  (const :tag "2 Hours" 7200)
  83                  (const :tag "30 Minutes" 1800)
  84                  (integer :tag "Seconds")))
  85
  86 (defclass auth-source-backend ()
  87   ((type :initarg :type
  88          :initform 'netrc
  89          :type symbol
  90          :custom symbol
  91          :documentation "The backend type.")
  92    (source :initarg :source
  93            :type string
  94            :custom string
  95            :documentation "The backend source.")
  96    (host :initarg :host
  97          :initform t
  98          :type t
  99          :custom string
 100          :documentation "The backend host.")
 101    (user :initarg :user
 102          :initform t
 103          :type t
 104          :custom string
 105          :documentation "The backend user.")
 106    (port :initarg :port
 107          :initform t
 108          :type t
 109          :custom string
 110          :documentation "The backend protocol.")
 111    (create-function :initarg :create-function
 112                     :initform ignore
 113                     :type function
 114                     :custom function
 115                     :documentation "The create function.")
 116    (search-function :initarg :search-function
 117                     :initform ignore
 118                     :type function
 119                     :custom function
 120                     :documentation "The search function.")))
 121
 122 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
 123                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
 124                                    (ssh  "ssh" "22")
 125                                    (sftp "sftp" "115")
 126                                    (smtp "smtp" "25"))
 127   "List of authentication protocols and their names"
 128
 129   :group 'auth-source
 130   :version "23.2" ;; No Gnus
 131   :type '(repeat :tag "Authentication Protocols"
 132                  (cons :tag "Protocol Entry"
 133                        (symbol :tag "Protocol")
 134                        (repeat :tag "Names"
 135                                (string :tag "Name")))))
 136
 137 ;;; generate all the protocols in a format Customize can use
 138 ;;; TODO: generate on the fly from auth-source-protocols
 139 (defconst auth-source-protocols-customize
 140   (mapcar (lambda (a)
 141             (let ((p (car-safe a)))
 142               (list 'const
 143                     :tag (upcase (symbol-name p))
 144                     p)))
 145           auth-source-protocols))
 146
 147 (defvar auth-source-creation-defaults nil
 148   "Defaults for creating token values.  Usually let-bound.")
 149
 150 (defvar auth-source-creation-prompts nil
 151   "Default prompts for token values.  Usually let-bound.")
 152
 153 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 154
 155 (defvar auth-source-magic "auth-source-magic ")
 156
 157 (defcustom auth-source-do-cache t
 158   "Whether auth-source should cache information with `password-cache'."
 159   :group 'auth-source
 160   :version "23.2" ;; No Gnus
 161   :type `boolean)
 162
 163 (defcustom auth-source-debug nil
 164   "Whether auth-source should log debug messages.
 165
 166 If the value is nil, debug messages are not logged.
 167
 168 If the value is t, debug messages are logged with `message'.  In
 169 that case, your authentication data will be in the clear (except
 170 for passwords).
 171
 172 If the value is a function, debug messages are logged by calling
 173  that function using the same arguments as `message'."
 174   :group 'auth-source
 175   :version "23.2" ;; No Gnus
 176   :type `(choice
 177           :tag "auth-source debugging mode"
 178           (const :tag "Log using `message' to the *Messages* buffer" t)
 179           (const :tag "Log all trivia with `message' to the *Messages* buffer"
 180                  trivia)
 181           (function :tag "Function that takes arguments like `message'")
 182           (const :tag "Don't log anything" nil)))
 183
 184 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
 185   "List of authentication sources.
 186
 187 The default will get login and password information from
 188 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
 189 packages to be encrypted.  If that file doesn't exist, it will
 190 try the unencrypted version \"~/.authinfo\" and the famous
 191 \"~/.netrc\" file.
 192
 193 See the auth.info manual for details.
 194
 195 Each entry is the authentication type with optional properties.
 196
 197 It's best to customize this with `M-x customize-variable' because the choices
 198 can get pretty complex."
 199   :group 'auth-source
 200   :version "24.1" ;; No Gnus
 201   :type `(repeat :tag "Authentication Sources"
 202                  (choice
 203                   (string :tag "Just a file")
 204                   (const :tag "Default Secrets API Collection" 'default)
 205                   (const :tag "Login Secrets API Collection" "secrets:Login")
 206                   (const :tag "Temp Secrets API Collection" "secrets:session")
 207                   (list :tag "Source definition"
 208                         (const :format "" :value :source)
 209                         (choice :tag "Authentication backend choice"
 210                                 (string :tag "Authentication Source (file)")
 211                                 (list
 212                                  :tag "Secret Service API/KWallet/GNOME Keyring"
 213                                  (const :format "" :value :secrets)
 214                                  (choice :tag "Collection to use"
 215                                          (string :tag "Collection name")
 216                                          (const :tag "Default" 'default)
 217                                          (const :tag "Login" "Login")
 218                                          (const
 219                                           :tag "Temporary" "session"))))
 220                         (repeat :tag "Extra Parameters" :inline t
 221                                 (choice :tag "Extra parameter"
 222                                         (list
 223                                          :tag "Host"
 224                                          (const :format "" :value :host)
 225                                          (choice :tag "Host (machine) choice"
 226                                                  (const :tag "Any" t)
 227                                                  (regexp
 228                                                   :tag "Regular expression")))
 229                                         (list
 230                                          :tag "Protocol"
 231                                          (const :format "" :value :port)
 232                                          (choice
 233                                           :tag "Protocol"
 234                                           (const :tag "Any" t)
 235                                           ,@auth-source-protocols-customize))
 236                                         (list :tag "User" :inline t
 237                                               (const :format "" :value :user)
 238                                               (choice :tag "Personality/Username"
 239                                                       (const :tag "Any" t)
 240                                                       (string :tag "Name")))))))))
 241
 242 (defcustom auth-source-gpg-encrypt-to t
 243   "List of recipient keys that `authinfo.gpg' encrypted to.
 244 If the value is not a list, symmetric encryption will be used."
 245   :group 'auth-source
 246   :version "24.1" ;; No Gnus
 247   :type '(choice (const :tag "Symmetric encryption" t)
 248                  (repeat :tag "Recipient public keys"
 249                          (string :tag "Recipient public key"))))
 250
 251 ;; temp for debugging
 252 ;; (unintern 'auth-source-protocols)
 253 ;; (unintern 'auth-sources)
 254 ;; (customize-variable 'auth-sources)
 255 ;; (setq auth-sources nil)
 256 ;; (format "%S" auth-sources)
 257 ;; (customize-variable 'auth-source-protocols)
 258 ;; (setq auth-source-protocols nil)
 259 ;; (format "%S" auth-source-protocols)
 260 ;; (auth-source-pick nil :host "a" :port 'imap)
 261 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 262 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 263 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 264 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 265 ;; (auth-source-protocol-defaults 'imap)
 266
 267 ;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
 268 ;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
 269 ;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
 270 (defun auth-source-do-debug (&rest msg)
 271   (when auth-source-debug
 272     (apply 'auth-source-do-warn msg)))
 273
 274 (defun auth-source-do-trivia (&rest msg)
 275   (when (or (eq auth-source-debug 'trivia)
 276             (functionp auth-source-debug))
 277     (apply 'auth-source-do-warn msg)))
 278
 279 (defun auth-source-do-warn (&rest msg)
 280   (apply
 281     ;; set logger to either the function in auth-source-debug or 'message
 282     ;; note that it will be 'message if auth-source-debug is nil
 283    (if (functionp auth-source-debug)
 284        auth-source-debug
 285      'message)
 286    msg))
 287
 288
 289 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 290 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 291 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 292 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 293 ;;                   (:source (:secrets "Login") :host t :port t)
 294 ;;                   (:source "~/.authinfo.gpg" :host t :port t)))
 295
 296 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 297 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 298 ;;                   (:source (:secrets "Login") :host t :port t)
 299 ;;                   ))
 300
 301 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
 302
 303 ;; (auth-source-backend-parse "myfile.gpg")
 304 ;; (auth-source-backend-parse 'default)
 305 ;; (auth-source-backend-parse "secrets:Login")
 306
 307 (defun auth-source-backend-parse (entry)
 308   "Creates an auth-source-backend from an ENTRY in `auth-sources'."
 309   (auth-source-backend-parse-parameters
 310    entry
 311    (cond
 312     ;; take 'default and recurse to get it as a Secrets API default collection
 313     ;; matching any user, host, and protocol
 314     ((eq entry 'default)
 315      (auth-source-backend-parse '(:source (:secrets default))))
 316     ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
 317     ;; matching any user, host, and protocol
 318     ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
 319      (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
 320     ;; take just a file name and recurse to get it as a netrc file
 321     ;; matching any user, host, and protocol
 322     ((stringp entry)
 323      (auth-source-backend-parse `(:source ,entry)))
 324
 325     ;; a file name with parameters
 326     ((stringp (plist-get entry :source))
 327      (auth-source-backend
 328       (plist-get entry :source)
 329       :source (plist-get entry :source)
 330       :type 'netrc
 331       :search-function 'auth-source-netrc-search
 332       :create-function 'auth-source-netrc-create))
 333
 334     ;; the Secrets API.  We require the package, in order to have a
 335     ;; defined value for `secrets-enabled'.
 336     ((and
 337       (not (null (plist-get entry :source))) ; the source must not be nil
 338       (listp (plist-get entry :source))      ; and it must be a list
 339       (require 'secrets nil t)               ; and we must load the Secrets API
 340       secrets-enabled)                       ; and that API must be enabled
 341
 342      ;; the source is either the :secrets key in ENTRY or
 343      ;; if that's missing or nil, it's "session"
 344      (let ((source (or (plist-get (plist-get entry :source) :secrets)
 345                        "session")))
 346
 347        ;; if the source is a symbol, we look for the alias named so,
 348        ;; and if that alias is missing, we use "Login"
 349        (when (symbolp source)
 350          (setq source (or (secrets-get-alias (symbol-name source))
 351                           "Login")))
 352
 353        (if (featurep 'secrets)
 354            (auth-source-backend
 355             (format "Secrets API (%s)" source)
 356             :source source
 357             :type 'secrets
 358             :search-function 'auth-source-secrets-search
 359             :create-function 'auth-source-secrets-create)
 360          (auth-source-do-warn
 361           "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
 362          (auth-source-backend
 363           (format "Ignored Secrets API (%s)" source)
 364           :source ""
 365           :type 'ignore))))
 366
 367     ;; none of them
 368     (t
 369      (auth-source-do-warn
 370       "auth-source-backend-parse: invalid backend spec: %S" entry)
 371      (auth-source-backend
 372       "Empty"
 373       :source ""
 374       :type 'ignore)))))
 375
 376 (defun auth-source-backend-parse-parameters (entry backend)
 377   "Fills in the extra auth-source-backend parameters of ENTRY.
 378 Using the plist ENTRY, get the :host, :port, and :user search
 379 parameters."
 380   (let ((entry (if (stringp entry)
 381                    nil
 382                  entry))
 383         val)
 384     (when (setq val (plist-get entry :host))
 385       (oset backend host val))
 386     (when (setq val (plist-get entry :user))
 387       (oset backend user val))
 388     (when (setq val (plist-get entry :port))
 389       (oset backend port val)))
 390   backend)
 391
 392 ;; (mapcar 'auth-source-backend-parse auth-sources)
 393
 394 (defun* auth-source-search (&rest spec
 395                                   &key type max host user port secret
 396                                   create delete
 397                                   &allow-other-keys)
 398   "Search or modify authentication backends according to SPEC.
 399
 400 This function parses `auth-sources' for matches of the SPEC
 401 plist.  It can optionally create or update an authentication
 402 token if requested.  A token is just a standard Emacs property
 403 list with a :secret property that can be a function; all the
 404 other properties will always hold scalar values.
 405
 406 Typically the :secret property, if present, contains a password.
 407
 408 Common search keys are :max, :host, :port, and :user.  In
 409 addition, :create specifies how tokens will be or created.
 410 Finally, :type can specify which backend types you want to check.
 411
 412 A string value is always matched literally.  A symbol is matched
 413 as its string value, literally.  All the SPEC values can be
 414 single values (symbol or string) or lists thereof (in which case
 415 any of the search terms matches).
 416
 417 :create t means to create a token if possible.
 418
 419 A new token will be created if no matching tokens were found.
 420 The new token will have only the keys the backend requires.  For
 421 the netrc backend, for instance, that's the user, host, and
 422 port keys.
 423
 424 Here's an example:
 425
 426 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 427                                         (A    . \"default A\"))))
 428   (auth-source-search :host \"mine\" :type 'netrc :max 1
 429                       :P \"pppp\" :Q \"qqqq\"
 430                       :create t))
 431
 432 which says:
 433
 434 \"Search for any entry matching host 'mine' in backends of type
 435  'netrc', maximum one result.
 436
 437  Create a new entry if you found none.  The netrc backend will
 438  automatically require host, user, and port.  The host will be
 439  'mine'.  We prompt for the user with default 'defaultUser' and
 440  for the port without a default.  We will not prompt for A, Q,
 441  or P.  The resulting token will only have keys user, host, and
 442  port.\"
 443
 444 :create '(A B C) also means to create a token if possible.
 445
 446 The behavior is like :create t but if the list contains any
 447 parameter, that parameter will be required in the resulting
 448 token.  The value for that parameter will be obtained from the
 449 search parameters or from user input.  If any queries are needed,
 450 the alist `auth-source-creation-defaults' will be checked for the
 451 default value.  If the user, host, or port are missing, the alist
 452 `auth-source-creation-prompts' will be used to look up the
 453 prompts IN THAT ORDER (so the 'user prompt will be queried first,
 454 then 'host, then 'port, and finally 'secret).  Each prompt string
 455 can use %u, %h, and %p to show the user, host, and port.
 456
 457 Here's an example:
 458
 459 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 460                                         (A    . \"default A\")))
 461        (auth-source-creation-prompts
 462         '((password . \"Enter IMAP password for %h:%p: \"))))
 463   (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
 464                       :P \"pppp\" :Q \"qqqq\"
 465                       :create '(A B Q)))
 466
 467 which says:
 468
 469 \"Search for any entry matching host 'nonesuch'
 470  or 'twosuch' in backends of type 'netrc', maximum one result.
 471
 472  Create a new entry if you found none.  The netrc backend will
 473  automatically require host, user, and port.  The host will be
 474  'nonesuch' and Q will be 'qqqq'.  We prompt for the password
 475  with the shown prompt.  We will not prompt for Q.  The resulting
 476  token will have keys user, host, port, A, B, and Q.  It will not
 477  have P with any value, even though P is used in the search to
 478  find only entries that have P set to 'pppp'.\"
 479
 480 When multiple values are specified in the search parameter, the
 481 user is prompted for which one.  So :host (X Y Z) would ask the
 482 user to choose between X, Y, and Z.
 483
 484 This creation can fail if the search was not specific enough to
 485 create a new token (it's up to the backend to decide that).  You
 486 should `catch' the backend-specific error as usual.  Some
 487 backends (netrc, at least) will prompt the user rather than throw
 488 an error.
 489
 490 :delete t means to delete any found entries.  nil by default.
 491 Use `auth-source-delete' in ELisp code instead of calling
 492 `auth-source-search' directly with this parameter.
 493
 494 :type (X Y Z) will check only those backend types.  'netrc and
 495 'secrets are the only ones supported right now.
 496
 497 :max N means to try to return at most N items (defaults to 1).
 498 When 0 the function will return just t or nil to indicate if any
 499 matches were found.  More than N items may be returned, depending
 500 on the search and the backend.
 501
 502 :host (X Y Z) means to match only hosts X, Y, or Z according to
 503 the match rules above.  Defaults to t.
 504
 505 :user (X Y Z) means to match only users X, Y, or Z according to
 506 the match rules above.  Defaults to t.
 507
 508 :port (P Q R) means to match only protocols P, Q, or R.
 509 Defaults to t.
 510
 511 :K (V1 V2 V3) for any other key K will match values V1, V2, or
 512 V3 (note the match rules above).
 513
 514 The return value is a list with at most :max tokens.  Each token
 515 is a plist with keys :backend :host :port :user, plus any other
 516 keys provided by the backend (notably :secret).  But note the
 517 exception for :max 0, which see above.
 518
 519 The token's :secret key can hold a function.  In that case you
 520 must call it to obtain the actual value."
 521   (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
 522          (max (or max 1))
 523          (ignored-keys '(:create :delete :max))
 524          (keys (loop for i below (length spec) by 2
 525                      unless (memq (nth i spec) ignored-keys)
 526                      collect (nth i spec)))
 527          (found (auth-source-recall spec))
 528          filtered-backends accessor-key backend)
 529
 530     (if (and found auth-source-do-cache)
 531         (auth-source-do-debug
 532          "auth-source-search: found %d CACHED results matching %S"
 533          (length found) spec)
 534
 535       (assert
 536        (or (eq t create) (listp create)) t
 537        "Invalid auth-source :create parameter (must be t or a list): %s %s")
 538
 539       (setq filtered-backends (copy-sequence backends))
 540       (dolist (backend backends)
 541         (dolist (key keys)
 542           ;; ignore invalid slots
 543           (condition-case signal
 544               (unless (eval `(auth-source-search-collection
 545                               (plist-get spec key)
 546                               (oref backend ,key)))
 547                 (setq filtered-backends (delq backend filtered-backends))
 548                 (return))
 549             (invalid-slot-name))))
 550
 551       (auth-source-do-trivia
 552        "auth-source-search: found %d backends matching %S"
 553        (length filtered-backends) spec)
 554
 555       ;; (debug spec "filtered" filtered-backends)
 556       ;; First go through all the backends without :create, so we can
 557       ;; query them all.
 558       (setq found (auth-source-search-backends filtered-backends
 559                                                spec
 560                                                ;; to exit early
 561                                                max
 562                                                ;; create and delete
 563                                                nil delete))
 564
 565       (auth-source-do-debug
 566        "auth-source-search: found %d results (max %d) matching %S"
 567        (length found) max spec)
 568
 569       ;; If we didn't find anything, then we allow the backend(s) to
 570       ;; create the entries.
 571       (when (and create
 572                  (not found))
 573         (setq found (auth-source-search-backends filtered-backends
 574                                                  spec
 575                                                  ;; to exit early
 576                                                  max
 577                                                  ;; create and delete
 578                                                  create delete))
 579         (auth-source-do-warn
 580          "auth-source-search: CREATED %d results (max %d) matching %S"
 581          (length found) max spec))
 582
 583       (when (and found auth-source-do-cache)
 584         (auth-source-remember spec found)))
 585
 586       found))
 587
 588 (defun auth-source-search-backends (backends spec max create delete)
 589   (let (matches)
 590     (dolist (backend backends)
 591       (when (> max (length matches))   ; when we need more matches...
 592         (let ((bmatches (apply
 593                          (slot-value backend 'search-function)
 594                          :backend backend
 595                          ;; note we're overriding whatever the spec
 596                          ;; has for :create and :delete
 597                          :create create
 598                          :delete delete
 599                          spec)))
 600           (when bmatches
 601             (auth-source-do-trivia
 602              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
 603              (length bmatches) max
 604              (slot-value backend :type)
 605              (slot-value backend :source)
 606              spec)
 607             (setq matches (append matches bmatches))))))
 608     matches))
 609
 610 ;;; (auth-source-search :max 1)
 611 ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
 612 ;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
 613 ;;; (auth-source-search :host "nonesuch" :type 'secrets)
 614
 615 (defun* auth-source-delete (&rest spec
 616                                   &key delete
 617                                   &allow-other-keys)
 618   "Delete entries from the authentication backends according to SPEC.
 619 Calls `auth-source-search' with the :delete property in SPEC set to t.
 620 The backend may not actually delete the entries.
 621
 622 Returns the deleted entries."
 623   (auth-source-search (plist-put spec :delete t)))
 624
 625 (defun auth-source-search-collection (collection value)
 626   "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
 627   (when (and (atom collection) (not (eq t collection)))
 628     (setq collection (list collection)))
 629
 630   ;; (debug :collection collection :value value)
 631   (or (eq collection t)
 632       (eq value t)
 633       (equal collection value)
 634       (member value collection)))
 635
 636 (defun auth-source-forget-all-cached ()
 637   "Forget all cached auth-source data."
 638   (interactive)
 639   (loop for sym being the symbols of password-data
 640         ;; when the symbol name starts with auth-source-magic
 641         when (string-match (concat "^" auth-source-magic)
 642                            (symbol-name sym))
 643         ;; remove that key
 644         do (password-cache-remove (symbol-name sym))))
 645
 646 (defun auth-source-remember (spec found)
 647   "Remember FOUND search results for SPEC."
 648   (let ((password-cache-expiry auth-source-cache-expiry))
 649     (password-cache-add
 650      (concat auth-source-magic (format "%S" spec)) found)))
 651
 652 (defun auth-source-recall (spec)
 653   "Recall FOUND search results for SPEC."
 654   (password-read-from-cache
 655    (concat auth-source-magic (format "%S" spec))))
 656
 657 (defun auth-source-forget (spec)
 658   "Forget any cached data matching SPEC exactly.
 659
 660 This is the same SPEC you passed to `auth-source-search'.
 661 Returns t or nil for forgotten or not found."
 662   (password-cache-remove (concat auth-source-magic (format "%S" spec))))
 663
 664 ;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
 665
 666 ;;; (auth-source-remember '(:host "wedd") '(4 5 6))
 667 ;;; (auth-source-remember '(:host "xedd") '(1 2 3))
 668 ;;; (auth-source-recall '(:host "xedd"))
 669 ;;; (auth-source-recall '(:host t))
 670 ;;; (auth-source-forget+ :host t)
 671
 672 (defun* auth-source-forget+ (&rest spec &allow-other-keys)
 673   "Forget any cached data matching SPEC.  Returns forgotten count.
 674
 675 This is not a full `auth-source-search' spec but works similarly.
 676 For instance, \(:host \"myhost\" \"yourhost\") would find all the
 677 cached data that was found with a search for those two hosts,
 678 while \(:host t) would find all host entries."
 679   (let ((count 0)
 680         sname)
 681     (loop for sym being the symbols of password-data
 682           ;; when the symbol name matches with auth-source-magic
 683           when (and (setq sname (symbol-name sym))
 684                     (string-match (concat "^" auth-source-magic "\\(.+\\)")
 685                                   sname)
 686                     ;; and the spec matches what was stored in the cache
 687                     (auth-source-specmatchp spec (read (match-string 1 sname))))
 688           ;; remove that key
 689           do (progn
 690                (password-cache-remove sname)
 691                (incf count)))
 692     count))
 693
 694 (defun auth-source-specmatchp (spec stored)
 695   (let ((keys (loop for i below (length spec) by 2
 696                    collect (nth i spec))))
 697     (not (eq
 698           (dolist (key keys)
 699             (unless (auth-source-search-collection (plist-get stored key)
 700                                                    (plist-get spec key))
 701               (return 'no)))
 702           'no))))
 703
 704 ;;; Backend specific parsing: netrc/authinfo backend
 705
 706 (defun auth-source-ensure-strings (values)
 707   (unless (listp values)
 708     (setq values (list values)))
 709   (mapcar (lambda (value)
 710             (if (numberp value)
 711                 (format "%s" value)
 712               value))
 713           values))
 714
 715 (defvar auth-source-netrc-cache nil)
 716
 717 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
 718 (defun* auth-source-netrc-parse (&rest
 719                                  spec
 720                                  &key file max host user port delete
 721                                  &allow-other-keys)
 722   "Parse FILE and return a list of all entries in the file.
 723 Note that the MAX parameter is used so we can exit the parse early."
 724   (if (listp file)
 725       ;; We got already parsed contents; just return it.
 726       file
 727     (when (file-exists-p file)
 728       (setq port (auth-source-ensure-strings port))
 729       (with-temp-buffer
 730         (let* ((tokens '("machine" "host" "default" "login" "user"
 731                          "password" "account" "macdef" "force"
 732                          "port" "protocol"))
 733                (max (or max 5000))       ; sanity check: default to stop at 5K
 734                (modified 0)
 735                (cached (cdr-safe (assoc file auth-source-netrc-cache)))
 736                (cached-mtime (plist-get cached :mtime))
 737                (cached-secrets (plist-get cached :secret))
 738                alist elem result pair)
 739
 740           (if (and (functionp cached-secrets)
 741                    (equal cached-mtime
 742                           (nth 5 (file-attributes file))))
 743               (progn
 744                 (auth-source-do-trivia
 745                  "auth-source-netrc-parse: using CACHED file data for %s"
 746                  file)
 747                 (insert (funcall cached-secrets)))
 748             (insert-file-contents file)
 749             ;; cache all netrc files (used to be just .gpg files)
 750             ;; Store the contents of the file heavily encrypted in memory.
 751             ;; (note for the irony-impaired: they are just obfuscated)
 752             (aput 'auth-source-netrc-cache file
 753                   (list :mtime (nth 5 (file-attributes file))
 754                         :secret (lexical-let ((v (rot13-string
 755                                                   (base64-encode-string
 756                                                    (buffer-string)))))
 757                                   (lambda () (base64-decode-string
 758                                          (rot13-string v)))))))
 759           (goto-char (point-min))
 760           ;; Go through the file, line by line.
 761           (while (and (not (eobp))
 762                       (> max 0))
 763
 764             (narrow-to-region (point) (point-at-eol))
 765             ;; For each line, get the tokens and values.
 766             (while (not (eobp))
 767               (skip-chars-forward "\t ")
 768               ;; Skip lines that begin with a "#".
 769               (if (eq (char-after) ?#)
 770                   (goto-char (point-max))
 771                 (unless (eobp)
 772                   (setq elem
 773                         (if (= (following-char) ?\")
 774                             (read (current-buffer))
 775                           (buffer-substring
 776                            (point) (progn (skip-chars-forward "^\t ")
 777                                           (point)))))
 778                   (cond
 779                    ((equal elem "macdef")
 780                     ;; We skip past the macro definition.
 781                     (widen)
 782                     (while (and (zerop (forward-line 1))
 783                                 (looking-at "$")))
 784                     (narrow-to-region (point) (point)))
 785                    ((member elem tokens)
 786                     ;; Tokens that don't have a following value are ignored,
 787                     ;; except "default".
 788                     (when (and pair (or (cdr pair)
 789                                         (equal (car pair) "default")))
 790                       (push pair alist))
 791                     (setq pair (list elem)))
 792                    (t
 793                     ;; Values that haven't got a preceding token are ignored.
 794                     (when pair
 795                       (setcdr pair elem)
 796                       (push pair alist)
 797                       (setq pair nil)))))))
 798
 799             (when (and alist
 800                        (> max 0)
 801                        (auth-source-search-collection
 802                         host
 803                         (or
 804                          (aget alist "machine")
 805                          (aget alist "host")
 806                          t))
 807                        (auth-source-search-collection
 808                         user
 809                         (or
 810                          (aget alist "login")
 811                          (aget alist "account")
 812                          (aget alist "user")
 813                          t))
 814                        (auth-source-search-collection
 815                         port
 816                         (or
 817                          (aget alist "port")
 818                          (aget alist "protocol")
 819                          t)))
 820               (decf max)
 821               (push (nreverse alist) result)
 822               ;; to delete a line, we just comment it out
 823               (when delete
 824                 (goto-char (point-min))
 825                 (insert "#")
 826                 (incf modified)))
 827             (setq alist nil
 828                   pair nil)
 829             (widen)
 830             (forward-line 1))
 831
 832           (when (< 0 modified)
 833             (when auth-source-gpg-encrypt-to
 834               ;; (see bug#7487) making `epa-file-encrypt-to' local to
 835               ;; this buffer lets epa-file skip the key selection query
 836               ;; (see the `local-variable-p' check in
 837               ;; `epa-file-write-region').
 838               (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
 839                 (make-local-variable 'epa-file-encrypt-to))
 840               (if (listp auth-source-gpg-encrypt-to)
 841                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
 842
 843             ;; ask AFTER we've successfully opened the file
 844             (when (y-or-n-p (format "Save file %s? (%d modifications)"
 845                                     file modified))
 846               (write-region (point-min) (point-max) file nil 'silent)
 847               (auth-source-do-debug
 848                "auth-source-netrc-parse: modified %d lines in %s"
 849                modified file)))
 850
 851           (nreverse result))))))
 852
 853 (defun auth-source-netrc-normalize (alist)
 854   (mapcar (lambda (entry)
 855             (let (ret item)
 856               (while (setq item (pop entry))
 857                 (let ((k (car item))
 858                       (v (cdr item)))
 859
 860                   ;; apply key aliases
 861                   (setq k (cond ((member k '("machine")) "host")
 862                                 ((member k '("login" "account")) "user")
 863                                 ((member k '("protocol")) "port")
 864                                 ((member k '("password")) "secret")
 865                                 (t k)))
 866
 867                   ;; send back the secret in a function (lexical binding)
 868                   (when (equal k "secret")
 869                     (setq v (lexical-let ((v v))
 870                               (lambda () v))))
 871
 872                   (setq ret (plist-put ret
 873                                        (intern (concat ":" k))
 874                                        v))
 875                   ))
 876               ret))
 877           alist))
 878
 879 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
 880 ;;; (funcall secret)
 881
 882 (defun* auth-source-netrc-search (&rest
 883                                   spec
 884                                   &key backend create delete
 885                                   type max host user port
 886                                   &allow-other-keys)
 887 "Given a property list SPEC, return search matches from the :backend.
 888 See `auth-source-search' for details on SPEC."
 889   ;; just in case, check that the type is correct (null or same as the backend)
 890   (assert (or (null type) (eq type (oref backend type)))
 891           t "Invalid netrc search: %s %s")
 892
 893   (let ((results (auth-source-netrc-normalize
 894                   (auth-source-netrc-parse
 895                    :max max
 896                    :delete delete
 897                    :file (oref backend source)
 898                    :host (or host t)
 899                    :user (or user t)
 900                    :port (or port t)))))
 901
 902     ;; if we need to create an entry AND none were found to match
 903     (when (and create
 904                (not results))
 905
 906       ;; create based on the spec and record the value
 907       (setq results (or
 908                      ;; if the user did not want to create the entry
 909                      ;; in the file, it will be returned
 910                      (apply (slot-value backend 'create-function) spec)
 911                      ;; if not, we do the search again without :create
 912                      ;; to get the updated data.
 913
 914                      ;; the result will be returned, even if the search fails
 915                      (apply 'auth-source-netrc-search
 916                             (plist-put spec :create nil)))))
 917     results))
 918
 919 (defun auth-source-netrc-element-or-first (v)
 920   (if (listp v)
 921       (nth 0 v)
 922     v))
 923
 924 ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
 925
 926 (defun auth-source-format-prompt (prompt alist)
 927   "Format PROMPT using %x (for any character x) specifiers in ALIST."
 928   (dolist (cell alist)
 929     (let ((c (nth 0 cell))
 930           (v (nth 1 cell)))
 931       (when (and c v)
 932         (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
 933   prompt)
 934
 935 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
 936 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
 937
 938 (defun* auth-source-netrc-create (&rest spec
 939                                         &key backend
 940                                         secret host user port create
 941                                         &allow-other-keys)
 942   (let* ((base-required '(host user port secret))
 943          ;; we know (because of an assertion in auth-source-search) that the
 944          ;; :create parameter is either t or a list (which includes nil)
 945          (create-extra (if (eq t create) nil create))
 946          (required (append base-required create-extra))
 947          (file (oref backend source))
 948          (add "")
 949          ;; `valist' is an alist
 950          valist
 951          ;; `artificial' will be returned if no creation is needed
 952          artificial)
 953
 954     ;; only for base required elements (defined as function parameters):
 955     ;; fill in the valist with whatever data we may have from the search
 956     ;; we complete the first value if it's a list and use the value otherwise
 957     (dolist (br base-required)
 958       (when (symbol-value br)
 959         (let ((br-choice (cond
 960                           ;; all-accepting choice (predicate is t)
 961                           ((eq t (symbol-value br)) nil)
 962                           ;; just the value otherwise
 963                           (t (symbol-value br)))))
 964           (when br-choice
 965             (aput 'valist br br-choice)))))
 966
 967     ;; for extra required elements, see if the spec includes a value for them
 968     (dolist (er create-extra)
 969       (let ((name (concat ":" (symbol-name er)))
 970             (keys (loop for i below (length spec) by 2
 971                         collect (nth i spec))))
 972         (dolist (k keys)
 973           (when (equal (symbol-name k) name)
 974             (aput 'valist er (plist-get spec k))))))
 975
 976     ;; for each required element
 977     (dolist (r required)
 978       (let* ((data (aget valist r))
 979              ;; take the first element if the data is a list
 980              (data (auth-source-netrc-element-or-first data))
 981              ;; this is the default to be offered
 982              (given-default (aget auth-source-creation-defaults r))
 983              ;; the default supplementals are simple: for the user,
 984              ;; try (user-login-name), otherwise take given-default
 985              (default (cond
 986                        ;; don't default the user name
 987                        ;; ((and (not given-default) (eq r 'user))
 988                        ;;  (user-login-name))
 989                        (t given-default)))
 990              (printable-defaults (list
 991                                   (cons 'user
 992                                         (or
 993                                          (auth-source-netrc-element-or-first
 994                                           (aget valist 'user))
 995                                          (plist-get artificial :user)
 996                                          "[any user]"))
 997                                   (cons 'host
 998                                         (or
 999                                          (auth-source-netrc-element-or-first
1000                                           (aget valist 'host))
1001                                          (plist-get artificial :host)
1002                                          "[any host]"))
1003                                   (cons 'port
1004                                         (or
1005                                          (auth-source-netrc-element-or-first
1006                                           (aget valist 'port))
1007                                          (plist-get artificial :port)
1008                                          "[any port]"))))
1009              (prompt (or (aget auth-source-creation-prompts r)
1010                          (case r
1011                            ('secret "%p password for user %u, host %h: ")
1012                            ('user "%p user name: ")
1013                            ('host "%p host name for user %u: ")
1014                            ('port "%p port for user %u and host %h: "))
1015                          (format "Enter %s (%%u@%%h:%%p): " r)))
1016              (prompt (auth-source-format-prompt
1017                       prompt
1018                       `((?u ,(aget printable-defaults 'user))
1019                         (?h ,(aget printable-defaults 'host))
1020                         (?p ,(aget printable-defaults 'port))))))
1021
1022         ;; store the data, prompting for the password if needed
1023         (setq data
1024               (cond
1025                ((and (null data) (eq r 'secret))
1026                 ;; special case prompt for passwords
1027                 (read-passwd prompt))
1028                ((null data)
1029                 (read-string prompt default))
1030                (t (or data default))))
1031
1032         (when data
1033           (setq artificial (plist-put artificial
1034                                       (intern (concat ":" (symbol-name r)))
1035                                       (if (eq r 'secret)
1036                                           (lexical-let ((data data))
1037                                             (lambda () data))
1038                                         data))))
1039
1040         ;; when r is not an empty string...
1041         (when (and (stringp data)
1042                    (< 0 (length data)))
1043           ;; this function is not strictly necessary but I think it
1044           ;; makes the code clearer -tzz
1045           (let ((printer (lambda ()
1046                            ;; append the key (the symbol name of r)
1047                            ;; and the value in r
1048                            (format "%s%s %S"
1049                                    ;; prepend a space
1050                                    (if (zerop (length add)) "" " ")
1051                                    ;; remap auth-source tokens to netrc
1052                                    (case r
1053                                      ('user   "login")
1054                                      ('host   "machine")
1055                                      ('secret "password")
1056                                      ('port   "port") ; redundant but clearer
1057                                      (t (symbol-name r)))
1058                                    ;; the value will be printed in %S format
1059                                    data))))
1060             (setq add (concat add (funcall printer)))))))
1061
1062     (with-temp-buffer
1063       (when (file-exists-p file)
1064         (insert-file-contents file))
1065       (when auth-source-gpg-encrypt-to
1066         ;; (see bug#7487) making `epa-file-encrypt-to' local to
1067         ;; this buffer lets epa-file skip the key selection query
1068         ;; (see the `local-variable-p' check in
1069         ;; `epa-file-write-region').
1070         (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1071           (make-local-variable 'epa-file-encrypt-to))
1072         (if (listp auth-source-gpg-encrypt-to)
1073             (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1074       (goto-char (point-max))
1075
1076       ;; ask AFTER we've successfully opened the file
1077       (let ((prompt (format "Add to file %s? %s: "
1078                             file
1079                             "(y)es/(n)o but use it/(e)dit line/(s)kip file"))
1080             done k)
1081         (while (not done)
1082           (setq k (read-char prompt))
1083           (case k
1084             (?y (setq done t))
1085             (?n (setq add ""
1086                       done t))
1087             (?s (setq add ""
1088                       done 'skip))
1089             (?e (setq add (read-string "Line to add: " add)))
1090             (t nil)))
1091
1092         (when (< 0 (length add))
1093           (progn
1094             (unless (bolp)
1095               (insert "\n"))
1096             (insert add "\n")
1097             (write-region (point-min) (point-max) file nil 'silent)
1098             (auth-source-do-warn
1099              "auth-source-netrc-create: wrote 1 new line to %s"
1100              file)
1101             nil))
1102
1103         (when (eq done t)
1104           (list artificial))))))
1105
1106 ;;; Backend specific parsing: Secrets API backend
1107
1108 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1109 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1110 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1111 ;;; (let ((auth-sources '(default))) (auth-source-search))
1112 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1113 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
1114
1115 (defun* auth-source-secrets-search (&rest
1116                                     spec
1117                                     &key backend create delete label
1118                                     type max host user port
1119                                     &allow-other-keys)
1120   "Search the Secrets API; spec is like `auth-source'.
1121
1122 The :label key specifies the item's label.  It is the only key
1123 that can specify a substring.  Any :label value besides a string
1124 will allow any label.
1125
1126 All other search keys must match exactly.  If you need substring
1127 matching, do a wider search and narrow it down yourself.
1128
1129 You'll get back all the properties of the token as a plist.
1130
1131 Here's an example that looks for the first item in the 'Login'
1132 Secrets collection:
1133
1134  \(let ((auth-sources '(\"secrets:Login\")))
1135     (auth-source-search :max 1)
1136
1137 Here's another that looks for the first item in the 'Login'
1138 Secrets collection whose label contains 'gnus':
1139
1140  \(let ((auth-sources '(\"secrets:Login\")))
1141     (auth-source-search :max 1 :label \"gnus\")
1142
1143 And this one looks for the first item in the 'Login' Secrets
1144 collection that's a Google Chrome entry for the git.gnus.org site
1145 authentication tokens:
1146
1147  \(let ((auth-sources '(\"secrets:Login\")))
1148     (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1149 "
1150
1151   ;; TODO
1152   (assert (not create) nil
1153           "The Secrets API auth-source backend doesn't support creation yet")
1154   ;; TODO
1155   ;; (secrets-delete-item coll elt)
1156   (assert (not delete) nil
1157           "The Secrets API auth-source backend doesn't support deletion yet")
1158
1159   (let* ((coll (oref backend source))
1160          (max (or max 5000))     ; sanity check: default to stop at 5K
1161          (ignored-keys '(:create :delete :max :backend :label))
1162          (search-keys (loop for i below (length spec) by 2
1163                             unless (memq (nth i spec) ignored-keys)
1164                             collect (nth i spec)))
1165          ;; build a search spec without the ignored keys
1166          ;; if a search key is nil or t (match anything), we skip it
1167          (search-spec (apply 'append (mapcar
1168                                       (lambda (k)
1169                                         (if (or (null (plist-get spec k))
1170                                                 (eq t (plist-get spec k)))
1171                                             nil
1172                                           (list k (plist-get spec k))))
1173                               search-keys)))
1174          ;; needed keys (always including host, login, port, and secret)
1175          (returned-keys (mm-delete-duplicates (append
1176                                                '(:host :login :port :secret)
1177                                                search-keys)))
1178          (items (loop for item in (apply 'secrets-search-items coll search-spec)
1179                       unless (and (stringp label)
1180                                   (not (string-match label item)))
1181                       collect item))
1182          ;; TODO: respect max in `secrets-search-items', not after the fact
1183          (items (butlast items (- (length items) max)))
1184          ;; convert the item name to a full plist
1185          (items (mapcar (lambda (item)
1186                           (append
1187                            ;; make an entry for the secret (password) element
1188                            (list
1189                             :secret
1190                             (lexical-let ((v (secrets-get-secret coll item)))
1191                               (lambda () v)))
1192                            ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1193                            (apply 'append
1194                                   (mapcar (lambda (entry)
1195                                             (list (car entry) (cdr entry)))
1196                                           (secrets-get-attributes coll item)))))
1197                         items))
1198          ;; ensure each item has each key in `returned-keys'
1199          (items (mapcar (lambda (plist)
1200                           (append
1201                            (apply 'append
1202                                   (mapcar (lambda (req)
1203                                             (if (plist-get plist req)
1204                                                 nil
1205                                               (list req nil)))
1206                                           returned-keys))
1207                            plist))
1208                         items)))
1209     items))
1210
1211 (defun* auth-source-secrets-create (&rest
1212                                     spec
1213                                     &key backend type max host user port
1214                                     &allow-other-keys)
1215   ;; TODO
1216   ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1217   (debug spec))
1218
1219 ;;; older API
1220
1221 ;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1222
1223 ;; deprecate the old interface
1224 (make-obsolete 'auth-source-user-or-password
1225                'auth-source-search "Emacs 24.1")
1226 (make-obsolete 'auth-source-forget-user-or-password
1227                'auth-source-forget "Emacs 24.1")
1228
1229 (defun auth-source-user-or-password
1230   (mode host port &optional username create-missing delete-existing)
1231   "Find MODE (string or list of strings) matching HOST and PORT.
1232
1233 DEPRECATED in favor of `auth-source-search'!
1234
1235 USERNAME is optional and will be used as \"login\" in a search
1236 across the Secret Service API (see secrets.el) if the resulting
1237 items don't have a username.  This means that if you search for
1238 username \"joe\" and it matches an item but the item doesn't have
1239 a :user attribute, the username \"joe\" will be returned.
1240
1241 A non nil DELETE-EXISTING means deleting any matching password
1242 entry in the respective sources.  This is useful only when
1243 CREATE-MISSING is non nil as well; the intended use case is to
1244 remove wrong password entries.
1245
1246 If no matching entry is found, and CREATE-MISSING is non nil,
1247 the password will be retrieved interactively, and it will be
1248 stored in the password database which matches best (see
1249 `auth-sources').
1250
1251 MODE can be \"login\" or \"password\"."
1252   (auth-source-do-debug
1253    "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
1254    mode host port username)
1255
1256   (let* ((listy (listp mode))
1257          (mode (if listy mode (list mode)))
1258          (cname (if username
1259                     (format "%s %s:%s %s" mode host port username)
1260                   (format "%s %s:%s" mode host port)))
1261          (search (list :host host :port port))
1262          (search (if username (append search (list :user username)) search))
1263          (search (if create-missing
1264                      (append search (list :create t))
1265                    search))
1266          (search (if delete-existing
1267                      (append search (list :delete t))
1268                    search))
1269          ;; (found (if (not delete-existing)
1270          ;;            (gethash cname auth-source-cache)
1271          ;;          (remhash cname auth-source-cache)
1272          ;;          nil)))
1273          (found nil))
1274     (if found
1275         (progn
1276           (auth-source-do-debug
1277            "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
1278            mode
1279            ;; don't show the password
1280            (if (and (member "password" mode) t)
1281                "SECRET"
1282              found)
1283            host port username)
1284           found)                        ; return the found data
1285       ;; else, if not found, search with a max of 1
1286       (let ((choice (nth 0 (apply 'auth-source-search
1287                                   (append '(:max 1) search)))))
1288         (when choice
1289           (dolist (m mode)
1290             (cond
1291              ((equal "password" m)
1292               (push (if (plist-get choice :secret)
1293                       (funcall (plist-get choice :secret))
1294                     nil) found))
1295              ((equal "login" m)
1296               (push (plist-get choice :user) found)))))
1297         (setq found (nreverse found))
1298         (setq found (if listy found (car-safe found)))))
1299
1300         found))
1301
1302 (provide 'auth-source)
1303
1304 ;;; auth-source.el ends here