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 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, or (at your option)
  13 ;; 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This is the auth-source.el package.  It lets users tell Gnus how to
  28 ;; authenticate in a single place.  Simplicity is the goal.  Instead
  29 ;; of providing 5000 options, we'll stick to simple, easy to
  30 ;; understand options.
  31
  32 ;; Easy setup:
  33 ;; (require 'auth-source)
  34 ;; (customize-variable 'auth-sources) ;; optional
  35
  36 ;; now, whatever sources you've defined for password have to be available
  37
  38 ;; if you want encrypted sources, which is strongly recommended, do
  39 ;; (require 'epa-file)
  40 ;; (epa-file-mode)
  41
  42 ;; before you put some data in ~/.authinfo.gpg (the default place)
  43
  44 ;;; For url-auth authentication (HTTP/HTTPS), you need to use:
  45
  46 ;;; machine yourmachine.com:80 port http login testuser password testpass
  47
  48 ;;; This will match any realm and authentication method (basic or
  49 ;;; digest).  If you want finer controls, explore the url-auth source
  50 ;;; code and variables.
  51
  52 ;;; (Tramp patch pending for this!)
  53 ;;; For tramp authentication, use:
  54
  55 ;;; machine yourmachine.com port tramp login testuser password testpass
  56
  57 ;;; Note that the port can be scp or ssh, for example, to match only
  58 ;;; those protocols.  When you use port = tramp, you match any Tramp
  59 ;;; protocol.
  60
  61 ;;; Code:
  62
  63 (require 'gnus-util)
  64
  65 (eval-when-compile (require 'cl))
  66 (eval-when-compile (require 'netrc))
  67
  68 (defgroup auth-source nil
  69   "Authentication sources."
  70   :version "23.1" ;; No Gnus
  71   :group 'gnus)
  72
  73 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
  74                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
  75                                    (ssh  "ssh" "22")
  76                                    (sftp "sftp" "115")
  77                                    (smtp "smtp" "25"))
  78   "List of authentication protocols and their names"
  79
  80   :group 'auth-source
  81   :version "23.1" ;; No Gnus
  82   :type '(repeat :tag "Authentication Protocols"
  83                  (cons :tag "Protocol Entry"
  84                        (symbol :tag "Protocol")
  85                        (repeat :tag "Names"
  86                                (string :tag "Name")))))
  87
  88 ;;; generate all the protocols in a format Customize can use
  89 (defconst auth-source-protocols-customize
  90   (mapcar (lambda (a)
  91             (let ((p (car-safe a)))
  92               (list 'const
  93                     :tag (upcase (symbol-name p))
  94                     p)))
  95           auth-source-protocols))
  96
  97 (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))
  98   "List of authentication sources.
  99
 100 Each entry is the authentication type with optional properties."
 101   :group 'auth-source
 102   :version "23.1" ;; No Gnus
 103   :type `(repeat :tag "Authentication Sources"
 104                  (list :tag "Source definition"
 105                        (const :format "" :value :source)
 106                        (string :tag "Authentication Source")
 107                        (const :format "" :value :host)
 108                        (choice :tag "Host (machine) choice"
 109                                (const :tag "Any" t)
 110                                (regexp :tag "Host (machine) regular expression (TODO)")
 111                                (const :tag "Fallback" nil))
 112                        (const :format "" :value :protocol)
 113                        (choice :tag "Protocol"
 114                                (const :tag "Any" t)
 115                                (const :tag "Fallback" nil)
 116                                ,@auth-source-protocols-customize))))
 117
 118 ;; temp for debugging
 119 ;; (unintern 'auth-source-protocols)
 120 ;; (unintern 'auth-sources)
 121 ;; (customize-variable 'auth-sources)
 122 ;; (setq auth-sources nil)
 123 ;; (format "%S" auth-sources)
 124 ;; (customize-variable 'auth-source-protocols)
 125 ;; (setq auth-source-protocols nil)
 126 ;; (format "%S" auth-source-protocols)
 127 ;; (auth-source-pick "a" 'imap)
 128 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 129 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 130 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 131 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 132 ;; (auth-source-protocol-defaults 'imap)
 133
 134 (defun auth-source-pick (host protocol &optional fallback)
 135   "Parse `auth-sources' for HOST, and PROTOCOL matches.
 136
 137 Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
 138   (interactive "sHost: \nsProtocol: \n") ;for testing
 139   (let (choices)
 140     (dolist (choice auth-sources)
 141       (let ((h (plist-get choice :host))
 142             (p (plist-get choice :protocol)))
 143         (when (and
 144                (or (equal t h)
 145                    (and (stringp h) (string-match h host))
 146                    (and fallback (equal h nil)))
 147                (or (equal t p)
 148                    (and (symbolp p) (equal p protocol))
 149                    (and fallback (equal p nil))))
 150           (push choice choices))))
 151     (if choices
 152         choices
 153       (unless fallback
 154         (auth-source-pick host protocol t)))))
 155
 156 (defun auth-source-user-or-password (mode host protocol)
 157   "Find user or password (from the string MODE) matching HOST and PROTOCOL."
 158   (gnus-message 9
 159                 "auth-source-user-or-password: get %s for %s (%s)"
 160                 mode host protocol)
 161   (let (found)
 162     (dolist (choice (auth-source-pick host protocol))
 163       (setq found (netrc-machine-user-or-password
 164                    mode
 165                    (plist-get choice :source)
 166                    (list host)
 167                    (list (format "%s" protocol))
 168                    (auth-source-protocol-defaults protocol)))
 169       (when found
 170         (gnus-message 9
 171                       "auth-source-user-or-password: found %s=%s for %s (%s)"
 172                       mode
 173                       ;; don't show the password
 174                       (if (equal mode "password") "SECRET" found)
 175                       host protocol)
 176         (return found)))))
 177
 178 (defun auth-source-protocol-defaults (protocol)
 179   "Return a list of default ports and names for PROTOCOL."
 180   (cdr-safe (assoc protocol auth-source-protocols)))
 181
 182 (defun auth-source-user-or-password-imap (mode host)
 183   (auth-source-user-or-password mode host 'imap))
 184
 185 (defun auth-source-user-or-password-pop3 (mode host)
 186   (auth-source-user-or-password mode host 'pop3))
 187
 188 (defun auth-source-user-or-password-ssh (mode host)
 189   (auth-source-user-or-password mode host 'ssh))
 190
 191 (defun auth-source-user-or-password-sftp (mode host)
 192   (auth-source-user-or-password mode host 'sftp))
 193
 194 (defun auth-source-user-or-password-smtp (mode host)
 195   (auth-source-user-or-password mode host 'smtp))
 196
 197 (provide 'auth-source)
 198
 199 ;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab
 200 ;;; auth-source.el ends here