X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnetrc.el;h=ff0b52c2b9623a90fab70506bcdd9ceea24cbf4b;hb=77f6f02bf2e5678361dc4489ad5b13502ded0021;hp=e526242e13596da7f4cdd12ff96bbc24f4ec3020;hpb=3c3280899283966946960d78bcd5682497df9014;p=gnus diff --git a/lisp/netrc.el b/lisp/netrc.el index e526242e1..ff0b52c2b 100644 --- a/lisp/netrc.el +++ b/lisp/netrc.el @@ -1,9 +1,10 @@ ;;; netrc.el --- .netrc parsing functionality ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news +;; ;; Modularized by Ted Zlatanov ;; when it was part of Gnus. @@ -33,14 +34,10 @@ ;;; .netrc and .authinfo rc parsing ;;; -;; use encrypt if loaded (encrypt-file-alist has to be set as well) -(autoload 'encrypt-find-model "encrypt") -(autoload 'encrypt-insert-file-contents "encrypt") (defalias 'netrc-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position)) -(defvar encrypt-file-alist) (eval-when-compile ;; This is unnecessary in the compiled version as it is a macro. (if (fboundp 'bound-and-true-p) @@ -53,12 +50,19 @@ "Netrc configuration." :group 'comm) +(defcustom netrc-file "~/.authinfo" + "File where user credentials are stored." + :type 'file + :group 'netrc) + (defvar netrc-services-file "/etc/services" "The name of the services file.") -(defun netrc-parse (file) +(defun netrc-parse (&optional file) (interactive "fFile to Parse: ") "Parse FILE and return a list of all entries in the file." + (unless file + (setq file netrc-file)) (if (listp file) file (when (file-exists-p file) @@ -66,12 +70,8 @@ (let ((tokens '("machine" "default" "login" "password" "account" "macdef" "force" "port")) - (encryption-model (when (netrc-bound-and-true-p encrypt-file-alist) - (encrypt-find-model file))) alist elem result pair) - (if encryption-model - (encrypt-insert-file-contents file encryption-model) - (insert-file-contents file)) + (insert-file-contents file) (goto-char (point-min)) ;; Go through the file, line by line. (while (not (eobp)) @@ -131,19 +131,23 @@ Entries without port tokens default to DEFAULTPORT." ;; No machine name matches, so we look for default entries. (while rest (when (assoc "default" (car rest)) - (push (car rest) result)) + (let ((elem (car rest))) + (setq elem (delete (assoc "default" elem) elem)) + (push elem result))) (pop rest))) (when result (setq result (nreverse result)) - (while (and result - (not (netrc-port-equal - (or port defaultport "nntp") - ;; when port is not given in the netrc file, - ;; it should mean "any port" - (or (netrc-get (car result) "port") - defaultport port)))) - (pop result)) - (car result)))) + (if (not port) + (car result) + (while (and result + (not (netrc-port-equal + (or port defaultport "nntp") + ;; when port is not given in the netrc file, + ;; it should mean "any port" + (or (netrc-get (car result) "port") + defaultport port)))) + (pop result)) + (car result))))) (defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults) "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST. @@ -158,11 +162,22 @@ MODE can be \"login\" or \"password\", suitable for passing to (ports (or ports '(nil))) (defaults (or defaults '(nil))) info) - (dolist (machine machines) - (dolist (default defaults) - (dolist (port ports) - (let ((alist (netrc-machine authinfo-list machine port default))) - (setq info (or (netrc-get alist mode) info)))))) + (if (listp mode) + (setq info + (mapcar + (lambda (mode-element) + (netrc-machine-user-or-password + mode-element + authinfo-list + machines + ports + defaults)) + mode)) + (dolist (machine machines) + (dolist (default defaults) + (dolist (port ports) + (let ((alist (netrc-machine authinfo-list machine port default))) + (setq info (or (netrc-get alist mode) info))))))) info)) (defun netrc-get (alist type) @@ -209,7 +224,33 @@ MODE can be \"login\" or \"password\", suitable for passing to (eq type (car (cddr service))))))) (cadr service))) +(defun netrc-store-data (file host port user password) + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "machine %s login %s password %s port %s\n" + host user password port)) + (write-region (point-min) (point-max) file nil 'silent))) + +;;;###autoload +(defun netrc-credentials (machine &rest ports) + "Return a user name/password pair. +Port specifications will be prioritised in the order they are +listed in the PORTS list." + (let ((list (netrc-parse)) + found) + (if (not ports) + (setq found (netrc-machine list machine)) + (while (and ports + (not found)) + (setq found (netrc-machine list machine (pop ports))))) + (when found + (list (cdr (assoc "login" found)) + (cdr (assoc "password" found)))))) + (provide 'netrc) -;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55 ;;; netrc.el ends here