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 'gnus-util)
  43 (require 'netrc)
  44 (require 'assoc)
  45 (eval-when-compile (require 'cl))
  46 (eval-when-compile (require 'eieio))
  47
  48 (autoload 'secrets-create-item "secrets")
  49 (autoload 'secrets-delete-item "secrets")
  50 (autoload 'secrets-get-alias "secrets")
  51 (autoload 'secrets-get-attribute "secrets")
  52 (autoload 'secrets-get-secret "secrets")
  53 (autoload 'secrets-list-collections "secrets")
  54 (autoload 'secrets-search-items "secrets")
  55
  56 (defvar secrets-enabled)
  57
  58 (defgroup auth-source nil
  59   "Authentication sources."
  60   :version "23.1" ;; No Gnus
  61   :group 'gnus)
  62
  63 (defclass auth-source-backend ()
  64   ((type :initarg :type
  65          :initform 'netrc
  66          :type symbol
  67          :custom symbol
  68          :documentation "The backend type.")
  69    (source :initarg :source
  70            :type string
  71            :custom string
  72            :documentation "The backend source.")
  73    (host :initarg :host
  74          :initform t
  75          :type t
  76          :custom string
  77          :documentation "The backend host.")
  78    (user :initarg :user
  79          :initform t
  80          :type t
  81          :custom string
  82          :documentation "The backend user.")
  83    (protocol :initarg :protocol
  84              :initform t
  85              :type t
  86              :custom string
  87              :documentation "The backend protocol.")
  88    (create-function :initarg :create-function
  89                     :initform ignore
  90                     :type function
  91                     :custom function
  92                     :documentation "The create function.")
  93    (search-function :initarg :search-function
  94                     :initform ignore
  95                     :type function
  96                     :custom function
  97                     :documentation "The search function.")))
  98
  99 ;;(auth-source-backend "netrc" :type 'netrc)
 100
 101 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
 102                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
 103                                    (ssh  "ssh" "22")
 104                                    (sftp "sftp" "115")
 105                                    (smtp "smtp" "25"))
 106   "List of authentication protocols and their names"
 107
 108   :group 'auth-source
 109   :version "23.2" ;; No Gnus
 110   :type '(repeat :tag "Authentication Protocols"
 111                  (cons :tag "Protocol Entry"
 112                        (symbol :tag "Protocol")
 113                        (repeat :tag "Names"
 114                                (string :tag "Name")))))
 115
 116 ;;; generate all the protocols in a format Customize can use
 117 ;;; TODO: generate on the fly from auth-source-protocols
 118 (defconst auth-source-protocols-customize
 119   (mapcar (lambda (a)
 120             (let ((p (car-safe a)))
 121               (list 'const
 122                     :tag (upcase (symbol-name p))
 123                     p)))
 124           auth-source-protocols))
 125
 126 (defvar auth-source-creation-defaults nil
 127   "Defaults for creating token values.  Usually let-bound.")
 128
 129 (defvar auth-source-cache (make-hash-table :test 'equal)
 130   "Cache for auth-source data")
 131
 132 (defcustom auth-source-do-cache t
 133   "Whether auth-source should cache information."
 134   :group 'auth-source
 135   :version "23.2" ;; No Gnus
 136   :type `boolean)
 137
 138 (defcustom auth-source-debug nil
 139   "Whether auth-source should log debug messages.
 140 Also see `auth-source-hide-passwords'.
 141
 142 If the value is nil, debug messages are not logged.
 143 If the value is t, debug messages are logged with `message'.
 144  In that case, your authentication data will be in the
 145  clear (except for passwords, which are always stripped out).
 146 If the value is a function, debug messages are logged by calling
 147  that function using the same arguments as `message'."
 148   :group 'auth-source
 149   :version "23.2" ;; No Gnus
 150   :type `(choice
 151           :tag "auth-source debugging mode"
 152           (const :tag "Log using `message' to the *Messages* buffer" t)
 153           (function :tag "Function that takes arguments like `message'")
 154           (const :tag "Don't log anything" nil)))
 155
 156 (defcustom auth-source-hide-passwords t
 157   "Whether auth-source should hide passwords in log messages.
 158 Only relevant if `auth-source-debug' is not nil."
 159   :group 'auth-source
 160   :version "23.2" ;; No Gnus
 161   :type `boolean)
 162
 163 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
 164   "List of authentication sources.
 165
 166 The default will get login and password information from
 167 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
 168 packages to be encrypted.  If that file doesn't exist, it will
 169 try the unencrypted version \"~/.authinfo\".
 170
 171 See the auth.info manual for details.
 172
 173 Each entry is the authentication type with optional properties.
 174
 175 It's best to customize this with `M-x customize-variable' because the choices
 176 can get pretty complex."
 177   :group 'auth-source
 178   :version "24.1" ;; No Gnus
 179   :type `(repeat :tag "Authentication Sources"
 180                  (choice
 181                   (string :tag "Just a file")
 182                   (const :tag "Default Secrets API Collection" 'default)
 183                   (const :tag "Login Secrets API Collection" "secrets:login")
 184                   (const :tag "Temp Secrets API Collection" "secrets:session")
 185                   (list :tag "Source definition"
 186                         (const :format "" :value :source)
 187                         (choice :tag "Authentication backend choice"
 188                                 (string :tag "Authentication Source (file)")
 189                                 (list
 190                                  :tag "Secret Service API/KWallet/GNOME Keyring"
 191                                  (const :format "" :value :secrets)
 192                                  (choice :tag "Collection to use"
 193                                          (string :tag "Collection name")
 194                                          (const :tag "Default" 'default)
 195                                          (const :tag "Login" "login")
 196                                          (const