auth-source.el 104 KB
Newer Older
1
;;; auth-source.el --- authentication sources for Gnus and Emacs -*- lexical-binding: t -*-
Miles Bader's avatar
Miles Bader committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
Miles Bader's avatar
Miles Bader committed
4 5 6 7 8 9

;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Miles Bader's avatar
Miles Bader committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Miles Bader's avatar
Miles Bader committed
14 15 16

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Miles Bader's avatar
Miles Bader committed
18 19 20
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Miles Bader's avatar
Miles Bader committed
22 23 24 25 26 27 28

;;; Commentary:

;; This is the auth-source.el package.  It lets users tell Gnus how to
;; authenticate in a single place.  Simplicity is the goal.  Instead
;; of providing 5000 options, we'll stick to simple, easy to
;; understand options.
Miles Bader's avatar
Miles Bader committed
29

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
30
;; See the auth.info Info documentation for details.
Miles Bader's avatar
Miles Bader committed
31

32 33 34 35 36 37 38 39
;; TODO:

;; - never decode the backend file unless it's necessary
;; - a more generic way to match backends and search backend contents
;; - absorb netrc.el and simplify it
;; - protect passwords better
;; - allow creating and changing netrc lines (not files) e.g. change a password

Miles Bader's avatar
Miles Bader committed
40 41
;;; Code:

