Mercurial > emacs
annotate lisp/net/netrc.el @ 91204:53108e6cea98
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-294
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 06 Dec 2007 09:51:45 +0000 |
parents | 880960b70474 d549ccffa35b |
children | 56a72e2bd635 |
rev | line source |
---|---|
44810 | 1 ;;; netrc.el --- .netrc parsing functionality |
64701
34bd8e434dd7
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
75347 | 3 ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
44810 | 4 |
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
6 ;; Keywords: news | |
7 ;; Modularized by Ted Zlatanov <tzz@lifelogs.com> | |
8 ;; when it was part of Gnus. | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
78230
84cf1e2214c5
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
14 ;; the Free Software Foundation; either version 3, or (at your option) |
44810 | 15 ;; any later version. |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
44810 | 26 |
27 ;;; Commentary: | |
28 | |
29 ;; Just the .netrc parsing functionality, abstracted so other packages | |
30 ;; besides Gnus can use it. | |
31 | |
32 ;;; Code: | |
33 | |
34 ;;; | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
35 ;;; .netrc and .authinfo rc parsing |
44810 | 36 ;;; |
37 | |
38 (defalias 'netrc-point-at-eol | |
39 (if (fboundp 'point-at-eol) | |
40 'point-at-eol | |
41 'line-end-position)) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
42 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
43 (defgroup netrc nil |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
44 "Netrc configuration." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
45 :group 'comm) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
46 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
47 (defvar netrc-services-file "/etc/services" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
48 "The name of the services file.") |
44810 | 49 |
50 (defun netrc-parse (file) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
51 (interactive "fFile to Parse: ") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
52 "Parse FILE and return an list of all entries in the file." |
44810 | 53 (when (file-exists-p file) |
54 (with-temp-buffer | |
55 (let ((tokens '("machine" "default" "login" | |
56 "password" "account" "macdef" "force" | |
57 "port")) | |
58 alist elem result pair) | |
86963
d549ccffa35b
(top-level): Don't load `encrypt' features.
Glenn Morris <rgm@gnu.org>
parents:
85712
diff
changeset
|
59 (insert-file-contents file) |
44810 | 60 (goto-char (point-min)) |
61 ;; Go through the file, line by line. | |
62 (while (not (eobp)) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
63 (narrow-to-region (point) (point-at-eol)) |
44810 | 64 ;; For each line, get the tokens and values. |
65 (while (not (eobp)) | |
66 (skip-chars-forward "\t ") | |
67 ;; Skip lines that begin with a "#". | |
68 (if (eq (char-after) ?#) | |
69 (goto-char (point-max)) | |
70 (unless (eobp) | |
71 (setq elem | |
72 (if (= (following-char) ?\") | |
73 (read (current-buffer)) | |
74 (buffer-substring | |
75 (point) (progn (skip-chars-forward "^\t ") | |
76 (point))))) | |
77 (cond | |
78 ((equal elem "macdef") | |
79 ;; We skip past the macro definition. | |
80 (widen) | |
81 (while (and (zerop (forward-line 1)) | |
82 (looking-at "$"))) | |
83 (narrow-to-region (point) (point))) | |
84 ((member elem tokens) | |
85 ;; Tokens that don't have a following value are ignored, | |
86 ;; except "default". | |
87 (when (and pair (or (cdr pair) | |
88 (equal (car pair) "default"))) | |
89 (push pair alist)) | |
90 (setq pair (list elem))) | |
91 (t | |
92 ;; Values that haven't got a preceding token are ignored. | |
93 (when pair | |
94 (setcdr pair elem) | |
95 (push pair alist) | |
96 (setq pair nil))))))) | |
97 (when alist | |
98 (push (nreverse alist) result)) | |
99 (setq alist nil | |
100 pair nil) | |
101 (widen) | |
102 (forward-line 1)) | |
103 (nreverse result))))) | |
104 | |
105 (defun netrc-machine (list machine &optional port defaultport) | |
106 "Return the netrc values from LIST for MACHINE or for the default entry. | |
107 If PORT specified, only return entries with matching port tokens. | |
108 Entries without port tokens default to DEFAULTPORT." | |
109 (let ((rest list) | |
110 result) | |
111 (while list | |
112 (when (equal (cdr (assoc "machine" (car list))) machine) | |
113 (push (car list) result)) | |
114 (pop list)) | |
115 (unless result | |
116 ;; No machine name matches, so we look for default entries. | |
117 (while rest | |
118 (when (assoc "default" (car rest)) | |
119 (push (car rest) result)) | |
120 (pop rest))) | |
121 (when result | |
122 (setq result (nreverse result)) | |
123 (while (and result | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
124 (not (netrc-port-equal |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
125 (or port defaultport "nntp") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
126 (or (netrc-get (car result) "port") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
127 defaultport "nntp")))) |
44810 | 128 (pop result)) |
129 (car result)))) | |
130 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
131 (defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
132 "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
133 Matches a machine from MACHINES and a port from PORTS, giving |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
134 default ports DEFAULTS to `netrc-machine'. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
135 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
136 MODE can be \"login\" or \"password\", suitable for passing to |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
137 `netrc-get'." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
138 (let ((authinfo-list (if (stringp authinfo-file-or-list) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
139 (netrc-parse authinfo-file-or-list) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
140 authinfo-file-or-list)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
141 (ports (or ports '(nil))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
142 (defaults (or defaults '(nil))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
143 info) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
144 (dolist (machine machines) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
145 (dolist (default defaults) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
146 (dolist (port ports) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
147 (let ((alist (netrc-machine authinfo-list machine port default))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
148 (setq info (or (netrc-get alist mode) info)))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
149 info)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
150 |
44810 | 151 (defun netrc-get (alist type) |
152 "Return the value of token TYPE from ALIST." | |
153 (cdr (assoc type alist))) | |
154 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
155 (defun netrc-port-equal (port1 port2) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
156 (when (numberp port1) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
157 (setq port1 (or (netrc-find-service-name port1) port1))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
158 (when (numberp port2) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
159 (setq port2 (or (netrc-find-service-name port2) port2))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
160 (equal port1 port2)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
161 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
162 (defun netrc-parse-services () |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
163 (when (file-exists-p netrc-services-file) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
164 (let ((services nil)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
165 (with-temp-buffer |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
166 (insert-file-contents netrc-services-file) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
167 (while (search-forward "#" nil t) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
168 (delete-region (1- (point)) (point-at-eol))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
169 (goto-char (point-min)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
170 (while (re-search-forward |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
171 "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
172 (push (list (match-string 1) (string-to-number (match-string 2)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
173 (intern (downcase (match-string 3)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
174 services)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
175 (nreverse services))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
176 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
177 (defun netrc-find-service-name (number &optional type) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
178 (let ((services (netrc-parse-services)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
179 service) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
180 (setq type (or type 'tcp)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
181 (while (and (setq service (pop services)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
182 (not (and (= number (cadr service)) |
86963
d549ccffa35b
(top-level): Don't load `encrypt' features.
Glenn Morris <rgm@gnu.org>
parents:
85712
diff
changeset
|
183 (eq type (car (cddr service))))))) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
184 (car service))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
185 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
186 (defun netrc-find-service-number (name &optional type) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
187 (let ((services (netrc-parse-services)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
188 service) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
189 (setq type (or type 'tcp)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
190 (while (and (setq service (pop services)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
191 (not (and (string= name (car service)) |
86963
d549ccffa35b
(top-level): Don't load `encrypt' features.
Glenn Morris <rgm@gnu.org>
parents:
85712
diff
changeset
|
192 (eq type (car (cddr service))))))) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
193 (cadr service))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78230
diff
changeset
|
194 |
44810 | 195 (provide 'netrc) |
196 | |
52401 | 197 ;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55 |
44810 | 198 ;;; netrc.el ends here |