X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnetrc.el;h=ff0b52c2b9623a90fab70506bcdd9ceea24cbf4b;hp=85ab774910702cffc8e953b4692e301cfc6dd5a9;hb=a2556858067503fc6719a777279ace07db95735e;hpb=0d3661887445fbe805ab16d3496638122c97cab8 diff --git a/lisp/netrc.el b/lisp/netrc.el index 85ab77491..ff0b52c2b 100644 --- a/lisp/netrc.el +++ b/lisp/netrc.el @@ -1,27 +1,27 @@ ;;; netrc.el --- .netrc parsing functionality -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Modularizer: Ted Zlatanov ;; Keywords: news +;; +;; Modularized by Ted Zlatanov +;; when it was part of Gnus. ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -34,141 +34,88 @@ ;;; .netrc and .authinfo rc parsing ;;; -;; autoload password -(eval-and-compile - (autoload 'password-read "password")) +(defalias 'netrc-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position)) +(eval-when-compile + ;; This is unnecessary in the compiled version as it is a macro. + (if (fboundp 'bound-and-true-p) + (defalias 'netrc-bound-and-true-p 'bound-and-true-p) + (defmacro netrc-bound-and-true-p (var) + "Return the value of symbol VAR if it is bound, else nil." + `(and (boundp (quote ,var)) ,var)))) (defgroup netrc nil - "Netrc configuration.") - -(defcustom netrc-encrypting-method nil - "Decoding method used for the netrc file. -Use the OpenSSL symmetric ciphers here. Leave nil for no -decoding. Encrypt the file with netrc-encrypt, but make sure you -have set netrc-encrypting-method to a non-nil value." - :type '(choice - (const :tag "DES-3" "des3") - (const :tag "IDEA" "idea") - (const :tag "RC4" "rc4") - (string :tag "Explicit cipher name") - (const :tag "None" nil)) - :group 'netrc) + "Netrc configuration." + :group 'comm) -(defcustom netrc-openssl-path (executable-find "openssl") - "File path of the OpenSSL shell." - :type '(choice (file :tag "Location of openssl") - (const :tag "openssl is not installed" nil)) +(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-encrypt (plain-file encrypted-file) - (interactive "fPlain File: \nFEncrypted File: ") - "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher." - (when (and (file-exists-p plain-file) - (stringp encrypted-file) - netrc-encrypting-method - netrc-openssl-path) - (let ((buffer-file-coding-system 'binary) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (password - (password-read - (format "OpenSSL Password for cipher %s? " - netrc-encrypting-method) - (format "netrc-openssl-password-%s" - netrc-encrypting-method)))) - (when password - (with-temp-buffer - (insert-file-contents plain-file) - (setenv "NETRC_OPENSSL_PASSWORD" password) - (shell-command-on-region - (point-min) - (point-max) - (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e" - netrc-openssl-path - netrc-encrypting-method) - t - t) - (write-file encrypted-file t)))))) - -(defun netrc-parse (file) +(defun netrc-parse (&optional file) (interactive "fFile to Parse: ") - "Parse FILE and return an list of all entries in the file." - (when (file-exists-p file) - (with-temp-buffer - (let ((tokens '("machine" "default" "login" - "password" "account" "macdef" "force" - "port")) - alist elem result pair) - (if (and netrc-encrypting-method - netrc-openssl-path) - (let ((buffer-file-coding-system 'binary) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (password - (password-read - (format "OpenSSL Password for cipher %s? " - netrc-encrypting-method) - (format "netrc-openssl-password-%s" - netrc-encrypting-method)))) - (when password - (insert-file-contents file) - (setenv "NETRC_OPENSSL_PASSWORD" password) - (shell-command-on-region - (point-min) - (point-max) - (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d" - netrc-openssl-path - netrc-encrypting-method) - t - t))) - (insert-file-contents file)) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (point-at-eol)) - ;; For each line, get the tokens and values. + "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) + (with-temp-buffer + (let ((tokens '("machine" "default" "login" + "password" "account" "macdef" "force" + "port")) + alist elem result pair) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. (while (not (eobp)) - (skip-chars-forward "\t ") - ;; Skip lines that begin with a "#". - (if (eq (char-after) ?#) - (goto-char (point-max)) - (unless (eobp) - (setq elem - (if (= (following-char) ?\") - (read (current-buffer)) - (buffer-substring - (point) (progn (skip-chars-forward "^\t ") - (point))))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))))) - (when alist - (push (nreverse alist) result)) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - (nreverse result))))) + (narrow-to-region (point) (point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem + (if (= (following-char) ?\") + (read (current-buffer)) + (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point))))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + (when alist + (push (nreverse alist) result)) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + (nreverse result)))))) (defun netrc-machine (list machine &optional port defaultport) "Return the netrc values from LIST for MACHINE or for the default entry. @@ -184,17 +131,54 @@ 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") - (or (netrc-get (car result) "port") - defaultport "nntp")))) - (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. +Matches a machine from MACHINES and a port from PORTS, giving +default ports DEFAULTS to `netrc-machine'. + +MODE can be \"login\" or \"password\", suitable for passing to +`netrc-get'." + (let ((authinfo-list (if (stringp authinfo-file-or-list) + (netrc-parse authinfo-file-or-list) + authinfo-file-or-list)) + (ports (or ports '(nil))) + (defaults (or defaults '(nil))) + 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) "Return the value of token TYPE from ALIST." @@ -213,7 +197,7 @@ Entries without port tokens default to DEFAULTPORT." (with-temp-buffer (insert-file-contents netrc-services-file) (while (search-forward "#" nil t) - (delete-region (1- (point)) (line-end-position))) + (delete-region (1- (point)) (point-at-eol))) (goto-char (point-min)) (while (re-search-forward "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t) @@ -228,8 +212,7 @@ Entries without port tokens default to DEFAULTPORT." (setq type (or type 'tcp)) (while (and (setq service (pop services)) (not (and (= number (cadr service)) - (eq type (caddr service))))) - ) + (eq type (car (cddr service))))))) (car service))) (defun netrc-find-service-number (name &optional type) @@ -238,11 +221,36 @@ Entries without port tokens default to DEFAULTPORT." (setq type (or type 'tcp)) (while (and (setq service (pop services)) (not (and (string= name (car service)) - (eq type (caddr service))))) - ) + (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