Changes committed gnus/lisp (ChangeLog auth-source.el)
"Ted Zlatanov" <[email protected]>
| Newsgroups | gmane.emacs.gnus.commits |
|---|---|
| Message-ID | <[email protected]> |
Modified: ChangeLog 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. Index: ChangeLog diff -u gnus/lisp/ChangeLog:7.1788 gnus/lisp/ChangeLog:7.1789 --- ChangeLog:7.1788 Wed Mar 12 02:27:58 2008 +++ ChangeLog Wed Mar 12 22:28:45 2008 @@ -1,3 +1,15 @@ +2008-03-12 Teodor Zlatanov <[email protected]> + + * 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 <[email protected]> * nntp.el (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet) Index: auth-source.el diff -u gnus/lisp/auth-source.el:7.2 gnus/lisp/auth-source.el:7.3 --- auth-source.el:7.2 Fri Mar 7 10:07:50 2008 +++ auth-source.el Wed Mar 12 22:28:45 2008 @@ -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 <[email protected]> ;; 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)