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, 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 ;;; Code:
  33
  34 (require 'gnus-util)
  35
  36 (eval-when-compile (require 'cl))
  37 (eval-when-compile (require 'netrc))
  38
  39 (autoload 'secrets-search-items "secrets")
  40 (autoload 'secrets-get-alias "secrets")
  41 (autoload 'secrets-get-attribute "secrets")
  42
  43 (defgroup auth-source nil
  44   "Authentication sources."
  45   :version "23.1" ;; No Gnus
  46   :group 'gnus)
  47
  48 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
  49                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
  50                                    (ssh  "ssh" "22")
  51                                    (sftp "sftp" "115")
  52                                    (smtp "smtp" "25"))
  53   "List of authentication protocols and their names"
  54
  55   :group 'auth-source
  56   :version "23.2" ;; No Gnus
  57   :type '(repeat :tag "Authentication Protocols"
  58                  (cons :tag "Protocol Entry"
  59                        (symbol :tag "Protocol")
  60                        (repeat :tag "Names"
  61                                (string :tag "Name")))))
  62
  63 ;;; generate all the protocols in a format Customize can use
  64 (defconst auth-source-protocols-customize
  65   (mapcar (lambda (a)
  66             (let ((p (car-safe a)))
  67               (list 'const
  68                     :tag (upcase (symbol-name p))
  69                     p)))
  70           auth-source-protocols))
  71
  72 (defvar auth-source-cache (make-hash-table :test 'equal)
  73   "Cache for auth-source data")
  74
  75 (defcustom auth-source-do-cache t
  76   "Whether auth-source should cache information."
  77   :group 'auth-source
  78   :version "23.2" ;; No Gnus
  79   :type `boolean)
  80
  81 (defcustom auth-source-debug nil
  82   "Whether auth-source should log debug messages.
  83 Also see `auth-source-hide-passwords'.
  84
  85 If the value is nil, debug messages are not logged.
  86 If the value is t, debug messages are logged with `message'.
  87  In that case, your authentication data will be in the
  88  clear (except for passwords, which are always stripped out).
  89 If the value is a function, debug messages are logged by calling
  90  that function using the same arguments as `message'."
  91   :group 'auth-source
  92   :version "23.2" ;; No Gnus
  93   :type `(choice
  94           :tag "auth-source debugging mode"
  95           (const :tag "Log using `message' to the *Messages* buffer" t)
  96           (function :tag "Function that takes arguments like `message'")
  97           (const :tag "Don't log anything" nil)))
  98
  99 (defcustom auth-source-hide-passwords t
 100   "Whether auth-source should hide passwords in log messages.
 101 Only relevant if `auth-source-debug' is not nil."
 102   :group 'auth-source
 103   :version "23.2" ;; No Gnus
 104   :type `boolean)
 105
 106 (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t nil))
 107   "List of authentication sources.
 108
 109 Each entry is the authentication type with optional properties.
 110
 111 It's best to customize this with `M-x customize-variable' because the choices
 112 can get pretty complex."
 113   :group 'auth-source
 114   :version "23.2" ;; No Gnus
 115   :type `(repeat :tag "Authentication Sources"
 116                  (list :tag "Source definition"
 117                        (const :format "" :value :source)
 118                        (choice :tag "Authentication backend choice"
 119                                (string :tag "Authentication Source (file)")
 120                                (list :tag "secrets.el (Secret Service API/KWallet/GNOME KeyRing)"
 121                                      (const :format "" :value :secrets)
 122                                      (choice :tag "Collection to use"
 123                                              (string :tag "Collection name")
 124                                              (const :tag "Default" 'default)
 125                                              (const :tag "Any" t)
 126                                              (const :tag "Temporary" "session")
 127                                              (string :tag "Specific session name")
 128                                              (const :tag "Fallback" nil))))
 129                        (const :format "" :value :host)
 130                        (choice :tag "Host (machine) choice"
 131                                (const :tag "Any" t)
 132                                (regexp :tag "Host (machine) regular expression (TODO)")
 133                                (const :tag "Fallback" nil))
 134                        (const :format "" :value :protocol)
 135                        (choice :tag "Protocol"
 136                                (const :tag "Any" t)
 137                                (const :tag "Fallback" nil)
 138                                ,@auth-source-protocols-customize)
 139                        (repeat :tag "Extra Parameters"
 140                                (choice :tag "Extra parameter"
 141                                        (list :tag "Preferred username"
 142                                              (const :format "" :value :preferred-username)
 143                                              (choice :tag "Personality or username"
 144                                                      (const :tag "Any" t)
 145                                                      (const :tag "Fallback" nil)
 146                                                      (string :tag "Specific user name"))))))))
 147
 148 ;; temp for debugging
 149 ;; (unintern 'auth-source-protocols)
 150 ;; (unintern 'auth-sources)
 151 ;; (customize-variable 'auth-sources)
 152 ;; (setq auth-sources nil)
 153 ;; (format "%S" auth-sources)
 154 ;; (customize-variable 'auth-source-protocols)
 155 ;; (setq auth-source-protocols nil)
 156 ;; (format "%S" auth-source-protocols)
 157 ;; (auth-source-pick "a" 'imap)
 158 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 159 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 160 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 161 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 162 ;; (auth-source-protocol-defaults 'imap)
 163
 164 ;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello"))
 165 ;; (let ((auth-source-debug t)) (auth-source-debug "hello"))
 166 ;; (let ((auth-source-debug nil)) (auth-source-debug "hello"))
 167 (defun auth-source-do-debug (&rest msg)
 168   ;; set logger to either the function in auth-source-debug or 'message
 169   ;; note that it will be 'message if auth-source-debug is nil, so
 170   ;; we also check the value
 171   (when auth-source-debug
 172     (let ((logger (if (functionp auth-source-debug)
 173                       auth-source-debug
 174                     'message)))
 175       (apply logger msg))))
 176
 177 (defun auth-source-pick (host protocol &optional fallback)
 178   "Parse `auth-sources' for HOST, and PROTOCOL matches.
 179
 180 Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
 181   (interactive "sHost: \nsProtocol: \n") ;for testing
 182   (let (choices)
 183     (dolist (choice auth-sources)
 184       (let ((h (plist-get choice :host))
 185             (p (plist-get choice :protocol)))
 186         (when (and
 187                (or (equal t h)
 188                    (and (stringp h) (string-match h host))
 189                    (and fallback (equal h nil)))
 190                (or (equal t p)
 191                    (and (symbolp p) (equal p protocol))
 192                    (and fallback (equal p nil))))
 193           (push choice choices))))
 194     (if choices
 195         choices
 196       (unless fallback
 197         (auth-source-pick host protocol t)))))
 198
 199 (defun auth-source-forget-user-or-password (mode host protocol)
 200   (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
 201   (remhash (format "%s %s:%s" mode host protocol) auth-source-cache))
 202
 203 (defun auth-source-forget-all-cached ()
 204   "Forget all cached auth-source authentication tokens."
 205   (interactive)
 206   (setq auth-source-cache (make-hash-table :test 'equal)))
 207
 208 (defun auth-source-user-or-password (mode host protocol)
 209   "Find MODE (string or list of strings) matching HOST and PROTOCOL.
 210 MODE can be \"login\" or \"password\" for example."
 211   (auth-source-do-debug
 212    "auth-source-user-or-password: get %s for %s (%s)"
 213    mode host protocol)
 214   (let* ((listy (listp mode))
 215          (mode (if listy mode (list mode)))
 216          (cname (format "%s %s:%s" mode host protocol))
 217          (found (gethash cname auth-source-cache)))
 218     (if found
 219         (progn
 220           (auth-source-do-debug
 221            "auth-source-user-or-password: cached %s=%s for %s (%s)"
 222            mode
 223            ;; don't show the password
 224            (if (and (member "password" mode) auth-source-hide-passwords) "SECRET" found)
 225            host protocol)
 226           found)
 227       (dolist (choice (auth-source-pick host protocol))
 228         (setq found (netrc-machine-user-or-password
 229                      mode
 230                      (plist-get choice :source)
 231                      (list host)
 232                      (list (format "%s" protocol))
 233                      (auth-source-protocol-defaults protocol)))
 234         (when found
 235           (auth-source-do-debug
 236            "auth-source-user-or-password: found %s=%s for %s (%s)"
 237            mode
 238            ;; don't show the password
 239            (if (and (member "password" mode) auth-source-hide-passwords) "SECRET" found)
 240            host protocol)
 241           (setq found (if listy found (car-safe found)))
 242           (when auth-source-do-cache
 243             (puthash cname found auth-source-cache)))
 244         (return found)))))
 245
 246 (defun auth-source-protocol-defaults (protocol)
 247   "Return a list of default ports and names for PROTOCOL."
 248   (cdr-safe (assoc protocol auth-source-protocols)))
 249
 250 (defun auth-source-user-or-password-imap (mode host)
 251   (auth-source-user-or-password mode host 'imap))
 252
 253 (defun auth-source-user-or-password-pop3 (mode host)
 254   (auth-source-user-or-password mode host 'pop3))
 255
 256 (defun auth-source-user-or-password-ssh (mode host)
 257   (auth-source-user-or-password mode host 'ssh))
 258
 259 (defun auth-source-user-or-password-sftp (mode host)
 260   (auth-source-user-or-password mode host 'sftp))
 261
 262 (defun auth-source-user-or-password-smtp (mode host)
 263   (auth-source-user-or-password mode host 'smtp))
 264
 265 (provide 'auth-source)
 266
 267 ;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab
 268 ;;; auth-source.el ends here