| 1 | ;;; auth-source.el --- authentication sources for Gnus and Emacs |
| 2 | |
| 3 | ;; Copyright (C) 2008, 2009, 2010 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 'gnus-util) |
| 43 | (require 'netrc) |
| 44 | |
| 45 | (eval-when-compile (require 'cl)) |
| 46 | (autoload 'secrets-create-item "secrets") |
| 47 | (autoload 'secrets-delete-item "secrets") |
| 48 | (autoload 'secrets-get-alias "secrets") |
| 49 | (autoload 'secrets-get-attribute "secrets") |
| 50 | (autoload 'secrets-get-secret "secrets") |
| 51 | (autoload 'secrets-list-collections "secrets") |
| 52 | (autoload 'secrets-search-items "secrets") |
| 53 | |
| 54 | (defgroup auth-source nil |
| 55 | "Authentication sources." |
| 56 | :version "23.1" ;; No Gnus |
| 57 | :group 'gnus) |
| 58 | |
| 59 | (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") |
| 60 | (pop3 "pop3" "pop" "pop3s" "110" "995") |
| 61 | (ssh "ssh" "22") |
| 62 | (sftp "sftp" "115") |
| 63 | (smtp "smtp" "25")) |
| 64 | "List of authentication protocols and their names" |
| 65 | |
| 66 | :group 'auth-source |
| 67 | :version "23.2" ;; No Gnus |
| 68 | :type '(repeat :tag "Authentication Protocols" |
| 69 | (cons :tag "Protocol Entry" |
| 70 | (symbol :tag "Protocol") |
| 71 | (repeat :tag "Names" |
| 72 | (string :tag "Name"))))) |
| 73 | |
| 74 | ;;; generate all the protocols in a format Customize can use |
| 75 | ;;; TODO: generate on the fly from auth-source-protocols |
| 76 | (defconst auth-source-protocols-customize |
| 77 | (mapcar (lambda (a) |
| 78 | (let ((p (car-safe a))) |
| 79 | (list 'const |
| 80 | :tag (upcase (symbol-name p)) |
| 81 | p))) |
| 82 | auth-source-protocols)) |
| 83 | |
| 84 | (defvar auth-source-cache (make-hash-table :test 'equal) |
| 85 | "Cache for auth-source data") |
| 86 | |
| 87 | (defcustom auth-source-do-cache t |
| 88 | "Whether auth-source should cache information." |
| 89 | :group 'auth-source |
| 90 | :version "23.2" ;; No Gnus |
| 91 | :type `boolean) |
| 92 | |
| 93 | (defcustom auth-source-debug nil |
| 94 | "Whether auth-source should log debug messages. |
| 95 | Also see `auth-source-hide-passwords'. |
| 96 | |
| 97 | If the value is nil, debug messages are not logged. |
| 98 | If the value is t, debug messages are logged with `message'. |
| 99 | In that case, your authentication data will be in the |
| 100 | clear (except for passwords, which are always stripped out). |
| 101 | If the value is a function, debug messages are logged by calling |
| 102 | that function using the same arguments as `message'." |
| 103 | :group 'auth-source |
| 104 | :version "23.2" ;; No Gnus |
| 105 | :type `(choice |
| 106 | :tag "auth-source debugging mode" |
| 107 | (const :tag "Log using `message' to the *Messages* buffer" t) |
| 108 | (function :tag "Function that takes arguments like `message'") |
| 109 | (const :tag "Don't log anything" nil))) |
| 110 | |
| 111 | (defcustom auth-source-hide-passwords t |
| 112 | "Whether auth-source should hide passwords in log messages. |
| 113 | Only relevant if `auth-source-debug' is not nil." |
| 114 | :group 'auth-source |
| 115 | :version "23.2" ;; No Gnus |
| 116 | :type `boolean) |
| 117 | |
| 118 | (defcustom auth-sources '((:source "~/.authinfo.gpg") |
| 119 | (:source "~/.authinfo")) |
| 120 | "List of authentication sources. |
| 121 | |
| 122 | The default will get login and password information from a .gpg |
| 123 | file, which you should set up with the EPA/EPG packages to be |
| 124 | encrypted. See the auth.info manual for details. |
| 125 | |
| 126 | Each entry is the authentication type with optional properties. |
| 127 | |
| 128 | It's best to customize this with `M-x customize-variable' because the choices |
| 129 | can get pretty complex." |
| 130 | :group 'auth-source |
| 131 | :version "23.2" ;; No Gnus |
| 132 | :type `(repeat :tag "Authentication Sources" |
| 133 | (list :tag "Source definition" |
| 134 | (const :format "" :value :source) |
| 135 | (choice :tag "Authentication backend choice" |
| 136 | (string :tag "Authentication Source (file)") |
| 137 | (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)" |
| 138 | (const :format "" :value :secrets) |
| 139 | (choice :tag "Collection to use" |
| 140 | (string :tag "Collection name") |
| 141 | (const :tag "Default" 'default) |
| 142 | (const :tag "Login" "login") |
| 143 | (const :tag "Temporary" "session")))) |
| 144 | (repeat :tag "Extra Parameters" :inline t |
| 145 | (choice :tag "Extra parameter" |
| 146 | (list :tag "Host (omit to match as a fallback)" |
| 147 | (const :format "" :value :host) |
| 148 | (choice :tag "Host (machine) choice" |
| 149 | (const :tag "Any" t) |
| 150 | (regexp :tag "Host (machine) regular expression"))) |
| 151 | (list :tag "Protocol (omit to match as a fallback)" |
| 152 | (const :format "" :value :protocol) |
| 153 | (choice :tag "Protocol" |
| 154 | (const :tag "Any" t) |
| 155 | ,@auth-source-protocols-customize)) |
| 156 | (list :tag "User (omit to match as a fallback)" :inline t |
| 157 | (const :format "" :value :user) |
| 158 | (choice :tag "Personality or username" |
| 159 | (const :tag "Any" t) |
| 160 | (string :tag "Specific user name")))))))) |
| 161 | |
| 162 | ;; temp for debugging |
| 163 | ;; (unintern 'auth-source-protocols) |
| 164 | ;; (unintern 'auth-sources) |
| 165 | ;; (customize-variable 'auth-sources) |
| 166 | ;; (setq auth-sources nil) |
| 167 | ;; (format "%S" auth-sources) |
| 168 | ;; (customize-variable 'auth-source-protocols) |
| 169 | ;; (setq auth-source-protocols nil) |
| 170 | ;; (format "%S" auth-source-protocols) |
| 171 | ;; (auth-source-pick nil :host "a" :port 'imap) |
| 172 | ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap) |
| 173 | ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap) |
| 174 | ;; (auth-source-user-or-password-imap "login" "imap.myhost.com") |
| 175 | ;; (auth-source-user-or-password-imap "password" "imap.myhost.com") |
| 176 | ;; (auth-source-protocol-defaults 'imap) |
| 177 | |
| 178 | ;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello")) |
| 179 | ;; (let ((auth-source-debug t)) (auth-source-debug "hello")) |
| 180 | ;; (let ((auth-source-debug nil)) (auth-source-debug "hello")) |
| 181 | (defun auth-source-do-debug (&rest msg) |
| 182 | ;; set logger to either the function in auth-source-debug or 'message |
| 183 | ;; note that it will be 'message if auth-source-debug is nil, so |
| 184 | ;; we also check the value |
| 185 | (when auth-source-debug |
| 186 | (let ((logger (if (functionp auth-source-debug) |
| 187 | auth-source-debug |
| 188 | 'message))) |
| 189 | (apply logger msg)))) |
| 190 | |
| 191 | ;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe") |
| 192 | ;; (auth-source-pick t :host "any" :protocol 'imap :user "joe") |
| 193 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") |
| 194 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") |
| 195 | ;; (:source (:secrets "login") :host t :protocol t) |
| 196 | ;; (:source "~/.authinfo.gpg" :host t :protocol t))) |
| 197 | |
| 198 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") |
| 199 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") |
| 200 | ;; (:source (:secrets "login") :host t :protocol t) |
| 201 | ;; )) |
| 202 | |
| 203 | ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) |
| 204 | |
| 205 | (defun auth-get-source (entry) |
| 206 | "Return the source string of ENTRY, which is one entry in `auth-sources'. |
| 207 | If it is a Secret Service API, return the collection name, otherwise |
| 208 | the file name." |
| 209 | (let ((source (plist-get entry :source))) |
| 210 | (if (stringp source) |
| 211 | source |
| 212 | ;; Secret Service API. |
| 213 | (setq source (plist-get source :secrets)) |
| 214 | (when (eq source 'default) |
| 215 | (setq source (or (secrets-get-alias "default") "login"))) |
| 216 | (or source "session")))) |
| 217 | |
| 218 | (defun auth-source-pick (&rest spec) |
| 219 | "Parse `auth-sources' for matches of the SPEC plist. |
| 220 | |
| 221 | Common keys are :host, :protocol, and :user. A value of t in |
| 222 | SPEC means to always succeed in the match. A string value is |
| 223 | matched as a regex." |
| 224 | (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) |
| 225 | choices) |
| 226 | (dolist (choice (copy-tree auth-sources) choices) |
| 227 | (let ((source (plist-get choice :source)) |
| 228 | (match t)) |
| 229 | (when |
| 230 | (and |
| 231 | ;; Check existence of source. |
| 232 | (if (consp source) |
| 233 | ;; Secret Service API. |
| 234 | (member (auth-get-source choice) (secrets-list-collections)) |
| 235 | ;; authinfo file. |
| 236 | (file-exists-p source)) |
| 237 | |
| 238 | ;; Check keywords. |
| 239 | (dolist (k keys match) |
| 240 | (let* ((v (plist-get spec k)) |
| 241 | (choicev (if (plist-member choice k) |
| 242 | (plist-get choice k) t))) |
| 243 | (setq match |
| 244 | (and match |
| 245 | (or |
| 246 | ;; source always matches spec key |
| 247 | (eq t choicev) |
| 248 | ;; source key gives regex to match against spec |
| 249 | (and (stringp choicev) (string-match choicev v)) |
| 250 | ;; source key gives symbol to match against spec |
| 251 | (and (symbolp choicev) (eq choicev v)))))))) |
| 252 | |
| 253 | (add-to-list 'choices choice 'append)))))) |
| 254 | |
| 255 | (defun auth-source-retrieve (mode entry &rest spec) |
| 256 | "Retrieve MODE credentials according to SPEC from ENTRY." |
| 257 | (catch 'no-password |
| 258 | (let ((host (plist-get spec :host)) |
| 259 | (user (plist-get spec :user)) |
| 260 | (prot (plist-get spec :protocol)) |
| 261 | (source (plist-get entry :source)) |
| 262 | result) |
| 263 | (cond |
| 264 | ;; Secret Service API. |
| 265 | ((consp source) |
| 266 | (let ((coll (auth-get-source entry)) |
| 267 | item) |
| 268 | ;; Loop over candidates with a matching host attribute. |
| 269 | (dolist (elt (secrets-search-items coll :host host) item) |
| 270 | (when (and (or (not user) |
| 271 | (string-equal |
| 272 | user (secrets-get-attribute coll elt :user))) |
| 273 | (or (not prot) |
| 274 | (string-equal |
| 275 | prot (secrets-get-attribute coll elt :protocol)))) |
| 276 | (setq item elt) |
| 277 | (return elt))) |
| 278 | ;; Compose result. |
| 279 | (when item |
| 280 | (setq result |
| 281 | (mapcar (lambda (m) |
| 282 | (if (string-equal "password" m) |
| 283 | (or (secrets-get-secret coll item) |
| 284 | ;; When we do not find a password, |
| 285 | ;; we return nil anyway. |
| 286 | (throw 'no-password nil)) |
| 287 | (or (secrets-get-attribute coll item :user) |
| 288 | user))) |
| 289 | (if (consp mode) mode (list mode))))) |
| 290 | (if (consp mode) result (car result)))) |
| 291 | ;; Anything else is netrc. |
| 292 | (t |
| 293 | (let ((search (list source (list host) (list (format "%s" prot)) |
| 294 | (auth-source-protocol-defaults prot)))) |
| 295 | (setq result |
| 296 | (mapcar (lambda (m) |
| 297 | (if (string-equal "password" m) |
| 298 | (or (apply |
| 299 | 'netrc-machine-user-or-password m search) |
| 300 | ;; When we do not find a password, we |
| 301 | ;; return nil anyway. |
| 302 | (throw 'no-password nil)) |
| 303 | (or (apply |
| 304 | 'netrc-machine-user-or-password m search) |
| 305 | user))) |
| 306 | (if (consp mode) mode (list mode))))) |
| 307 | (if (consp mode) result (car result))))))) |
| 308 | |
| 309 | (defun auth-source-create (mode entry &rest spec) |
| 310 | "Create interactively credentials according to SPEC in ENTRY. |
| 311 | Return structure as specified by MODE." |
| 312 | (let* ((host (plist-get spec :host)) |
| 313 | (user (plist-get spec :user)) |
| 314 | (prot (plist-get spec :protocol)) |
| 315 | (source (plist-get entry :source)) |
| 316 | (name (concat (if user (format "%s@" user)) |
| 317 | host |
| 318 | (if prot (format ":%s" prot)))) |
| 319 | result) |
| 320 | (setq result |
| 321 | (mapcar |
| 322 | (lambda (m) |
| 323 | (cons |
| 324 | m |
| 325 | (cond |
| 326 | ((equal "password" m) |
| 327 | (let ((passwd (read-passwd |
| 328 | (format "Password for %s on %s: " prot host)))) |
| 329 | (cond |
| 330 | ;; Secret Service API. |
| 331 | ((consp source) |
| 332 | (apply |
| 333 | 'secrets-create-item |
| 334 | (auth-get-source entry) name passwd spec)) |
| 335 | (t)) ;; netrc not implemented yes. |
| 336 | passwd)) |
| 337 | ((equal "login" m) |
| 338 | (or user |
| 339 | (read-string (format "User name for %s on %s: " prot host)))) |
| 340 | (t |
| 341 | "unknownuser")))) |
| 342 | (if (consp mode) mode (list mode)))) |
| 343 | ;; Allow the source to save the data. |
| 344 | (cond |
| 345 | ((consp source) |
| 346 | ;; Secret Service API -- not implemented. |
| 347 | ) |
| 348 | (t |
| 349 | ;; netrc interface. |
| 350 | (when (y-or-n-p (format "Do you want to save this password in %s? " |
| 351 | source)) |
| 352 | (netrc-store-data source host prot |
| 353 | (or user (cdr (assoc "login" result))) |
| 354 | (cdr (assoc "password" result)))))) |
| 355 | (if (consp mode) |
| 356 | (mapcar #'cdr result) |
| 357 | (cdar result)))) |
| 358 | |
| 359 | (defun auth-source-delete (entry &rest spec) |
| 360 | "Delete credentials according to SPEC in ENTRY." |
| 361 | (let ((host (plist-get spec :host)) |
| 362 | (user (plist-get spec :user)) |
| 363 | (prot (plist-get spec :protocol)) |
| 364 | (source (plist-get entry :source))) |
| 365 | (cond |
| 366 | ;; Secret Service API. |
| 367 | ((consp source) |
| 368 | (let ((coll (auth-get-source entry))) |
| 369 | ;; Loop over candidates with a matching host attribute. |
| 370 | (dolist (elt (secrets-search-items coll :host host)) |
| 371 | (when (and (or (not user) |
| 372 | (string-equal |
| 373 | user (secrets-get-attribute coll elt :user))) |
| 374 | (or (not prot) |
| 375 | (string-equal |
| 376 | prot (secrets-get-attribute coll elt :protocol)))) |
| 377 | (secrets-delete-item coll elt))))) |
| 378 | (t)))) ;; netrc not implemented yes. |
| 379 | |
| 380 | (defun auth-source-forget-user-or-password |
| 381 | (mode host protocol &optional username) |
| 382 | "Remove cached authentication token." |
| 383 | (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing |
| 384 | (remhash |
| 385 | (if username |
| 386 | (format "%s %s:%s %s" mode host protocol username) |
| 387 | (format "%s %s:%s" mode host protocol)) |
| 388 | auth-source-cache)) |
| 389 | |
| 390 | (defun auth-source-forget-all-cached () |
| 391 | "Forget all cached auth-source authentication tokens." |
| 392 | (interactive) |
| 393 | (setq auth-source-cache (make-hash-table :test 'equal))) |
| 394 | |
| 395 | ;; (progn |
| 396 | ;; (auth-source-forget-all-cached) |
| 397 | ;; (list |
| 398 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") |
| 399 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") |
| 400 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) |
| 401 | |
| 402 | (defun auth-source-user-or-password |
| 403 | (mode host protocol &optional username create-missing delete-existing) |
| 404 | "Find MODE (string or list of strings) matching HOST and PROTOCOL. |
| 405 | |
| 406 | USERNAME is optional and will be used as \"login\" in a search |
| 407 | across the Secret Service API (see secrets.el) if the resulting |
| 408 | items don't have a username. This means that if you search for |
| 409 | username \"joe\" and it matches an item but the item doesn't have |
| 410 | a :user attribute, the username \"joe\" will be returned. |
| 411 | |
| 412 | A non nil DELETE-EXISTING means deleting any matching password |
| 413 | entry in the respective sources. This is useful only when |
| 414 | CREATE-MISSING is non nil as well; the intended use case is to |
| 415 | remove wrong password entries. |
| 416 | |
| 417 | If no matching entry is found, and CREATE-MISSING is non nil, |
| 418 | the password will be retrieved interactively, and it will be |
| 419 | stored in the password database which matches best (see |
| 420 | `auth-sources'). |
| 421 | |
| 422 | MODE can be \"login\" or \"password\"." |
| 423 | (auth-source-do-debug |
| 424 | "auth-source-user-or-password: get %s for %s (%s) + user=%s" |
| 425 | mode host protocol username) |
| 426 | (let* ((listy (listp mode)) |
| 427 | (mode (if listy mode (list mode))) |
| 428 | (cname (if username |
| 429 | (format "%s %s:%s %s" mode host protocol username) |
| 430 | (format "%s %s:%s" mode host protocol))) |
| 431 | (search (list :host host :protocol protocol)) |
| 432 | (search (if username (append search (list :user username)) search)) |
| 433 | (found (if (not delete-existing) |
| 434 | (gethash cname auth-source-cache) |
| 435 | (remhash cname auth-source-cache) |
| 436 | nil))) |
| 437 | (if found |
| 438 | (progn |
| 439 | (auth-source-do-debug |
| 440 | "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" |
| 441 | mode |
| 442 | ;; don't show the password |
| 443 | (if (and (member "password" mode) auth-source-hide-passwords) |
| 444 | "SECRET" |
| 445 | found) |
| 446 | host protocol username) |
| 447 | found) ; return the found data |
| 448 | ;; else, if not found |
| 449 | (let ((choices (apply 'auth-source-pick search))) |
| 450 | (dolist (choice choices) |
| 451 | (if delete-existing |
| 452 | (apply 'auth-source-delete choice search) |
| 453 | (setq found (apply 'auth-source-retrieve mode choice search))) |
| 454 | (and found (return found))) |
| 455 | |
| 456 | ;; We haven't found something, so we will create it interactively. |
| 457 | (when (and (not found) create-missing) |
| 458 | (setq found (apply 'auth-source-create |
| 459 | mode (if choices |
| 460 | (car choices) |
| 461 | (car auth-sources)) |
| 462 | search))) |
| 463 | |
| 464 | ;; Cache the result. |
| 465 | (when found |
| 466 | (auth-source-do-debug |
| 467 | "auth-source-user-or-password: found %s=%s for %s (%s) + %s" |
| 468 | mode |
| 469 | ;; don't show the password |
| 470 | (if (and (member "password" mode) auth-source-hide-passwords) |
| 471 | "SECRET" found) |
| 472 | host protocol username) |
| 473 | (setq found (if listy found (car-safe found))) |
| 474 | (when auth-source-do-cache |
| 475 | (puthash cname found auth-source-cache))) |
| 476 | |
| 477 | found)))) |
| 478 | |
| 479 | (defun auth-source-protocol-defaults (protocol) |
| 480 | "Return a list of default ports and names for PROTOCOL." |
| 481 | (cdr-safe (assoc protocol auth-source-protocols))) |
| 482 | |
| 483 | (defun auth-source-user-or-password-imap (mode host) |
| 484 | (auth-source-user-or-password mode host 'imap)) |
| 485 | |
| 486 | (defun auth-source-user-or-password-pop3 (mode host) |
| 487 | (auth-source-user-or-password mode host 'pop3)) |
| 488 | |
| 489 | (defun auth-source-user-or-password-ssh (mode host) |
| 490 | (auth-source-user-or-password mode host 'ssh)) |
| 491 | |
| 492 | (defun auth-source-user-or-password-sftp (mode host) |
| 493 | (auth-source-user-or-password mode host 'sftp)) |
| 494 | |
| 495 | (defun auth-source-user-or-password-smtp (mode host) |
| 496 | (auth-source-user-or-password mode host 'smtp)) |
| 497 | |
| 498 | (provide 'auth-source) |
| 499 | |
| 500 | ;;; auth-source.el ends here |