Commit | Line | Data |
---|---|---|
97b913ad | 1 | ;;; netrc.el --- .netrc parsing functionality |
5fd6d89f | 2 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
5df4f04c | 3 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
97b913ad RS |
4 | |
5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
6 | ;; Keywords: news | |
88f4758e | 7 | ;; |
97b913ad RS |
8 | ;; Modularized by Ted Zlatanov <tzz@lifelogs.com> |
9 | ;; when it was part of Gnus. | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
874a927a | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
97b913ad | 14 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
97b913ad RS |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
874a927a | 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
97b913ad RS |
21 | ;; GNU General Public License for more details. |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
97b913ad RS |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; Just the .netrc parsing functionality, abstracted so other packages | |
29 | ;; besides Gnus can use it. | |
30 | ||
31 | ;;; Code: | |
32 | ||
33 | ;;; | |
01c52d31 | 34 | ;;; .netrc and .authinfo rc parsing |
97b913ad RS |
35 | ;;; |
36 | ||
01c52d31 MB |
37 | (defgroup netrc nil |
38 | "Netrc configuration." | |
39 | :group 'comm) | |
40 | ||
a9ec34f4 LMI |
41 | (defcustom netrc-file "~/.authinfo" |
42 | "File where user credentials are stored." | |
43 | :type 'file | |
44 | :group 'netrc) | |
45 | ||
01c52d31 MB |
46 | (defvar netrc-services-file "/etc/services" |
47 | "The name of the services file.") | |
97b913ad | 48 | |
7410c270 G |
49 | (defvar netrc-cache nil) |
50 | ||
a9ec34f4 | 51 | (defun netrc-parse (&optional file) |
01c52d31 | 52 | (interactive "fFile to Parse: ") |
8f7abae3 | 53 | "Parse FILE and return a list of all entries in the file." |
a9ec34f4 LMI |
54 | (unless file |
55 | (setq file netrc-file)) | |
5b51650c | 56 | (if (listp file) |
7410c270 | 57 | ;; We got already parsed contents; just return it. |
5b51650c MB |
58 | file |
59 | (when (file-exists-p file) | |
60 | (with-temp-buffer | |
61 | (let ((tokens '("machine" "default" "login" | |
62 | "password" "account" "macdef" "force" | |
63 | "port")) | |
5b51650c | 64 | alist elem result pair) |
7410c270 G |
65 | (if (and netrc-cache |
66 | (equal (car netrc-cache) (nth 5 (file-attributes file)))) | |
67 | ;; Store the contents of the file heavily encrypted in memory. | |
68 | (insert (base64-decode-string (rot13-string (cdr netrc-cache)))) | |
69 | (insert-file-contents file) | |
70 | (when (string-match "\\.gpg\\'" file) | |
71 | (setq netrc-cache (cons (nth 5 (file-attributes file)) | |
72 | (rot13-string | |
73 | (base64-encode-string | |
74 | (buffer-string))))))) | |
5b51650c MB |
75 | (goto-char (point-min)) |
76 | ;; Go through the file, line by line. | |
97b913ad | 77 | (while (not (eobp)) |
5b51650c MB |
78 | (narrow-to-region (point) (point-at-eol)) |
79 | ;; For each line, get the tokens and values. | |
80 | (while (not (eobp)) | |
81 | (skip-chars-forward "\t ") | |
82 | ;; Skip lines that begin with a "#". | |
83 | (if (eq (char-after) ?#) | |
84 | (goto-char (point-max)) | |
85 | (unless (eobp) | |
86 | (setq elem | |
87 | (if (= (following-char) ?\") | |
88 | (read (current-buffer)) | |
89 | (buffer-substring | |
90 | (point) (progn (skip-chars-forward "^\t ") | |
91 | (point))))) | |
92 | (cond | |
93 | ((equal elem "macdef") | |
94 | ;; We skip past the macro definition. | |
95 | (widen) | |
96 | (while (and (zerop (forward-line 1)) | |
97 | (looking-at "$"))) | |
98 | (narrow-to-region (point) (point))) | |
99 | ((member elem tokens) | |
100 | ;; Tokens that don't have a following value are ignored, | |
101 | ;; except "default". | |
102 | (when (and pair (or (cdr pair) | |
103 | (equal (car pair) "default"))) | |
104 | (push pair alist)) | |
105 | (setq pair (list elem))) | |
106 | (t | |
107 | ;; Values that haven't got a preceding token are ignored. | |
108 | (when pair | |
109 | (setcdr pair elem) | |
110 | (push pair alist) | |
111 | (setq pair nil))))))) | |
112 | (when alist | |
113 | (push (nreverse alist) result)) | |
114 | (setq alist nil | |
115 | pair nil) | |
116 | (widen) | |
117 | (forward-line 1)) | |
118 | (nreverse result)))))) | |
97b913ad RS |
119 | |
120 | (defun netrc-machine (list machine &optional port defaultport) | |
121 | "Return the netrc values from LIST for MACHINE or for the default entry. | |
122 | If PORT specified, only return entries with matching port tokens. | |
123 | Entries without port tokens default to DEFAULTPORT." | |
124 | (let ((rest list) | |
125 | result) | |
126 | (while list | |
127 | (when (equal (cdr (assoc "machine" (car list))) machine) | |
128 | (push (car list) result)) | |
129 | (pop list)) | |
130 | (unless result | |
131 | ;; No machine name matches, so we look for default entries. | |
132 | (while rest | |
133 | (when (assoc "default" (car rest)) | |
6b958814 G |
134 | (let ((elem (car rest))) |
135 | (setq elem (delete (assoc "default" elem) elem)) | |
136 | (push elem result))) | |
97b913ad RS |
137 | (pop rest))) |
138 | (when result | |
139 | (setq result (nreverse result)) | |
6b958814 G |
140 | (if (not port) |
141 | (car result) | |
142 | (while (and result | |
143 | (not (netrc-port-equal | |
144 | (or port defaultport "nntp") | |
145 | ;; when port is not given in the netrc file, | |
146 | ;; it should mean "any port" | |
147 | (or (netrc-get (car result) "port") | |
148 | defaultport port)))) | |
149 | (pop result)) | |
150 | (car result))))) | |
97b913ad | 151 | |
01c52d31 MB |
152 | (defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults) |
153 | "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST. | |
154 | Matches a machine from MACHINES and a port from PORTS, giving | |
155 | default ports DEFAULTS to `netrc-machine'. | |
156 | ||
157 | MODE can be \"login\" or \"password\", suitable for passing to | |
158 | `netrc-get'." | |
159 | (let ((authinfo-list (if (stringp authinfo-file-or-list) | |
160 | (netrc-parse authinfo-file-or-list) | |
161 | authinfo-file-or-list)) | |
162 | (ports (or ports '(nil))) | |
163 | (defaults (or defaults '(nil))) | |
164 | info) | |
3b36c17e | 165 | (if (listp mode) |
c9fc72fa LMI |
166 | (setq info |
167 | (mapcar | |
168 | (lambda (mode-element) | |
3b36c17e MB |
169 | (netrc-machine-user-or-password |
170 | mode-element | |
171 | authinfo-list | |
172 | machines | |
173 | ports | |
174 | defaults)) | |
175 | mode)) | |
176 | (dolist (machine machines) | |
177 | (dolist (default defaults) | |
178 | (dolist (port ports) | |
179 | (let ((alist (netrc-machine authinfo-list machine port default))) | |
180 | (setq info (or (netrc-get alist mode) info))))))) | |
01c52d31 MB |
181 | info)) |
182 | ||
97b913ad RS |
183 | (defun netrc-get (alist type) |
184 | "Return the value of token TYPE from ALIST." | |
185 | (cdr (assoc type alist))) | |
186 | ||
01c52d31 MB |
187 | (defun netrc-port-equal (port1 port2) |
188 | (when (numberp port1) | |
189 | (setq port1 (or (netrc-find-service-name port1) port1))) | |
190 | (when (numberp port2) | |
191 | (setq port2 (or (netrc-find-service-name port2) port2))) | |
192 | (equal port1 port2)) | |
193 | ||
194 | (defun netrc-parse-services () | |
195 | (when (file-exists-p netrc-services-file) | |
196 | (let ((services nil)) | |
197 | (with-temp-buffer | |
198 | (insert-file-contents netrc-services-file) | |
199 | (while (search-forward "#" nil t) | |
200 | (delete-region (1- (point)) (point-at-eol))) | |
201 | (goto-char (point-min)) | |
202 | (while (re-search-forward | |
203 | "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t) | |
204 | (push (list (match-string 1) (string-to-number (match-string 2)) | |
205 | (intern (downcase (match-string 3)))) | |
206 | services)) | |
207 | (nreverse services))))) | |
208 | ||
209 | (defun netrc-find-service-name (number &optional type) | |
210 | (let ((services (netrc-parse-services)) | |
211 | service) | |
212 | (setq type (or type 'tcp)) | |
213 | (while (and (setq service (pop services)) | |
214 | (not (and (= number (cadr service)) | |
cb11d614 | 215 | (eq type (car (cddr service))))))) |
01c52d31 MB |
216 | (car service))) |
217 | ||
218 | (defun netrc-find-service-number (name &optional type) | |
219 | (let ((services (netrc-parse-services)) | |
220 | service) | |
221 | (setq type (or type 'tcp)) | |
222 | (while (and (setq service (pop services)) | |
223 | (not (and (string= name (car service)) | |
cb11d614 | 224 | (eq type (car (cddr service))))))) |
01c52d31 MB |
225 | (cadr service))) |
226 | ||
1821a7b4 LMI |
227 | (defun netrc-store-data (file host port user password) |
228 | (with-temp-buffer | |
229 | (when (file-exists-p file) | |
230 | (insert-file-contents file)) | |
231 | (goto-char (point-max)) | |
232 | (unless (bolp) | |
233 | (insert "\n")) | |
234 | (insert (format "machine %s login %s password %s port %s\n" | |
235 | host user password port)) | |
236 | (write-region (point-min) (point-max) file nil 'silent))) | |
237 | ||
20a673b2 | 238 | ;;;###autoload |
a9ec34f4 LMI |
239 | (defun netrc-credentials (machine &rest ports) |
240 | "Return a user name/password pair. | |
241 | Port specifications will be prioritised in the order they are | |
242 | listed in the PORTS list." | |
243 | (let ((list (netrc-parse)) | |
244 | found) | |
6b958814 G |
245 | (if (not ports) |
246 | (setq found (netrc-machine list machine)) | |
247 | (while (and ports | |
248 | (not found)) | |
249 | (setq found (netrc-machine list machine (pop ports))))) | |
a9ec34f4 LMI |
250 | (when found |
251 | (list (cdr (assoc "login" found)) | |
252 | (cdr (assoc "password" found)))))) | |
253 | ||
97b913ad RS |
254 | (provide 'netrc) |
255 | ||
256 | ;;; netrc.el ends here |