gnus-util.el (iswitchb-mode): Declare

[gnus] / lisp / auth-source.el

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 467aa10..26994d5 100644 (file)
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1,6 +1,6 @@
 ;;; auth-source.el --- authentication sources for Gnus and Emacs
 
 ;;; auth-source.el --- authentication sources for Gnus and Emacs
 

-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.

 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news


@@ -42,17 +42,17 @@
 (require 'password-cache)
 (require 'mm-util)
 (require 'gnus-util)
 (require 'password-cache)
 (require 'mm-util)
 (require 'gnus-util)

-(require 'assoc)
+

 (eval-when-compile (require 'cl))
 (eval-and-compile
   (or (ignore-errors (require 'eieio))
       ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
       (ignore-errors
 (eval-when-compile (require 'cl))
 (eval-and-compile
   (or (ignore-errors (require 'eieio))
       ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
       (ignore-errors

-       (let ((load-path (cons (expand-file-name
-                               "gnus-fallback-lib/eieio"
-                               (file-name-directory (locate-library "gnus")))
-                              load-path)))
-         (require 'eieio)))
+        (let ((load-path (cons (expand-file-name
+                                "gnus-fallback-lib/eieio"
+                                (file-name-directory (locate-library "gnus")))
+                               load-path)))
+          (require 'eieio)))

       (error
        "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
 
       (error
        "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
 


@@ -64,6 +64,23 @@
 (autoload 'secrets-list-collections "secrets")
 (autoload 'secrets-search-items "secrets")
 
 (autoload 'secrets-list-collections "secrets")
 (autoload 'secrets-search-items "secrets")
 

+(autoload 'rfc2104-hash "rfc2104")
+
+(autoload 'plstore-open "plstore")
+(autoload 'plstore-find "plstore")
+(autoload 'plstore-put "plstore")
+(autoload 'plstore-delete "plstore")
+(autoload 'plstore-save "plstore")
+(autoload 'plstore-get-file "plstore")
+
+(autoload 'epg-make-context "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-context-set-armor "epg")
+(autoload 'epg-encrypt-string "epg")
+
+(autoload 'help-mode "help-mode" nil t)
+

 (defvar secrets-enabled)
 
 (defgroup auth-source nil
 (defvar secrets-enabled)
 
 (defgroup auth-source nil


@@ -76,6 +93,7 @@
   "How many seconds passwords are cached, or nil to disable
 expiring.  Overrides `password-cache-expiry' through a
 let-binding."
   "How many seconds passwords are cached, or nil to disable
 expiring.  Overrides `password-cache-expiry' through a
 let-binding."

+  :version "24.1"

   :group 'auth-source
   :type '(choice (const :tag "Never" nil)
                  (const :tag "All Day" 86400)
   :group 'auth-source
   :type '(choice (const :tag "Never" nil)
                  (const :tag "All Day" 86400)


@@ -83,6 +101,9 @@ let-binding."
                  (const :tag "30 Minutes" 1800)
                  (integer :tag "Seconds")))
 
                  (const :tag "30 Minutes" 1800)
                  (integer :tag "Seconds")))
 

+;; The slots below correspond with the `auth-source-search' spec,
+;; so a backend with :host set, for instance, would match only
+;; searches for that host.  Normally they are nil.

 (defclass auth-source-backend ()
   ((type :initarg :type
          :initform 'netrc
 (defclass auth-source-backend ()
   ((type :initarg :type
          :initform 'netrc


@@ -108,6 +129,9 @@ let-binding."
          :type t
          :custom string
          :documentation "The backend protocol.")
          :type t
          :custom string
          :documentation "The backend protocol.")

+   (data :initarg :data
+         :initform nil
+         :documentation "Internal backend data.")

    (create-function :initarg :create-function
                     :initform ignore
                     :type function
    (create-function :initarg :create-function
                     :initform ignore
                     :type function


@@ -134,8 +158,8 @@ let-binding."
                        (repeat :tag "Names"
                                (string :tag "Name")))))
 
                        (repeat :tag "Names"
                                (string :tag "Name")))))
 

-;;; generate all the protocols in a format Customize can use
-;;; TODO: generate on the fly from auth-source-protocols
+;; Generate all the protocols in a format Customize can use.
+;; TODO: generate on the fly from auth-source-protocols

 (defconst auth-source-protocols-customize
   (mapcar (lambda (a)
             (let ((p (car-safe a)))
 (defconst auth-source-protocols-customize
   (mapcar (lambda (a)
             (let ((p (car-safe a)))


@@ -147,8 +171,47 @@ let-binding."
 (defvar auth-source-creation-defaults nil
   "Defaults for creating token values.  Usually let-bound.")
 
 (defvar auth-source-creation-defaults nil
   "Defaults for creating token values.  Usually let-bound.")
 

+(defvar auth-source-creation-prompts nil
+  "Default prompts for token values.  Usually let-bound.")
+

 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 
 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 

+(defcustom auth-source-save-behavior 'ask
+  "If set, auth-source will respect it for save behavior."
+  :group 'auth-source
+  :version "23.2" ;; No Gnus
+  :type `(choice
+          :tag "auth-source new token save behavior"
+          (const :tag "Always save" t)
+          (const :tag "Never save" nil)
+          (const :tag "Ask" ask)))
+
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+
+(defcustom auth-source-netrc-use-gpg-tokens 'never
+  "Set this to tell auth-source when to create GPG password
+tokens in netrc files.  It's either an alist or `never'.
+Note that if EPA/EPG is not available, this should NOT be used."
+  :group 'auth-source
+  :version "23.2" ;; No Gnus
+  :type `(choice
+          (const :tag "Always use GPG password tokens" (t gpg))
+          (const :tag "Never use GPG password tokens" never)
+          (repeat :tag "Use a lookup list"
+                  (list
+                   (choice :tag "Matcher"
+                           (const :tag "Match anything" t)
+                           (const :tag "The EPA encrypted file extensions"
+                                  ,(if (boundp 'epa-file-auto-mode-alist-entry)
+                                       (car (symbol-value
+                                             'epa-file-auto-mode-alist-entry))
+                                     "\\.gpg\\'"))
+                           (regexp :tag "Regular expression"))
+                   (choice :tag "What to do"
+                           (const :tag "Save GPG-encrypted password tokens" gpg)
+                           (const :tag "Don't encrypt tokens" never))))))
+

 (defvar auth-source-magic "auth-source-magic ")
 
 (defcustom auth-source-do-cache t
 (defvar auth-source-magic "auth-source-magic ")
 
 (defcustom auth-source-do-cache t


@@ -178,18 +241,16 @@ If the value is a function, debug messages are logged by calling
           (function :tag "Function that takes arguments like `message'")
           (const :tag "Don't log anything" nil)))
 
           (function :tag "Function that takes arguments like `message'")
           (const :tag "Don't log anything" nil)))
 

-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
+(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")

   "List of authentication sources.
   "List of authentication sources.

-
-The default will get login and password information from
-\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
-packages to be encrypted.  If that file doesn't exist, it will
-try the unencrypted version \"~/.authinfo\" and the famous
-\"~/.netrc\" file.
-
-See the auth.info manual for details.
-

 Each entry is the authentication type with optional properties.
 Each entry is the authentication type with optional properties.

+Entries are tried in the order in which they appear.
+See Info node `(auth)Help for users' for details.
+
+If an entry names a file with the \".gpg\" extension and you have
+EPA/EPG set up, the file will be encrypted and decrypted
+automatically.  See Info node `(epa)Encrypting/decrypting gpg files'
+for details.

 
 It's best to customize this with `M-x customize-variable' because the choices
 can get pretty complex."
 
 It's best to customize this with `M-x customize-variable' because the choices
 can get pretty complex."


@@ -198,9 +259,16 @@ can get pretty complex."
   :type `(repeat :tag "Authentication Sources"
                  (choice
                   (string :tag "Just a file")
   :type `(repeat :tag "Authentication Sources"
                  (choice
                   (string :tag "Just a file")

-                  (const :tag "Default Secrets API Collection" 'default)
+                  (const :tag "Default Secrets API Collection" default)

                   (const :tag "Login Secrets API Collection" "secrets:Login")
                   (const :tag "Temp Secrets API Collection" "secrets:session")
                   (const :tag "Login Secrets API Collection" "secrets:Login")
                   (const :tag "Temp Secrets API Collection" "secrets:session")

+
+                  (const :tag "Default internet Mac OS Keychain"
+                         macos-keychain-internet)
+
+                  (const :tag "Default generic Mac OS Keychain"
+                         macos-keychain-generic)
+

                   (list :tag "Source definition"
                         (const :format "" :value :source)
                         (choice :tag "Authentication backend choice"
                   (list :tag "Source definition"
                         (const :format "" :value :source)
                         (choice :tag "Authentication backend choice"


@@ -210,10 +278,24 @@ can get pretty complex."
                                  (const :format "" :value :secrets)
                                  (choice :tag "Collection to use"
                                          (string :tag "Collection name")
                                  (const :format "" :value :secrets)
                                  (choice :tag "Collection to use"
                                          (string :tag "Collection name")

-                                         (const :tag "Default" 'default)
+                                         (const :tag "Default" default)

                                          (const :tag "Login" "Login")
                                          (const
                                          (const :tag "Login" "Login")
                                          (const

-                                          :tag "Temporary" "session"))))
+                                          :tag "Temporary" "session")))
+                                (list
+                                 :tag "Mac OS internet Keychain"
+                                 (const :format ""
+                                        :value :macos-keychain-internet)
+                                 (choice :tag "Collection to use"
+                                         (string :tag "internet Keychain path")
+                                         (const :tag "default" default)))
+                                (list
+                                 :tag "Mac OS generic Keychain"
+                                 (const :format ""
+                                        :value :macos-keychain-generic)
+                                 (choice :tag "Collection to use"
+                                         (string :tag "generic Keychain path")
+                                         (const :tag "default" default))))

                         (repeat :tag "Extra Parameters" :inline t
                                 (choice :tag "Extra parameter"
                                         (list
                         (repeat :tag "Extra Parameters" :inline t
                                 (choice :tag "Extra parameter"
                                         (list


@@ -232,9 +314,11 @@ can get pretty complex."
                                           ,@auth-source-protocols-customize))
                                         (list :tag "User" :inline t
                                               (const :format "" :value :user)
                                           ,@auth-source-protocols-customize))
                                         (list :tag "User" :inline t
                                               (const :format "" :value :user)

-                                              (choice :tag "Personality/Username"
-                                                      (const :tag "Any" t)
-                                                      (string :tag "Name")))))))))
+                                              (choice
+                                               :tag "Personality/Username"
+                                               (const :tag "Any" t)
+                                               (string
+                                                :tag "Name")))))))))

 
 (defcustom auth-source-gpg-encrypt-to t
   "List of recipient keys that `authinfo.gpg' encrypted to.
 
 (defcustom auth-source-gpg-encrypt-to t
   "List of recipient keys that `authinfo.gpg' encrypted to.


@@ -275,14 +359,36 @@ If the value is not a list, symmetric encryption will be used."
 
 (defun auth-source-do-warn (&rest msg)
   (apply
 
 (defun auth-source-do-warn (&rest msg)
   (apply

-    ;; set logger to either the function in auth-source-debug or 'message
-    ;; note that it will be 'message if auth-source-debug is nil
+   ;; set logger to either the function in auth-source-debug or 'message
+   ;; note that it will be 'message if auth-source-debug is nil

    (if (functionp auth-source-debug)
        auth-source-debug
      'message)
    msg))
 
 
    (if (functionp auth-source-debug)
        auth-source-debug
      'message)
    msg))
 
 

+;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+(defun auth-source-read-char-choice (prompt choices)
+  "Read one of CHOICES by `read-char-choice', or `read-char'.
+`dropdown-list' support is disabled because it doesn't work reliably.
+Only one of CHOICES will be returned.  The PROMPT is augmented
+with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+  (when choices
+    (let* ((prompt-choices
+            (apply 'concat (loop for c in choices
+                                 collect (format "%c/" c))))
+           (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
+           (full-prompt (concat prompt prompt-choices))
+           k)
+
+      (while (not (memq k choices))
+        (setq k (cond
+                 ((fboundp 'read-char-choice)
+                  (read-char-choice full-prompt choices))
+                 (t (message "%s" full-prompt)
+                    (setq k (read-char))))))
+      k)))
+

 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 ;; (setq auth-sources '((:source (