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