Commit | Line | Data |
---|---|---|
406c51ee JH |
1 | # Net::Netrc.pm |
2 | # | |
3 | # Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved. | |
4 | # This program is free software; you can redistribute it and/or | |
5 | # modify it under the same terms as Perl itself. | |
6 | ||
7 | package Net::Netrc; | |
8 | ||
9 | use Carp; | |
10 | use strict; | |
11 | use FileHandle; | |
12 | use vars qw($VERSION); | |
13 | ||
b3f6f6a6 | 14 | $VERSION = "2.12"; |
406c51ee JH |
15 | |
16 | my %netrc = (); | |
17 | ||
b3f6f6a6 RGS |
18 | |
19 | sub _readrc { | |
20 | my $host = shift; | |
21 | my ($home, $file); | |
22 | ||
23 | if ($^O eq "MacOS") { | |
24 | $home = $ENV{HOME} || `pwd`; | |
25 | chomp($home); | |
26 | $file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc"); | |
27 | } | |
28 | else { | |
29 | ||
30 | # Some OS's don't have `getpwuid', so we default to $ENV{HOME} | |
31 | $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; | |
32 | $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE}; | |
33 | $file = $home . "/.netrc"; | |
34 | } | |
35 | ||
36 | my ($login, $pass, $acct) = (undef, undef, undef); | |
37 | my $fh; | |
38 | local $_; | |
39 | ||
40 | $netrc{default} = undef; | |
41 | ||
42 | # OS/2 and Win32 do not handle stat in a way compatable with this check :-( | |
43 | unless ($^O eq 'os2' | |
44 | || $^O eq 'MSWin32' | |
45 | || $^O eq 'MacOS' | |
46 | || $^O =~ /^cygwin/) | |
47 | { | |
48 | my @stat = stat($file); | |
49 | ||
50 | if (@stat) { | |
51 | if ($stat[2] & 077) { | |
52 | carp "Bad permissions: $file"; | |
53 | return; | |
406c51ee | 54 | } |
b3f6f6a6 RGS |
55 | if ($stat[4] != $<) { |
56 | carp "Not owner: $file"; | |
57 | return; | |
406c51ee JH |
58 | } |
59 | } | |
60 | } | |
61 | ||
b3f6f6a6 RGS |
62 | if ($fh = FileHandle->new($file, "r")) { |
63 | my ($mach, $macdef, $tok, @tok) = (0, 0); | |
406c51ee | 64 | |
b3f6f6a6 RGS |
65 | while (<$fh>) { |
66 | undef $macdef if /\A\n\Z/; | |
406c51ee | 67 | |
b3f6f6a6 RGS |
68 | if ($macdef) { |
69 | push(@$macdef, $_); | |
70 | next; | |
406c51ee JH |
71 | } |
72 | ||
b3f6f6a6 RGS |
73 | s/^\s*//; |
74 | chomp; | |
12df23ee | 75 | |
b3f6f6a6 RGS |
76 | while (length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) { |
77 | (my $tok = $+) =~ s/\\(.)/$1/g; | |
78 | push(@tok, $tok); | |
79 | } | |
406c51ee | 80 | |
b3f6f6a6 RGS |
81 | TOKEN: |
82 | while (@tok) { | |
83 | if ($tok[0] eq "default") { | |
84 | shift(@tok); | |
85 | $mach = bless {}; | |
86 | $netrc{default} = [$mach]; | |
406c51ee | 87 | |
b3f6f6a6 | 88 | next TOKEN; |
406c51ee JH |
89 | } |
90 | ||
b3f6f6a6 RGS |
91 | last TOKEN |
92 | unless @tok > 1; | |
406c51ee | 93 | |
b3f6f6a6 | 94 | $tok = shift(@tok); |
406c51ee | 95 | |
b3f6f6a6 RGS |
96 | if ($tok eq "machine") { |
97 | my $host = shift @tok; | |
98 | $mach = bless {machine => $host}; | |
406c51ee | 99 | |
b3f6f6a6 | 100 | $netrc{$host} = [] |
406c51ee | 101 | unless exists($netrc{$host}); |
b3f6f6a6 | 102 | push(@{$netrc{$host}}, $mach); |
406c51ee | 103 | } |
b3f6f6a6 RGS |
104 | elsif ($tok =~ /^(login|password|account)$/) { |
105 | next TOKEN unless $mach; | |
106 | my $value = shift @tok; | |
107 | ||
108 | # Following line added by rmerrell to remove '/' escape char in .netrc | |
109 | $value =~ s/\/\\/\\/g; | |
110 | $mach->{$1} = $value; | |
406c51ee | 111 | } |
b3f6f6a6 RGS |
112 | elsif ($tok eq "macdef") { |
113 | next TOKEN unless $mach; | |
114 | my $value = shift @tok; | |
115 | $mach->{macdef} = {} | |
406c51ee | 116 | unless exists $mach->{macdef}; |
b3f6f6a6 | 117 | $macdef = $mach->{machdef}{$value} = []; |
406c51ee JH |
118 | } |
119 | } | |
120 | } | |
b3f6f6a6 | 121 | $fh->close(); |
406c51ee JH |
122 | } |
123 | } | |
124 | ||
406c51ee | 125 | |
b3f6f6a6 RGS |
126 | sub lookup { |
127 | my ($pkg, $mach, $login) = @_; | |
128 | ||
129 | _readrc() | |
406c51ee JH |
130 | unless exists $netrc{default}; |
131 | ||
b3f6f6a6 RGS |
132 | $mach ||= 'default'; |
133 | undef $login | |
406c51ee JH |
134 | if $mach eq 'default'; |
135 | ||
b3f6f6a6 RGS |
136 | if (exists $netrc{$mach}) { |
137 | if (defined $login) { | |
138 | my $m; | |
139 | foreach $m (@{$netrc{$mach}}) { | |
140 | return $m | |
141 | if (exists $m->{login} && $m->{login} eq $login); | |
406c51ee | 142 | } |
b3f6f6a6 | 143 | return undef; |
406c51ee | 144 | } |
b3f6f6a6 | 145 | return $netrc{$mach}->[0]; |
406c51ee JH |
146 | } |
147 | ||
b3f6f6a6 | 148 | return $netrc{default}->[0] |
406c51ee JH |
149 | if defined $netrc{default}; |
150 | ||
b3f6f6a6 | 151 | return undef; |
406c51ee JH |
152 | } |
153 | ||
406c51ee | 154 | |
b3f6f6a6 RGS |
155 | sub login { |
156 | my $me = shift; | |
157 | ||
158 | exists $me->{login} | |
406c51ee JH |
159 | ? $me->{login} |
160 | : undef; | |
161 | } | |
162 | ||
406c51ee | 163 | |
b3f6f6a6 RGS |
164 | sub account { |
165 | my $me = shift; | |
166 | ||
167 | exists $me->{account} | |
406c51ee JH |
168 | ? $me->{account} |
169 | : undef; | |
170 | } | |
171 | ||
406c51ee | 172 | |
b3f6f6a6 RGS |
173 | sub password { |
174 | my $me = shift; | |
175 | ||
176 | exists $me->{password} | |
406c51ee JH |
177 | ? $me->{password} |
178 | : undef; | |
179 | } | |
180 | ||
b3f6f6a6 RGS |
181 | |
182 | sub lpa { | |
183 | my $me = shift; | |
184 | ($me->login, $me->password, $me->account); | |
406c51ee JH |
185 | } |
186 | ||
187 | 1; | |
188 | ||
189 | __END__ | |
190 | ||
191 | =head1 NAME | |
192 | ||
193 | Net::Netrc - OO interface to users netrc file | |
194 | ||
195 | =head1 SYNOPSIS | |
196 | ||
197 | use Net::Netrc; | |
686337f3 | 198 | |
406c51ee JH |
199 | $mach = Net::Netrc->lookup('some.machine'); |
200 | $login = $mach->login; | |
201 | ($login, $password, $account) = $mach->lpa; | |
202 | ||
203 | =head1 DESCRIPTION | |
204 | ||
205 | C<Net::Netrc> is a class implementing a simple interface to the .netrc file | |
206 | used as by the ftp program. | |
207 | ||
208 | C<Net::Netrc> also implements security checks just like the ftp program, | |
209 | these checks are, first that the .netrc file must be owned by the user and | |
210 | second the ownership permissions should be such that only the owner has | |
211 | read and write access. If these conditions are not met then a warning is | |
212 | output and the .netrc file is not read. | |
213 | ||
214 | =head1 THE .netrc FILE | |
215 | ||
216 | The .netrc file contains login and initialization information used by the | |
217 | auto-login process. It resides in the user's home directory. The following | |
218 | tokens are recognized; they may be separated by spaces, tabs, or new-lines: | |
219 | ||
220 | =over 4 | |
221 | ||
222 | =item machine name | |
223 | ||
224 | Identify a remote machine name. The auto-login process searches | |
225 | the .netrc file for a machine token that matches the remote machine | |
226 | specified. Once a match is made, the subsequent .netrc tokens | |
227 | are processed, stopping when the end of file is reached or an- | |
228 | other machine or a default token is encountered. | |
229 | ||
230 | =item default | |
231 | ||
232 | This is the same as machine name except that default matches | |
233 | any name. There can be only one default token, and it must be | |
234 | after all machine tokens. This is normally used as: | |
235 | ||
236 | default login anonymous password user@site | |
237 | ||
238 | thereby giving the user automatic anonymous login to machines | |
239 | not specified in .netrc. | |
240 | ||
241 | =item login name | |
242 | ||
243 | Identify a user on the remote machine. If this token is present, | |
244 | the auto-login process will initiate a login using the | |
245 | specified name. | |
246 | ||
247 | =item password string | |
248 | ||
249 | Supply a password. If this token is present, the auto-login | |
250 | process will supply the specified string if the remote server | |
251 | requires a password as part of the login process. | |
252 | ||
253 | =item account string | |
254 | ||
255 | Supply an additional account password. If this token is present, | |
256 | the auto-login process will supply the specified string | |
257 | if the remote server requires an additional account password. | |
258 | ||
259 | =item macdef name | |
260 | ||
261 | Define a macro. C<Net::Netrc> only parses this field to be compatible | |
262 | with I<ftp>. | |
263 | ||
264 | =back | |
265 | ||
266 | =head1 CONSTRUCTOR | |
267 | ||
268 | The constructor for a C<Net::Netrc> object is not called new as it does not | |
269 | really create a new object. But instead is called C<lookup> as this is | |
270 | essentially what it does. | |
271 | ||
272 | =over 4 | |
273 | ||
274 | =item lookup ( MACHINE [, LOGIN ]) | |
275 | ||
276 | Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is given | |
277 | then the entry returned will have the given login. If C<LOGIN> is not given then | |
278 | the first entry in the .netrc file for C<MACHINE> will be returned. | |
279 | ||
280 | If a matching entry cannot be found, and a default entry exists, then a | |
281 | reference to the default entry is returned. | |
282 | ||
302c2e6b GB |
283 | If there is no matching entry found and there is no default defined, or |
284 | no .netrc file is found, then C<undef> is returned. | |
285 | ||
406c51ee JH |
286 | =back |
287 | ||
288 | =head1 METHODS | |
289 | ||
290 | =over 4 | |
291 | ||
292 | =item login () | |
293 | ||
294 | Return the login id for the netrc entry | |
295 | ||
296 | =item password () | |
297 | ||
298 | Return the password for the netrc entry | |
299 | ||
300 | =item account () | |
301 | ||
302 | Return the account information for the netrc entry | |
303 | ||
304 | =item lpa () | |
305 | ||
306 | Return a list of login, password and account information fir the netrc entry | |
307 | ||
308 | =back | |
309 | ||
310 | =head1 AUTHOR | |
311 | ||
312 | Graham Barr <gbarr@pobox.com> | |
313 | ||
314 | =head1 SEE ALSO | |
315 | ||
316 | L<Net::Netrc> | |
317 | L<Net::Cmd> | |
318 | ||
319 | =head1 COPYRIGHT | |
320 | ||
321 | Copyright (c) 1995-1998 Graham Barr. All rights reserved. | |
322 | This program is free software; you can redistribute it and/or modify | |
323 | it under the same terms as Perl itself. | |
324 | ||
325 | =cut |