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