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 'netrc)
  46 (require 'assoc)
  47 (eval-when-compile (require 'cl))
  48 (eval-and-compile
  49   (or (ignore-errors (require 'eieio))
  50       ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
  51       (ignore-errors
  52         (let ((load-path (cons (expand-file-name
  53                                 "gnus-fallback-lib/eieio"
  54                                 (file-name-directory (locate-library "gnus")))
  55                                load-path)))
  56           (require 'eieio)))
  57       (error
  58        "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
  59
  60 (autoload 'secrets-create-item "secrets")
  61 (autoload 'secrets-delete-item "secrets")
  62 (autoload 'secrets-get-alias "secrets")
  63 (autoload 'secrets-get-attributes "secrets")
  64 (autoload 'secrets-get-secret "secrets")
  65 (autoload 'secrets-list-collections "secrets")
  66 (autoload 'secrets-search-items "secrets")
  67
  68 (defvar secrets-enabled)
  69
  70 (defgroup auth-source nil
  71   "Authentication sources."
  72   :version "23.1" ;; No Gnus
  73   :group 'gnus)
  74
  75 ;;;###autoload
  76 (defcustom auth-source-cache-expiry 7200
  77   "How many seconds passwords are cached, or nil to disable
  78 expiring.  Overrides `password-cache-expiry' through a
  79 let-binding."
  80   :group 'auth-source
  81   :type '(choice (const :tag "Never" nil)
  82                  (const :tag "All Day" 86400)
  83                  (const :tag "2 Hours" 7200)
  84                  (const :tag "30 Minutes" 1800)
  85                  (integer :tag "Seconds")))
  86
  87 (defclass auth-source-backend ()
  88   ((type :initarg :type
  89          :initform 'netrc
  90          :type symbol
  91          :custom symbol
  92          :documentation "The backend type.")
  93    (source :initarg :source
  94            :type string
  95            :custom string
  96            :documentation "The backend source.")
  97    (host :initarg :host
  98          :initform t
  99          :type t
 100          :custom string
 101          :documentation "The backend host.")
 102    (user :initarg :user
 103          :initform t
 104          :type t
 105          :custom string
 106          :documentation "The backend user.")
 107    (port :initarg :port
 108          :initform t
 109          :type t
 110          :custom string
 111          :documentation "The backend protocol.")
 112    (create-function :initarg :create-function
 113                     :initform ignore
 114                     :type function
 115                     :custom function
 116                     :documentation "The create function.")
 117    (search-function :initarg :search-function
 118                     :initform ignore
 119                     :type function
 120                     :custom function
 121                     :documentation "The search function.")))
 122
 123 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
 124                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
 125                                    (ssh  "ssh" "22")
 126                                    (sftp "sftp" "115")
 127                                    (smtp "smtp" "25"))
 128   "List of authentication protocols and their names"
 129
 130   :group 'auth-source
 131   :version "23.2" ;; No Gnus
 132   :type '(repeat :tag "Authentication Protocols"
 133                  (cons :tag "Protocol Entry"
 134                        (symbol :tag "Protocol")
 135                        (repeat :tag "Names"
 136                                (string :tag "Name")))))
 137
 138 ;;; generate all the protocols in a format Customize can use
 139 ;;; TODO: generate on the fly from auth-source-protocols
 140 (defconst auth-source-protocols-customize
 141   (mapcar (lambda (a)
 142             (let ((p (car-safe a)))
 143               (list 'const
 144                     :tag (upcase (symbol-name p))
 145                     p)))
 146           auth-source-protocols))
 147
 148 (defvar auth-source-creation-defaults nil
 149   "Defaults for creating token values.  Usually let-bound.")
 150
 151 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 152
 153 (defvar auth-source-magic "auth-source-magic ")
 154
 155 (defcustom auth-source-do-cache t
 156   "Whether auth-source should cache information with `password-cache'."
 157   :group 'auth-source
 158   :version "23.2" ;; No Gnus
 159   :type `boolean)
 160
 161 (defcustom auth-source-debug nil
 162   "Whether auth-source should log debug messages.
 163
 164 If the value is nil, debug messages are not logged.
 165
 166 If the value is t, debug messages are logged with `message'.  In
 167 that case, your authentication data will be in the clear (except
 168 for passwords).
 169
 170 If the value is a function, debug messages are logged by calling
 171  that function using the same arguments as `message'."
 172   :group 'auth-source
 173   :version "23.2" ;; No Gnus
 174   :type `(choice
 175           :tag "auth-source debugging mode"
 176           (const :tag "Log using `message' to the *Messages* buffer" t)
 177           (function :tag "Function that takes arguments like `message'")
 178           (const :tag "Don't log anything" nil)))
 179
 180 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
 181   "List of authentication sources.
 182
 183 The default will get login and password information from
 184 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
 185 packages to be encrypted.  If that file doesn't exist, it will
 186 try the unencrypted version \"~/.authinfo\".
 187
 188 See the auth.info manual for details.
 189
 190 Each entry is the authentication type with optional properties.
 191
 192 It's best to customize this with `M-x customize-variable' because the choices
 193 can get pretty complex."
 194   :group 'auth-source
 195   :version "24.1" ;; No Gnus
 196   :type `(repeat :tag "Authentication Sources"
 197                  (choice
 198                   (string :tag "Just a file")
 199                   (const :tag "Default Secrets API Collection" 'default)
 200                   (const :tag "Login Secrets API Collection" "secrets:Login")
 201                   (const :tag "Temp Secrets API Collection" "secrets:session")
 202                   (list :tag "Source definition"
 203                         (const :format "" :value :source)
 204                         (choice :tag "Authentication backend choice"
 205                                 (string :tag "Authentication Source (file)")
 206                                 (list
 207                                  :tag "Secret Service API/KWallet/GNOME Keyring"
 208                                  (const :format "" :value :secrets)
 209                                  (choice :tag "Collection to use"
 210                                          (string :tag "Collection name")
 211                                          (const :tag "Default" 'default)
 212                                          (const :tag "Login" "Login")
 213                                          (const
 214                                           :tag "Temporary" "session"))))
 215                         (repeat :tag "Extra Parameters" :inline t
 216                                 (choice :tag "Extra parameter"
 217                                         (list
 218                                          :tag "Host"
 219                                          (const :format "" :value :host)
 220                                          (choice :tag "Host (machine) choice"
 221                                                  (const :tag "Any" t)
 222                                                  (regexp
 223                                                   :tag "Regular expression")))
 224                                         (list
 225                                          :tag "Protocol"
 226                                          (const :format "" :value :port)
 227                                          (choice
 228                                           :tag "Protocol"
 229                                           (const :tag "Any" t)
 230                                           ,@auth-source-protocols-customize))
 231                                         (list :tag "User" :inline t
 232                                               (const :format "" :value :user)
 233                                               (choice :tag "Personality/Username"
 234                                                       (const :tag "Any" t)
 235                                                       (string :tag "Name")))))))))
 236
 237 (defcustom auth-source-gpg-encrypt-to t
 238   "List of recipient keys that `authinfo.gpg' encrypted to.
 239 If the value is not a list, symmetric encryption will be used."
 240   :group 'auth-source
 241   :version "24.1" ;; No Gnus
 242   :type '(choice (const :tag "Symmetric encryption" t)
 243                  (repeat :tag "Recipient public keys"
 244                          (string :tag "Recipient public key"))))
 245
 246 ;; temp for debugging
 247 ;; (unintern 'auth-source-protocols)
 248 ;; (unintern 'auth-sources)
 249 ;; (customize-variable 'auth-sources)
 250 ;; (setq auth-sources nil)
 251 ;; (format "%S" auth-sources)
 252 ;; (customize-variable 'auth-source-protocols)
 253 ;; (setq auth-source-protocols nil)
 254 ;; (format "%S" auth-source-protocols)
 255 ;; (auth-source-pick nil :host "a" :port 'imap)
 256 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 257 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 258 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 259 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 260 ;; (auth-source-protocol-defaults 'imap)
 261
 262 ;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
 263 ;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
 264 ;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
 265 (defun auth-source-do-debug (&rest msg)
 266   (when auth-source-debug
 267     (apply 'auth-source-do-warn msg)))
 268
 269 (defun auth-source-do-warn (&rest msg)
 270   (apply
 271     ;; set logger to either the function in auth-source-debug or 'message
 272     ;; note that it will be 'message if auth-source-debug is nil
 273    (if (functionp auth-source-debug)
 274        auth-source-debug
 275      'message)
 276    msg))
 277
 278
 279 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 280 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 281 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 282 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 283 ;;                   (:source (:secrets "Login") :host t :port t)
 284 ;;                   (:source "~/.authinfo.gpg" :host t :port t)))
 285
 286 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 287 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 288 ;;                   (:source (:secrets "Login") :host t :port t)
 289 ;;                   ))
 290
 291 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
 292
 293 ;; (auth-source-backend-parse "myfile.gpg")
 294 ;; (auth-source-backend-parse 'default)
 295 ;; (auth-source-backend-parse "secrets:Login")
 296
 297 (defun auth-source-backend-parse (entry)
 298   "Creates an auth-source-backend from an ENTRY in `auth-sources'."
 299   (auth-source-backend-parse-parameters
 300    entry
 301    (cond
 302     ;; take 'default and recurse to get it as a Secrets API default collection
 303     ;; matching any user, host, and protocol
 304     ((eq entry 'default)
 305      (auth-source-backend-parse '(:source (:secrets default))))
 306     ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
 307     ;; matching any user, host, and protocol
 308     ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
 309      (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
 310     ;; take just a file name and recurse to get it as a netrc file
 311     ;; matching any user, host, and protocol
 312     ((stringp entry)
 313      (auth-source-backend-parse `(:source ,entry)))
 314
 315     ;; a file name with parameters
 316     ((stringp (plist-get entry :source))
 317      (auth-source-backend
 318       (plist-get entry :source)
 319       :source (plist-get entry :source)
 320       :type 'netrc
 321       :search-function 'auth-source-netrc-search
 322       :create-function 'auth-source-netrc-create))
 323
 324     ;; the Secrets API.  We require the package, in order to have a
 325     ;; defined value for `secrets-enabled'.
 326     ((and
 327       (not (null (plist-get entry :source))) ; the source must not be nil
 328       (listp (plist-get entry :source))      ; and it must be a list
 329       (require 'secrets nil t)               ; and we must load the Secrets API
 330       secrets-enabled)                       ; and that API must be enabled
 331
 332      ;; the source is either the :secrets key in ENTRY or
 333      ;; if that's missing or nil, it's "session"
 334      (let ((source (or (plist-get (plist-get entry :source) :secrets)
 335                        "session")))
 336
 337        ;; if the source is a symbol, we look for the alias named so,
 338        ;; and if that alias is missing, we use "Login"
 339        (when (symbolp source)
 340    &n