42
(require 'json)
43
(require 'password-cache)
44

45
(require 'cl-lib)
Mark Oteiza's avatar
Mark Oteiza committed
46
(require 'eieio)
47

48 49
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
50
(autoload 'secrets-get-alias "secrets")
51
(autoload 'secrets-get-attributes "secrets")
52
(autoload 'secrets-get-secret "secrets")
53 54
(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
Miles Bader's avatar
Miles Bader committed
55

56 57
(autoload 'rfc2104-hash "rfc2104")

58 59 60
(autoload 'plstore-open "plstore")
(autoload 'plstore-find "plstore")
(autoload 'plstore-put "plstore")
Daiki Ueno's avatar
Daiki Ueno committed
61
(autoload 'plstore-delete "plstore")
62
(autoload 'plstore-save "plstore")
63
(autoload 'plstore-get-file "plstore")
64

65
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
66 67 68 69
(autoload 'epg-make-context "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-decrypt-string "epg")
(autoload 'epg-encrypt-string "epg")
70

71 72
(autoload 'help-mode "help-mode" nil t)

73 74
(defvar secrets-enabled)

Miles Bader's avatar
Miles Bader committed
75 76
(defgroup auth-source nil
  "Authentication sources."
Miles Bader's avatar
Miles Bader committed
77
  :version "23.1" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
78 79
  :group 'gnus)

80 81 82 83 84
;;;###autoload
(defcustom auth-source-cache-expiry 7200
  "How many seconds passwords are cached, or nil to disable
expiring.  Overrides `password-cache-expiry' through a
let-binding."
85
  :version "24.1"
86 87 88 89 90 91
  :type '(choice (const :tag "Never" nil)
                 (const :tag "All Day" 86400)
                 (const :tag "2 Hours" 7200)
                 (const :tag "30 Minutes" 1800)
                 (integer :tag "Seconds")))

92 93 94
;; The slots below correspond with the `auth-source-search' spec,
;; so a backend with :host set, for instance, would match only
;; searches for that host.  Normally they are nil.
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
(defclass auth-source-backend ()
  ((type :initarg :type
         :initform 'netrc
         :type symbol
         :custom symbol
         :documentation "The backend type.")
   (source :initarg :source
           :type string
           :custom string
           :documentation "The backend source.")
   (host :initarg :host
         :initform t
         :type t
         :custom string
         :documentation "The backend host.")
   (user :initarg :user
         :initform t
         :type t
         :custom string
         :documentation "The backend user.")
115 116 117 118 119
   (port :initarg :port
         :initform t
         :type t
         :custom string
         :documentation "The backend protocol.")
120
   (data :initarg :data
121 122
         :initform nil
         :documentation "Internal backend data.")
123 124 125 126 127 128 129 130 131 132 133
   (create-function :initarg :create-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The create function.")
   (search-function :initarg :search-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The search function.")))

Miles Bader's avatar
Miles Bader committed
134
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
135 136 137 138
                                   (pop3 "pop3" "pop" "pop3s" "110" "995")
                                   (ssh  "ssh" "22")
                                   (sftp "sftp" "115")
                                   (smtp "smtp" "25"))
139
  "List of authentication protocols and their names."
Miles Bader's avatar
Miles Bader committed
140

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
141
  :version "23.2" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
142
  :type '(repeat :tag "Authentication Protocols"
143 144 145 146
                 (cons :tag "Protocol Entry"
                       (symbol :tag "Protocol")
                       (repeat :tag "Names"
                               (string :tag "Name")))))
Miles Bader's avatar
Miles Bader committed
147

148 149
;; Generate all the protocols in a format Customize can use.
;; TODO: generate on the fly from auth-source-protocols
Miles Bader's avatar
Miles Bader committed
150 151
(defconst auth-source-protocols-customize
  (mapcar (lambda (a)
152 153 154 155 156
            (let ((p (car-safe a)))
              (list 'const
                    :tag (upcase (symbol-name p))
                    p)))
          auth-source-protocols))
Miles Bader's avatar
Miles Bader committed
157

158
(defvar auth-source-creation-defaults nil
159
  ;; FIXME: AFAICT this is not set (or let-bound) anywhere!
160 161
  "Defaults for creating token values.  Usually let-bound.")

162 163 164
(defvar auth-source-creation-prompts nil
  "Default prompts for token values.  Usually let-bound.")

165 166
(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")

167 168 169
(defcustom auth-source-save-behavior 'ask
  "If set, auth-source will respect it for save behavior."
  :version "23.2" ;; No Gnus
170
  :type '(choice
171 172 173 174 175
          :tag "auth-source new token save behavior"
          (const :tag "Always save" t)
          (const :tag "Never save" nil)
          (const :tag "Ask" ask)))

176
;; 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)))
177 178 179 180
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)

(defcustom auth-source-netrc-use-gpg-tokens 'never
  "Set this to tell auth-source when to create GPG password
181 182
tokens in netrc files.  It's either an alist or `never'.
Note that if EPA/EPG is not available, this should NOT be used."
183 184
  :version "23.2" ;; No Gnus
  :type `(choice
185 186 187 188 189 190 191 192
          (const :tag "Always use GPG password tokens" (t gpg))
          (const :tag "Never use GPG password tokens" never)
          (repeat :tag "Use a lookup list"
                  (list
                   (choice :tag "Matcher"
                           (const :tag "Match anything" t)
                           (const :tag "The EPA encrypted file extensions"
                                  ,(if (boundp 'epa-file-auto-mode-alist-entry)
193
                                       (car epa-file-auto-mode-alist-entry)
194 195 196 197 198
                                     "\\.gpg\\'"))
                           (regexp :tag "Regular expression"))
                   (choice :tag "What to do"
                           (const :tag "Save GPG-encrypted password tokens" gpg)
                           (const :tag "Don't encrypt tokens" never))))))
199

Miles Bader's avatar
Miles Bader committed
200
(defcustom auth-source-do-cache t
201
  "Whether auth-source should cache information with `password-cache'."
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
202
  :version "23.2" ;; No Gnus
203
  :type 'boolean)
Miles Bader's avatar
Miles Bader committed
204

205
(defcustom auth-source-debug nil
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
206 207 208
  "Whether auth-source should log debug messages.

If the value is nil, debug messages are not logged.
209 210 211 212 213

If the value is t, debug messages are logged with `message'.  In
that case, your authentication data will be in the clear (except
for passwords).

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
214 215
If the value is a function, debug messages are logged by calling
 that function using the same arguments as `message'."
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
216
  :version "23.2" ;; No Gnus
217
  :type '(choice
218 219
          :tag "auth-source debugging mode"
          (const :tag "Log using `message' to the *Messages* buffer" t)
220 221
          (const :tag "Log all trivia with `message' to the *Messages* buffer"
                 trivia)
222 223
          (function :tag "Function that takes arguments like `message'")
          (const :tag "Don't log anything" nil)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
224

225
(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
Miles Bader's avatar
Miles Bader committed
226
  "List of authentication sources.
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
227
Each entry is the authentication type with optional properties.
Glenn Morris's avatar
Glenn Morris committed
228 229
Entries are tried in the order in which they appear.
See Info node `(auth)Help for users' for details.
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
230

231 232 233 234 235
If an entry names a file with the \".gpg\" extension and you have
EPA/EPG set up, the file will be encrypted and decrypted
automatically.  See Info node `(epa)Encrypting/decrypting gpg files'
for details.

236
It's best to customize this with `\\[customize-variable]' because the choices
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
237
can get pretty complex."
238
  :version "26.1" ; neither new nor changed default
Miles Bader's avatar
Miles Bader committed
239
  :type `(repeat :tag "Authentication Sources"
240 241
                 (choice
                  (string :tag "Just a file")
Glenn Morris's avatar
Glenn Morris committed
242
                  (const :tag "Default Secrets API Collection" default)
243
                  (const :tag "Login Secrets API Collection" "secrets:Login")
244
                  (const :tag "Temp Secrets API Collection" "secrets:session")
245 246

                  (const :tag "Default internet Mac OS Keychain"
247
                         macos-keychain-internet)
248 249

                  (const :tag "Default generic Mac OS Keychain"
250
                         macos-keychain-generic)
251

252 253 254 255 256 257 258 259 260
                  (list :tag "Source definition"
                        (const :format "" :value :source)
                        (choice :tag "Authentication backend choice"
                                (string :tag "Authentication Source (file)")
                                (list
                                 :tag "Secret Service API/KWallet/GNOME Keyring"
                                 (const :format "" :value :secrets)
                                 (choice :tag "Collection to use"
                                         (string :tag "Collection name")
Glenn Morris's avatar
Glenn Morris committed
261
                                         (const :tag "Default" default)
262
                                         (const :tag "Login" "Login")
263
                                         (const
264 265 266 267 268 269 270
                                          :tag "Temporary" "session")))
                                (list
                                 :tag "Mac OS internet Keychain"
                                 (const :format ""
                                        :value :macos-keychain-internet)
                                 (choice :tag "Collection to use"
                                         (string :tag "internet Keychain path")
Glenn Morris's avatar
Glenn Morris committed
271
                                         (const :tag "default" default)))
272 273 274 275 276 277
                                (list
                                 :tag "Mac OS generic Keychain"
                                 (const :format ""
                                        :value :macos-keychain-generic)
                                 (choice :tag "Collection to use"
                                         (string :tag "generic Keychain path")
Glenn Morris's avatar
Glenn Morris committed
278
                                         (const :tag "default" default))))
279 280 281 282 283 284 285 286 287 288 289
                        (repeat :tag "Extra Parameters" :inline t
                                (choice :tag "Extra parameter"
                                        (list
                                         :tag "Host"
                                         (const :format "" :value :host)
                                         (choice :tag "Host (machine) choice"
                                                 (const :tag "Any" t)
                                                 (regexp
                                                  :tag "Regular expression")))
                                        (list
                                         :tag "Protocol"
290
                                         (const :format "" :value :port)
291 292 293 294 295 296
                                         (choice
                                          :tag "Protocol"
                                          (const :tag "Any" t)
                                          ,@auth-source-protocols-customize))
                                        (list :tag "User" :inline t
                                              (const :format "" :value :user)
297 298
                                              (choice
                                               :tag "Personality/Username"
299 300
                                               (const :tag "Any" t)
                                               (string
301 302
                                                :tag "Name"))))))
                  (sexp :tag "A data structure (external provider)"))))
Miles Bader's avatar
Miles Bader committed
303

304 305 306
(defcustom auth-source-gpg-encrypt-to t
  "List of recipient keys that `authinfo.gpg' encrypted to.
If the value is not a list, symmetric encryption will be used."
307
  :version "24.1" ;; No Gnus
308
  :type '(choice (const :tag "Symmetric encryption" t)
309 310
                 (repeat :tag "Recipient public keys"
                         (string :tag "Recipient public key"))))
311

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
312 313
(defun auth-source-do-debug (&rest msg)
  (when auth-source-debug
314
    (apply #'auth-source-do-warn msg)))
315

316 317 318
(defun auth-source-do-trivia (&rest msg)
  (when (or (eq auth-source-debug 'trivia)
            (functionp auth-source-debug))
319
    (apply #'auth-source-do-warn msg)))
320

321 322
(defun auth-source-do-warn (&rest msg)
  (apply
323 324
   ;; set logger to either the function in auth-source-debug or 'message
   ;; note that it will be 'message if auth-source-debug is nil
325 326 327 328 329
   (if (functionp auth-source-debug)
       auth-source-debug
     'message)
   msg))

330 331 332 333
(defun auth-source-read-char-choice (prompt choices)
  "Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
Only one of CHOICES will be returned.  The PROMPT is augmented
334
with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)."
335 336
  (when choices
    (let* ((prompt-choices
Mark Oteiza's avatar
Mark Oteiza committed
337 338
            (apply #'concat
                   (cl-loop for c in choices collect (format "%c/" c))))
339 340 341 342 343
           (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
           (full-prompt (concat prompt prompt-choices))
           k)

      (while (not (memq k choices))
344
        (setq k (read-char-choice full-prompt choices)))
345 346
      k)))

347
(defvar auth-source-backend-parser-functions nil
348 349 350 351 352 353
  "List of auth-source parser functions.
Each function takes an entry from `auth-sources' as parameter and
returns a backend or nil if the entry is not supported.  Add a
parser function to this list with `add-hook'.  Searching for a
backend starts with the first element on the list and stops as
soon as a function returns non-nil.")
354 355

(defun auth-source-backend-parse (entry)
356
  "Create an auth-source-backend from an ENTRY in `auth-sources'."
357

358 359 360
  (let ((backend
         (run-hook-with-args-until-success 'auth-source-backend-parser-functions
                                           entry)))
361 362 363 364 365 366 367 368 369 370 371 372 373 374

    (unless backend
      ;; none of the parsers worked
      (auth-source-do-warn
       "auth-source-backend-parse: invalid backend spec: %S" entry)
      (setq backend (make-instance 'auth-source-backend
                                   :source ""
                                   :type 'ignore)))
    (auth-source-backend-parse-parameters entry backend)))

(defun auth-source-backends-parser-file (entry)
  ;; take just a file name use it as a netrc/plist file
  ;; matching any user, host, and protocol
  (when (stringp entry)
375 376 377 378 379 380 381
    (setq entry (list :source entry)))
  (let* ((source (plist-get entry :source))
         (source-without-gpg
          (if (and (stringp source)
                   (equal (file-name-extension source) "gpg"))
              (file-name-sans-extension source)
            (or source "")))
382 383
         (extension (or (and (stringp source-without-gpg)
                             (file-name-extension source-without-gpg))
384 385 386 387
                        "")))
    (when (stringp source)
      (cond
       ((equal extension "plist")
388
        (auth-source-backend
389 390
         source
         :source source
391 392 393
         :type 'plstore
         :search-function #'auth-source-plstore-search
         :create-function #'auth-source-plstore-create
394 395 396 397 398 399 400 401 402 403 404 405 406 407
         :data (plstore-open source)))
       ((member-ignore-case extension '("json"))
        (auth-source-backend
         source
         :source source
         :type 'json
         :search-function #'auth-source-json-search))
       (t
        (auth-source-backend
         source
         :source source
         :type 'netrc
         :search-function #'auth-source-netrc-search
         :create-function #'auth-source-netrc-create))))))
408 409

;; Note this function should be last in the parser functions, so we add it first
410
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file)
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456

(defun auth-source-backends-parser-macos-keychain (entry)
  ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS
  ;; Keychain "XYZ" matching any user, host, and protocol
  (when (and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
                                           entry))
    (setq entry `(:source (:macos-keychain-internet
                           ,(match-string 1 entry)))))
  (when (and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
                                           entry))
    (setq entry `(:source (:macos-keychain-generic
                           ,(match-string 1 entry)))))
  ;; take 'macos-keychain-internet or generic and use it as a Mac OS
  ;; Keychain collection matching any user, host, and protocol
  (when (eq entry 'macos-keychain-internet)
    (setq entry '(:source (:macos-keychain-internet default))))
  (when (eq entry 'macos-keychain-generic)
    (setq entry '(:source (:macos-keychain-generic default))))
  (cond
   ;; the macOS Keychain
   ((and
     (not (null (plist-get entry :source))) ; the source must not be nil
     (listp (plist-get entry :source))      ; and it must be a list
     (or
      (plist-get (plist-get entry :source) :macos-keychain-generic)
      (plist-get (plist-get entry :source) :macos-keychain-internet)))

    (let* ((source-spec (plist-get entry :source))
           (keychain-generic (plist-get source-spec :macos-keychain-generic))
           (keychain-type (if keychain-generic
                              'macos-keychain-generic
                            'macos-keychain-internet))
           (source (plist-get source-spec (if keychain-generic
                                              :macos-keychain-generic
                                            :macos-keychain-internet))))

      (when (symbolp source)
        (setq source (symbol-name source)))

      (auth-source-backend
       (format "Mac OS Keychain (%s)" source)
       :source source
       :type keychain-type
       :search-function #'auth-source-macos-keychain-search
       :create-function #'auth-source-macos-keychain-create)))))

457
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain)
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503

(defun auth-source-backends-parser-secrets (entry)
  ;; take secrets:XYZ and use it as Secrets API collection "XYZ"
  ;; matching any user, host, and protocol
  (when (and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
    (setq entry `(:source (:secrets ,(match-string 1 entry)))))
  ;; take 'default and use it as a Secrets API default collection
  ;; matching any user, host, and protocol
  (when (eq entry 'default)
    (setq entry '(:source (:secrets default))))
  (cond
   ;; the Secrets API.  We require the package, in order to have a
   ;; defined value for `secrets-enabled'.
   ((and
     (not (null (plist-get entry :source))) ; the source must not be nil
     (listp (plist-get entry :source))      ; and it must be a list
     (not (null (plist-get
                 (plist-get entry :source)
                 :secrets))) ; the source must have :secrets
     (require 'secrets nil t)               ; and we must load the Secrets API
     secrets-enabled)                       ; and that API must be enabled

    ;; the source is either the :secrets key in ENTRY or
    ;; if that's missing or nil, it's "session"
    (let ((source (plist-get (plist-get entry :source) :secrets)))

      ;; if the source is a symbol, we look for the alias named so,
      ;; and if that alias is missing, we use "Login"
      (when (symbolp source)
        (setq source (or (secrets-get-alias (symbol-name source))
                         "Login")))

      (if (featurep 'secrets)
          (auth-source-backend
           (format "Secrets API (%s)" source)
           :source source
           :type 'secrets
           :search-function #'auth-source-secrets-search
           :create-function #'auth-source-secrets-create)
        (auth-source-do-warn
         "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
        (auth-source-backend
         (format "Ignored Secrets API (%s)" source)
         :source ""
         :type 'ignore))))))

504
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets)
505 506

(defun auth-source-backend-parse-parameters (entry backend)
507
  "Fill in the extra auth-source-backend parameters of ENTRY.
508 509
Using the plist ENTRY, get the :host, :port, and :user search
parameters."
510 511 512 513
  (let ((entry (if (stringp entry)
                   nil
                 entry))
        val)
514 515 516 517
    (when (setq val (plist-get entry :host))
      (oset backend host val))
    (when (setq val (plist-get entry :user))
      (oset backend user val))
518 519
    (when (setq val (plist-get entry :port))
      (oset backend port val)))
520 521
  backend)

522
;; (mapcar #'auth-source-backend-parse auth-sources)
523

Mark Oteiza's avatar
Mark Oteiza committed
524 525 526
(cl-defun auth-source-search (&rest spec
                              &key max require create delete
                              &allow-other-keys)
527 528 529 530 531 532 533 534 535 536
  "Search or modify authentication backends according to SPEC.

This function parses `auth-sources' for matches of the SPEC
plist.  It can optionally create or update an authentication
token if requested.  A token is just a standard Emacs property
list with a :secret property that can be a function; all the
other properties will always hold scalar values.

Typically the :secret property, if present, contains a password.

537
Common search keys are :max, :host, :port, and :user.  In
538
addition, :create specifies if and how tokens will be created.
539 540 541 542 543 544 545 546 547 548 549 550
Finally, :type can specify which backend types you want to check.

A string value is always matched literally.  A symbol is matched
as its string value, literally.  All the SPEC values can be
single values (symbol or string) or lists thereof (in which case
any of the search terms matches).

:create t means to create a token if possible.

A new token will be created if no matching tokens were found.
The new token will have only the keys the backend requires.  For
the netrc backend, for instance, that's the user, host, and
551
port keys.
552 553 554

Here's an example:

555
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
556
                                        (A    . \"default A\"))))
557
  (auth-source-search :host \"mine\" :type \\='netrc :max 1
558 559 560 561 562
                      :P \"pppp\" :Q \"qqqq\"
                      :create t))

which says:

563 564
\"Search for any entry matching host `mine' in backends of type
 `netrc', maximum one result.
565 566

 Create a new entry if you found none.  The netrc backend will
567
 automatically require host, user, and port.  The host will be
568
 `mine'.  We prompt for the user with default `defaultUser' and
569
 for the port without a default.  We will not prompt for A, Q,
570
 or P.  The resulting token will only have keys user, host, and
571
 port.\"
572

573
:create \\='(A B C) also means to create a token if possible.
574 575 576 577 578 579

The behavior is like :create t but if the list contains any
parameter, that parameter will be required in the resulting
token.  The value for that parameter will be obtained from the
search parameters or from user input.  If any queries are needed,
the alist `auth-source-creation-defaults' will be checked for the
580 581
default value.  If the user, host, or port are missing, the alist
`auth-source-creation-prompts' will be used to look up the
582 583
prompts IN THAT ORDER (so the `user' prompt will be queried first,
then `host', then `port', and finally `secret').  Each prompt string
584
can use %u, %h, and %p to show the user, host, and port.
585 586 587

Here's an example:

588
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
589 590
                                        (A    . \"default A\")))
       (auth-source-creation-prompts
591 592
        \\='((password . \"Enter IMAP password for %h:%p: \"))))
  (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
593
                      :P \"pppp\" :Q \"qqqq\"
594
                      :create \\='(A B Q)))
595 596 597

which says:

598 599
\"Search for any entry matching host `nonesuch'
 or `twosuch' in backends of type `netrc', maximum one result.
600 601

 Create a new entry if you found none.  The netrc backend will
602
 automatically require host, user, and port.  The host will be
603
 `nonesuch' and Q will be `qqqq'.  We prompt for the password
604 605 606
 with the shown prompt.  We will not prompt for Q.  The resulting
 token will have keys user, host, port, A, B, and Q.  It will not
 have P with any value, even though P is used in the search to
607
 find only entries that have P set to `pppp'.\"
608 609

When multiple values are specified in the search parameter, the
610 611
user is prompted for which one.  So :host (X Y Z) would ask the
user to choose between X, Y, and Z.
612 613 614 615 616 617 618

This creation can fail if the search was not specific enough to
create a new token (it's up to the backend to decide that).  You
should `catch' the backend-specific error as usual.  Some
backends (netrc, at least) will prompt the user rather than throw
an error.

619 620 621 622 623
:require (A B C) means that only results that contain those
tokens will be returned.  Thus for instance requiring :secret
will ensure that any results will actually have a :secret
property.

624 625 626 627
:delete t means to delete any found entries.  nil by default.
Use `auth-source-delete' in ELisp code instead of calling
`auth-source-search' directly with this parameter.

628 629
:type (X Y Z) will check only those backend types.  `netrc' and
`secrets' are the only ones supported right now.
630 631

:max N means to try to return at most N items (defaults to 1).
632 633 634 635 636
More than N items may be returned, depending on the search and
the backend.

When :max is 0 the function will return just t or nil to indicate
if any matches were found.
637 638 639 640 641 642 643

:host (X Y Z) means to match only hosts X, Y, or Z according to
the match rules above.  Defaults to t.

:user (X Y Z) means to match only users X, Y, or Z according to
the match rules above.  Defaults to t.

644
:port (P Q R) means to match only protocols P, Q, or R.
645 646 647 648 649 650
Defaults to t.

:K (V1 V2 V3) for any other key K will match values V1, V2, or
V3 (note the match rules above).

The return value is a list with at most :max tokens.  Each token
651
is a plist with keys :backend :host :port :user, plus any other
652 653 654
keys provided by the backend (notably :secret).  But note the
exception for :max 0, which see above.

655 656 657 658 659 660
The token can hold a :save-function key.  If you call that, the
user will be prompted to save the data to the backend.  You can't
request that this should happen right after creation, because
`auth-source-search' has no way of knowing if the token is
actually useful.  So the caller must arrange to call this function.

661 662
The token's :secret key can hold a function.  In that case you
must call it to obtain the actual value."
663
  (let* ((backends (mapcar #'auth-source-backend-parse auth-sources))
664
         (max (or max 1))
665
         (ignored-keys '(:require :create :delete :max))
Mark Oteiza's avatar
Mark Oteiza committed
666 667 668
         (keys (cl-loop for i below (length spec) by 2
                        unless (memq (nth i spec) ignored-keys)
                        collect (nth i spec)))
669 670 671
         (cached (auth-source-remembered-p spec))
         ;; note that we may have cached results but found is still nil
         ;; (there were no results from the search)
672
         (found (auth-source-recall spec))
673
         filtered-backends)
674

675
    (if (and cached auth-source-do-cache)
676 677 678 679
        (auth-source-do-debug
         "auth-source-search: found %d CACHED results matching %S"
         (length found) spec)

Mark Oteiza's avatar
Mark Oteiza committed
680
      (cl-assert
681
       (or (eq t create) (listp create)) t
682
       "Invalid auth-source :create parameter (must be t or a list): %s %s")
683

Mark Oteiza's avatar
Mark Oteiza committed
684
      (cl-assert
685 686 687
       (listp require) t
       "Invalid auth-source :require parameter (must be a list): %s")

688
      (setq filtered-backends (copy-sequence backends))
689
      (dolist (backend backends)
Mark Oteiza's avatar
Mark Oteiza committed
690
        (cl-dolist (key keys)
691
          ;; ignore invalid slots
692 693 694 695
          (condition-case nil
              (unless (auth-source-search-collection
                       (plist-get spec key)
                       (slot-value backend key))
696
                (setq filtered-backends (delq backend filtered-backends))
Mark Oteiza's avatar
Mark Oteiza committed
697
                (cl-return))
698
            (invalid-slot-name nil))))
699

700
      (auth-source-do-trivia
701 702 703 704
       "auth-source-search: found %d backends matching %S"
       (length filtered-backends) spec)

      ;; (debug spec "filtered" filtered-backends)
705 706
      ;; First go through all the backends without :create, so we can
      ;; query them all.
707 708 709 710
      (setq found (auth-source-search-backends filtered-backends
                                               spec
                                               ;; to exit early
                                               max
711 712 713
                                               ;; create is always nil here
                                               nil delete
                                               require))
714 715 716 717 718

      (auth-source-do-debug
       "auth-source-search: found %d results (max %d) matching %S"
       (length found) max spec)

719 720
      ;; If we didn't find anything, then we allow the backend(s) to
      ;; create the entries.
721
      (when (and create
722 723 724 725 726
                 (not found))
        (setq found (auth-source-search-backends filtered-backends
                                                 spec
                                                 ;; to exit early
                                                 max
727 728 729
                                                 create delete
                                                 require))
        (auth-source-do-debug
730 731 732
         "auth-source-search: CREATED %d results (max %d) matching %S"
         (length found) max spec))

733 734
      ;; note we remember the lack of result too, if it's applicable
      (when auth-source-do-cache
735 736
        (auth-source-remember spec found)))

737 738 739
    (if (zerop max)
        (not (null found))
      found)))
740

741
(defun auth-source-search-backends (backends spec max create delete require)
742 743
  (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero
        matches)
744
    (dolist (backend backends)
745
      (when (> max (length matches)) ; if we need more matches...
746 747 748
        (let* ((bmatches (apply
                          (slot-value backend 'search-function)
                          :backend backend
749
                          :type (slot-value backend 'type)
750
                          ;; note we're overriding whatever the spec
751 752
                          ;; has for :max, :require, :create, and :delete
                          :max max
753 754 755 756
                          :require require
                          :create create
                          :delete delete
                          spec)))
757 758 759 760
          (when bmatches
            (auth-source-do-trivia
             "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
             (length bmatches) max
761 762
             (slot-value backend 'type)
             (slot-value backend 'source)
763 764 765
             spec)
            (setq matches (append matches bmatches))))))
    matches))
766

767
(defun auth-source-delete (&rest spec)
768 769 770 771 772
  "Delete entries from the authentication backends according to SPEC.
Calls `auth-source-search' with the :delete property in SPEC set to t.
The backend may not actually delete the entries.

Returns the deleted entries."
773
  (apply #'auth-source-search (plist-put spec :delete t)))
774 775

(defun auth-source-search-collection (collection value)
776
  "Return t if VALUE is t or COLLECTION is t or COLLECTION contains VALUE."
777 778 779 780 781 782 783 784
  (when (and (atom collection) (not (eq t collection)))
    (setq collection (list collection)))

  ;; (debug :collection collection :value value)
  (or (eq collection t)
      (eq value t)
      (equal collection value)
      (member value collection)))
Miles Bader's avatar
Miles Bader committed
785

786 787
(defvar auth-source-netrc-cache nil)

Miles Bader's avatar
Miles Bader committed
788
(defun auth-source-forget-all-cached ()
789
  "Forget all cached auth-source data."
Miles Bader's avatar
Miles Bader committed
790
  (interactive)
791 792 793 794 795
  (maphash (lambda (key _password)
             (when (eq 'auth-source (car-safe key))
               ;; remove that key
               (password-cache-remove key)))
           password-data)
796
  (setq auth-source-netrc-cache nil))
797

798 799
(defun auth-source-format-cache-entry (spec)
  "Format SPEC entry to put it in the password cache."
800
  `(auth-source . ,spec))
801

802 803
(defun auth-source-remember (spec found)
  "Remember FOUND search results for SPEC."
804 805
  (let ((password-cache-expiry auth-source-cache-expiry))
    (password-cache-add
806
     (auth-source-format-cache-entry spec) found)))
807 808 809

(defun auth-source-recall (spec)
  "Recall FOUND search results for SPEC."
810
  (password-read-from-cache (auth-source-format-cache-entry spec)))
811

812 813 814
(defun auth-source-remembered-p (spec)
  "Check if SPEC is remembered."
  (password-in-cache-p
815
   (auth-source-format-cache-entry spec)))
816

817 818 819 820 821
(defun auth-source-forget (spec)
  "Forget any cached data matching SPEC exactly.

This is the same SPEC you passed to `auth-source-search'.
Returns t or nil for forgotten or not found."
822
  (password-cache-remove (auth-source-format-cache-entry spec)))
823

824
(defun auth-source-forget+ (&rest spec)
825 826 827 828 829 830
  "Forget any cached data matching SPEC.  Returns forgotten count.

This is not a full `auth-source-search' spec but works similarly.
For instance, \(:host \"myhost\" \"yourhost\") would find all the
cached data that was found with a search for those two hosts,
while \(:host t) would find all host entries."
831 832 833 834 835 836 837 838 839 840
  (let ((count 0))
    (maphash
     (lambda (key _password)
       (when (and (eq 'auth-source (car-safe key))
                  ;; and the spec matches what was stored in the cache
                  (auth-source-specmatchp spec (cdr key)))
         ;; remove that key
         (password-cache-remove key)
         (cl-incf count)))
     password-data)
841 842 843
    count))

(defun auth-source-specmatchp (spec stored)
Mark Oteiza's avatar
Mark Oteiza committed
844 845
  (let ((keys (cl-loop for i below (length spec) by 2
                       collect (nth i spec))))
846
    (not (eq
Mark Oteiza's avatar
Mark Oteiza committed
847
          (cl-dolist (key keys)
848 849
            (unless (auth-source-search-collection (plist-get stored key)
                                                   (plist-get spec key))
Mark Oteiza's avatar
Mark Oteiza committed
850
              (cl-return 'no)))
851 852
          'no))))

853 854
(defun auth-source-pick-first-password (&rest spec)
  "Pick the first secret found from applying SPEC to `auth-source-search'."
855
  (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
856 857 858 859 860 861 862 863 864 865 866 867
         (secret (plist-get result :secret)))

    (if (functionp secret)
        (funcall secret)
      secret)))

(defun auth-source-format-prompt (prompt alist)
  "Format PROMPT using %x (for any character x) specifiers in ALIST."
  (dolist (cell alist)
    (let ((c (nth 0 cell))
          (v (nth 1 cell)))
      (when (and c v)
868 869
        (setq prompt (replace-regexp-in-string (format "%%%c" c)
                                               (format "%s" v)
870
                                               prompt nil t)))))
871
  prompt)
872

873
(defun auth-source-ensure-strings (values)
874 875 876 877 878 879 880 881 882
  (if (eq values t)
      values
    (unless (listp values)
      (setq values (list values)))
    (mapcar (lambda (value)
	      (if (numberp value)
		  (format "%s" value)
		value))
	    values)))
883

884 885
;;; Backend specific parsing: netrc/authinfo backend

886 887 888 889 890 891 892 893 894 895 896 897 898 899 900
(defun auth-source--aput-1 (alist key val)
  (let ((seen ())
        (rest alist))
    (while (and (consp rest) (not (equal key (caar rest))))
      (push (pop rest) seen))
    (cons (cons key val)
          (if (null rest) alist
            (nconc (nreverse seen)
                   (if (equal key (caar rest)) (cdr rest) rest))))))
(defmacro auth-source--aput (var key val)
  `(setq ,var (auth-source--aput-1 ,var ,key ,val)))

(defun auth-source--aget (alist key)
  (cdr (assoc key alist)))

901
;; (auth-source-netrc-parse :file "~/.authinfo.gpg")
Mark Oteiza's avatar
Mark Oteiza committed
902 903
(cl-defun auth-source-netrc-parse (&key file max host user port require
                                   &allow-other-keys)
904 905 906 907 908 909
  "Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
  (if (listp file)
      ;; We got already parsed contents; just return it.
      file
    (when (file-exists-p file)
910
      (setq port (auth-source-ensure-strings port))
911
      (with-temp-buffer
912
        (let* ((max (or max 5000))       ; sanity check: default to stop at 5K
913 914 915 916
               (modified 0)
               (cached (cdr-safe (assoc file auth-source-netrc-cache)))
               (cached-mtime (plist-get cached :mtime))
               (cached-secrets (plist-get cached :secret))
917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940
               (check (lambda(alist)
                        (and alist
                             (auth-source-search-collection
                              host
                              (or
                               (auth-source--aget alist "machine")
                               (auth-source--aget alist "host")
                               t))
                             (auth-source-search-collection
                              user
                              (or
                               (auth-source--aget alist "login")
                               (auth-source--aget alist "account")
                               (auth-source--aget alist "user")
                               t))
                             (auth-source-search-collection
                              port
                              (or
                               (auth-source--aget alist "port")
                               (auth-source--aget alist "protocol")
                               t))
                             (or
                              ;; the required list of keys is nil, or
                              (null require)
Paul Eggert's avatar
Paul Eggert committed
941
                              ;; every element of require is in n (normalized)
942 943
                              (let ((n (nth 0 (auth-source-netrc-normalize
                                               (list alist) file))))
Mark Oteiza's avatar
Mark Oteiza committed
944 945
                                (cl-loop for req in require
                                         always (plist-get n req)))))))
946
               result)
947 948 949

          (if (and (functionp cached-secrets)
                   (equal cached-mtime
Paul Eggert's avatar
Paul Eggert committed
950 951
                          (file-attribute-modification-time
                           (file-attributes file))))
952 953 954 955 956 957 958
              (progn
                (auth-source-do-trivia
                 "auth-source-netrc-parse: using CACHED file data for %s"
                 file)
                (insert (funcall cached-secrets)))
            (insert-file-contents file)
            ;; cache all netrc files (used to be just .gpg files)
959
            ;; Store the contents of the file obfuscated in memory.
960 961
            (auth-source--aput
             auth-source-netrc-cache file
Paul Eggert's avatar
Paul Eggert committed
962 963
             (list :mtime (file-attribute-modification-time
                           (file-attributes file))
964 965
                   :secret (let ((v (auth-source--obfuscate (buffer-string))))
                             (lambda () (auth-source--deobfuscate v))))))
966
          (goto-char (point-min))
967 968 969 970
          (let ((entries (auth-source-netrc-parse-entries check max))
                alist)
            (while (setq alist (pop entries))
                (push (nreverse alist) result)))
971 972 973 974 975 976 977 978 979 980 981 982 983

          (when (< 0 modified)
            (when auth-source-gpg-encrypt-to
              ;; (see bug#7487) making `epa-file-encrypt-to' local to
              ;; this buffer lets epa-file skip the key selection query
              ;; (see the `local-variable-p' check in
              ;; `epa-file-write-region').
              (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
                (make-local-variable 'epa-file-encrypt-to))
              (if (listp auth-source-gpg-encrypt-to)
                  (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))

            ;; ask AFTER we've successfully opened the file
984
            (when (y-or-n-p (format "Save file %s? (%d deletions)"
985 986 987 988 989 990 991 992
                                    file modified))
              (write-region (point-min) (point-max) file nil 'silent)
              (auth-source-do-debug
               "auth-source-netrc-parse: modified %d lines in %s"
               modified file)))

          (nreverse result))))))

993 994
(defun auth-source-netrc-parse-next-interesting ()
  "Advance to the next interesting position in the current buffer."
995
  (skip-chars-forward "\t ")
996
  ;; If we're looking at a comment or are at the end of the line, move forward
997
  (while (or (eq (char-after) ?#)
998 999
             (and (eolp)
                  (not (eobp))))
1000 1001
    (forward-line 1)
    (skip-chars-forward "\t ")))
1002

1003 1004 1005 1006 1007 1008 1009
(defun auth-source-netrc-looking-at-token ()
  "Say whether the next think in the buffer is a token (password, etc).
Match data is altered to reflect the token."
  (or (looking-at "'\\([^']*\\)'")
      (looking-at "\"\\([^\"]*\\)\"")
      (looking-at "\\([^ \t\n]+\\)")))

1010 1011 1012 1013
(defun auth-source-netrc-parse-one ()
  "Read one thing from the current buffer."
  (auth-source-netrc-parse-next-interesting)

1014
  (when (auth-source-netrc-looking-at-token)
1015
    (forward-char (length (match-string 0)))
1016 1017 1018
    (prog1
        (match-string-no-properties 1)
      (auth-source-netrc-parse-next-interesting))))
1019

1020 1021 1022 1023 1024 1025 1026
;; with thanks to org-mode
(defsubst auth-source-current-line (&optional pos)
  (save-excursion
    (and pos (goto-char pos))
    ;; works also in narrowed buffer, because we start at 1, not point-min
    (+ (if (bolp) 1 0) (count-lines 1 (point)))))

1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042
(defun auth-source-netrc-parse-entries(check max)
  "Parse up to MAX netrc entries, passed by CHECK, from the current buffer."
  (let ((adder (lambda(check alist all)
                 (when (and
                        alist
                        (> max (length all))
                        (funcall check alist))
                   (push alist all))
                 all))
        item item2 all alist default)
    (while (setq item (auth-source-netrc-parse-one))
      (setq default (equal item "default"))
      ;; We're starting a new machine.  Save the old one.
      (when (and alist
                 (or default
                     (equal item "machine")))
1043 1044
        ;; (auth-source-do-trivia
        ;;  "auth-source-netrc-parse-entries: got entry %S" alist)
1045 1046 1047 1048 1049 1050 1051 1052
        (setq all (funcall adder check alist all)
              alist nil))
      ;; In default entries, we don't have a next token.
      ;; We store them as ("machine" . t)
      (if default
          (push (cons "machine" t) alist)
        ;; Not a default entry.  Grab the next item.
        (when (setq item2 (auth-source-netrc-parse-one))
1053 1054
          ;; Did we get a "machine" value?
          (if (equal item2 "machine")
1055 1056 1057 1058
	      (error
	       "%s: Unexpected `machine' token at line %d"
	       "auth-source-netrc-parse-entries"
	       (auth-source-current-line))
1059
            (push (cons item item2) alist)))))
1060 1061 1062

    ;; Clean up: if there's an entry left over, use it.
    (when alist
1063
      (setq all (funcall adder check alist all))
1064 1065 1066
      ;; (auth-source-do-trivia
      ;;  "auth-source-netrc-parse-entries: got2 entry %S" alist)
      )
1067 1068
    (nreverse all)))

1069 1070
(defvar auth-source-passphrase-alist nil)

1071
(defun auth-source-token-passphrase-callback-function (_context _key-id file)
Daiki Ueno's avatar
Daiki Ueno committed
1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086
  (let* ((file (file-truename file))
	 (entry (assoc file auth-source-passphrase-alist))
	 passphrase)
    ;; return the saved passphrase, calling a function if needed
    (or (copy-sequence (if (functionp (cdr entry))
			   (funcall (cdr entry))
			 (cdr entry)))
	(progn
	  (unless entry
	    (setq entry (list file))
	    (push entry auth-source-passphrase-alist))
	  (setq passphrase
		(read-passwd
		 (format "Passphrase for %s tokens: " file)
		 t))
1087
	  (setcdr entry (let ((p (copy-sequence passphrase)))
Daiki Ueno's avatar
Daiki Ueno committed
1088 1089
			  (lambda () p)))
	  passphrase))))
1090 1091 1092 1093 1094 1095

(defun auth-source-epa-extract-gpg-token (secret file)
  "Pass either the decoded SECRET or the gpg:BASE64DATA version.
FILE is the file from which we obtained this token."
  (when (string-match "^gpg:\\(.+\\)" secret)
    (setq secret (base64-decode-string (match-string 1 secret))))
1096
  (let ((context (epg-make-context 'OpenPGP)))
1097 1098 1099 1100 1101 1102
    (epg-context-set-passphrase-callback
     context
     (cons #'auth-source-token-passphrase-callback-function
           file))
    (epg-decrypt-string context secret)))

1103 1104
(defvar pp-escape-newlines)

1105
(defun auth-source-epa-make-gpg-token (secret file)
1106 1107 1108
  (let ((context (epg-make-context 'OpenPGP))
        (pp-escape-newlines nil)
        cipher)
1109
    (setf (epg-context-armor context) t)
1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120
    (epg-context-set-passphrase-callback
     context
     (cons #'auth-source-token-passphrase-callback-function
           file))
    (setq cipher (epg-encrypt-string context secret nil))
    (with-temp-buffer
      (insert cipher)
      (base64-encode-region (point-min) (point-max) t)
      (concat "gpg:" (buffer-substring-no-properties
                      (point-min)
                      (point-max))))))
1121

1122
(defun auth-source--symbol-keyword (symbol)
1123 1124
  (intern (format ":%s" symbol)))

1125
(defun auth-source-netrc-normalize (alist filename)
1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138
  (mapcar (lambda (entry)
            (let (ret item)
              (while (setq item (pop entry))
                (let ((k (car item))
                      (v (cdr item)))

                  ;; apply key aliases
                  (setq k (cond ((member k '("machine")) "host")
                                ((member k '("login" "account")) "user")
                                ((member k '("protocol")) "port")
                                ((member k '("password")) "secret")
                                (t k)))

1139 1140 1141 1142 1143
                  ;; Send back the secret in a function (lexical
                  ;; binding).  We slightly obfuscate the passwords
                  ;; (that's the "(mapcar #+' ..)" stuff) to avoid
                  ;; showing the passwords in clear text in backtraces
                  ;; and the like.
1144
                  (when (equal k "secret")
1145
                    (setq v (let ((lexv (auth-source--obfuscate v))
1146
                                  (token-decoder nil))
1147
                              (when (string-match "^gpg:" v)
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157
                                ;; it's a GPG token: create a token decoder
                                ;; which unsets itself once
                                (setq token-decoder
                                      (lambda (val)
                                        (prog1
                                            (auth-source-epa-extract-gpg-token
                                             val
                                             filename)
                                          (setq token-decoder nil)))))
                              (lambda ()
1158 1159
                                (if token-decoder
                                    (funcall token-decoder
1160 1161
                                             (auth-source--deobfuscate lexv))
                                  (auth-source--deobfuscate lexv))))))
1162
                  (setq ret (plist-put ret
1163
                                       (auth-source--symbol-keyword k)
1164 1165 1166
                                       v))))
              ret))
          alist))
1167

1168 1169 1170 1171
;; Never change this variable.
(defvar auth-source--session-nonce nil)

(defun auth-source--obfuscate (string)
1172 1173 1174 1175 1176 1177
  ;; We want to keep passwords out of backtraces and bug reports and
  ;; the like, so if we have GnuTLS available, we encrypt them with a
  ;; nonce that we just keep in memory.  If somebody has access to the
  ;; current Emacs session, they can be decrypted, but if not, little
  ;; useful information is leaked.  If you reset the nonce, you also
  ;; have to call `auth-source-forget-all-cached'.
1178 1179
  (unless auth-source--session-nonce
    (setq auth-source--session-nonce
1180
          (apply #'string (cl-loop repeat 16
1181
                                   collect (random 128)))))
1182 1183
  (if (and (fboundp 'gnutls-symmetric-encrypt)
           (gnutls-available-p))
1184 1185 1186
      (let ((cdata (car (last (gnutls-ciphers)))))
        (mapconcat
         #'base64-encode-string
1187 1188 1189 1190 1191
         (gnutls-symmetric-encrypt
          (pop cdata)
          (auth-source--pad auth-source--session-nonce
                            (plist-get cdata :cipher-keysize))
          (list 'iv-auto (plist-get cdata :cipher-ivsize))
1192 1193
          (auth-source--pad (encode-coding-string string 'utf-8)
                            (plist-get cdata :cipher-blocksize)))
1194 1195 1196
         "-"))
    (mapcar #'1- string)))

1197
(defun auth-source--pad (string length)
1198
  "Pad string S to a modulo of LENGTH."
1199 1200 1201 1202 1203 1204 1205
  (let ((pad (- length (mod (length string) length))))
    (concat string (make-string pad pad))))

(defun auth-source--unpad (string)
  "Remove PKCS#7 padding from STRING."
  (substring string 0 (- (length string)
			 (aref string (1- (length string))))))
1206 1207

(defun auth-source--deobfuscate (data)
1208 1209
  (if (and (fboundp 'gnutls-symmetric-encrypt)
           (gnutls-available-p))
1210 1211
      (let ((cdata (car (last (gnutls-ciphers))))
            (bits (split-string data "-")))
1212 1213 1214 1215 1216 1217 1218 1219 1220 1221
        (decode-coding-string
         (auth-source--unpad
          (car
           (gnutls-symmetric-decrypt
            (pop cdata)
            (auth-source--pad auth-source--session-nonce
                              (plist-get cdata :cipher-keysize))
            (base64-decode-string (cadr bits))
            (base64-decode-string (car bits)))))
         'utf-8))
1222 1223
    (apply #'string (mapcar #'1+ data))))

Mark Oteiza's avatar
Mark Oteiza committed
1224 1225 1226 1227
(cl-defun auth-source-netrc-search (&rest spec
                                    &key backend require create
                                    type max host user port
                                    &allow-other-keys)
1228
  "Given a property list SPEC, return search matches from the :backend.