(auth-source-protocols)

(auth-source-protocols-customize, auth-source-choices): Added and
modified variable customizations and defaults.
(auth-source-pick, auth-source-user-or-password)
(auth-source-protocol-defaults, auth-source-user-or-password-imap)
(auth-source-user-or-password-pop3, auth-source-user-or-password-ssh)
(auth-source-user-or-password-sftp)
(auth-source-user-or-password-smtp): Use new variables and provide an
interface to netrc.el.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9c4511a..aef5a01 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2008-03-12  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * auth-source.el (auth-source-protocols)
+       (auth-source-protocols-customize, auth-source-choices): Added and
+       modified variable customizations and defaults.
+       (auth-source-pick, auth-source-user-or-password)
+       (auth-source-protocol-defaults, auth-source-user-or-password-imap)
+       (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh)
+       (auth-source-user-or-password-sftp)
+       (auth-source-user-or-password-smtp): Use new variables and provide an
+       interface to netrc.el.
+
 2008-03-12  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * nntp.el (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet)

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 116d8b4..8aaa253 100644 (file)
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1,7 +1,6 @@
 ;;; auth-source.el --- authentication sources for Gnus and Emacs
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news
@@ -32,53 +31,128 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'netrc))
 
 (defgroup auth-source nil
   "Authentication sources."
-  :version "22.1"
+  :version "23.1" ;; No Gnus
   :group 'gnus)
 
-(defcustom auth-source-choices nil
+(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
+                                  (pop3 "pop3" "pop" "pop3s" "110" "995")
+                                  (ssh  "ssh" "22")
+                                  (sftp "sftp" "115")
+                                  (smtp "smtp" "25"))
+  "List of authentication protocols and their names"
+
+  :group 'auth-source
+  :version "23.1" ;; No Gnus
+  :type '(repeat :tag "Authentication Protocols"
+                (cons :tag "Protocol Entry"
+                      (symbol :tag "Protocol")
+                      (repeat :tag "Names"
+                              (string :tag "Name")))))
+
+;;; generate all the protocols in a format Customize can use
+(defconst auth-source-protocols-customize
+  (mapcar (lambda (a)
+           (let ((p (car-safe a)))
+             (list 'const 
+                   :tag (upcase (symbol-name p))
+                   p)))
+         auth-source-protocols))
+
+;;; this default will be changed to ~/.authinfo.gpg
+(defcustom auth-source-choices '((:source "~/.authinfo.enc" :host t :protocol t))
   "List of authentication sources.
 
 Each entry is the authentication type with optional properties."
   :group 'auth-source
-  :type '(repeat :tag "Authentication Sources"
-                (cons :tag "Source definition"
-                      (group :tag "Select a source" :inline t
-                             (const :format "" :value :source)
-                             (choice :tag "Authentication information"
-                                     (const :tag "None" nil)
-                                     (file :tag "File")))
-                      (checklist :tag "Options" :greedy t
-                                 (group :inline t
-                                        (choice :tag "Choose the hosts"
-                                         (group :tag "Select host by name" :inline t
-                                                (const :format "" :value :host)
-                                                (string :tag "Host name"))
-                                         (group :tag "Select host by regular expression" :inline t
-                                                (const :format "" :value :host-regex)
-                                                (regexp :tag "Host regular expression"))
-                                         (group :tag "Use any host" :inline t
-                                                (const :format "" :value :host-any)
-                                                (const :tag "Any" t))
-                                         (group :tag "Use if no other host matches" :inline t
-                                                (const :tag "Fallback" nil))))
-                                 (group :tag "Choose the protocol" :inline t
-                                        (const :format "" :value :protocol)
-                                        (choice :tag "Protocol"
-                                                (const :tag "Any" t)
-                                                (const :tag "Fallback (used if no others match)" nil)
-                                                (const :tag "IMAP" imap)
-                                                (const :tag "POP3" pop3)
-                                                (const :tag "SSH"  ssh)
-                                                (const :tag "SFTP" sftp)
-                                                (const :tag "SMTP" smtp)))))))
+  :version "23.1" ;; No Gnus
+  :type `(repeat :tag "Authentication Sources"
+                (list :tag "Source definition"
+                      (const :format "" :value :source)
+                      (string :tag "Authentication Source")
+                      (const :format "" :value :host)
+                      (choice :tag "Host choice"
+                              (const :tag "Any" t)
+                              (regexp :tag "Host regular expression (TODO)")
+                              (const :tag "Fallback" nil))
+                      (const :format "" :value :protocol)
+                      (choice :tag "Protocol"
+                              (const :tag "Any" t)
+                              (const :tag "Fallback" nil)
+                              ,@auth-source-protocols-customize))))
 
 ;; temp for debugging
+;; (unintern 'auth-source-protocols)
+;; (unintern 'auth-source-choices)
 ;; (customize-variable 'auth-source-choices)
 ;; (setq auth-source-choices nil)
 ;; (format "%S" auth-source-choices)
+;; (customize-variable 'auth-source-protocols)
+;; (setq auth-source-protocols nil)
+;; (format "%S" auth-source-protocols)
+;; (auth-source-pick "a" 'imap)
+;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
+;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
+;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
+;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
+;; (auth-source-protocol-defaults 'imap)
+
+(defun auth-source-pick (host protocol &optional fallback)
+  "Parse `auth-source-choices' for HOST and PROTOCOL matches.
+
+Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
+  (interactive "sHost: \nsProtocol: \n") ;for testing
+  (let (choices)
+    (dolist (choice auth-source-choices)
+      (let ((h (plist-get choice :host))
+           (p (plist-get choice :protocol)))
+       (when (and
+              (or (equal t h)
+                  (and (stringp h) (string-match h host))
+                  (and fallback (equal h nil)))
+              (or (equal t p)
+                  (and (symbolp p) (equal p protocol))
+                  (and fallback (equal p nil))))
+         (push choice choices))))
+    (if choices
+       choices
+      (unless fallback
+       (auth-source-pick host protocol t)))))
+
+(defun auth-source-user-or-password (mode host protocol)
+  "Find user or password (from the string MODE) matching HOST and PROTOCOL."
+  (let (found)
+    (dolist (choice (auth-source-pick host protocol))
+      (setq found (netrc-machine-user-or-password 
+                  mode
+                  (plist-get choice :source)
+                  (list host)
+                  (list (format "%s" protocol))
+                  (auth-source-protocol-defaults protocol)))
+      (when found
+       (return found)))))
+
+(defun auth-source-protocol-defaults (protocol)
+  "Return a list of default ports and names for PROTOCOL."
+  (cdr-safe (assoc protocol auth-source-protocols)))
+
+(defun auth-source-user-or-password-imap (mode host)
+  (auth-source-user-or-password mode host 'imap))
+
+(defun auth-source-user-or-password-pop3 (mode host)
+  (auth-source-user-or-password mode host 'pop3))
+
+(defun auth-source-user-or-password-ssh (mode host)
+  (auth-source-user-or-password mode host 'ssh))
+
+(defun auth-source-user-or-password-sftp (mode host)
+  (auth-source-user-or-password mode host 'sftp))
+
+(defun auth-source-user-or-password-smtp (mode host)
+  (auth-source-user-or-password mode host 'smtp))
 
 (provide 'auth-source)