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 7package Net::Netrc; 8 9use Carp; 10use strict; 11use FileHandle; 12use vars qw($VERSION); 13 14$VERSION = "2.12"; # $Id: //depot/libnet/Net/Netrc.pm#13 $ 15 16my %netrc = (); 17 18sub _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 85TOKEN: 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 133sub 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 165sub login 166{ 167 my $me = shift; 168 169 exists $me->{login} 170 ? $me->{login} 171 : undef; 172} 173 174sub account 175{ 176 my $me = shift; 177 178 exists $me->{account} 179 ? $me->{account} 180 : undef; 181} 182 183sub password 184{ 185 my $me = shift; 186 187 exists $me->{password} 188 ? $me->{password} 189 : undef; 190} 191 192sub lpa 193{ 194 my $me = shift; 195 ($me->login, $me->password, $me->account); 196} 197 1981; 199 200__END__ 201 202=head1 NAME 203 204Net::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 216C<Net::Netrc> is a class implementing a simple interface to the .netrc file 217used as by the ftp program. 218 219C<Net::Netrc> also implements security checks just like the ftp program, 220these checks are, first that the .netrc file must be owned by the user and 221second the ownership permissions should be such that only the owner has 222read and write access. If these conditions are not met then a warning is 223output and the .netrc file is not read. 224 225=head1 THE .netrc FILE 226 227The .netrc file contains login and initialization information used by the 228auto-login process. It resides in the user's home directory. The following 229tokens are recognized; they may be separated by spaces, tabs, or new-lines: 230 231=over 4 232 233=item machine name 234 235Identify a remote machine name. The auto-login process searches 236the .netrc file for a machine token that matches the remote machine 237specified. Once a match is made, the subsequent .netrc tokens 238are processed, stopping when the end of file is reached or an- 239other machine or a default token is encountered. 240 241=item default 242 243This is the same as machine name except that default matches 244any name. There can be only one default token, and it must be 245after all machine tokens. This is normally used as: 246 247 default login anonymous password user@site 248 249thereby giving the user automatic anonymous login to machines 250not specified in .netrc. 251 252=item login name 253 254Identify a user on the remote machine. If this token is present, 255the auto-login process will initiate a login using the 256specified name. 257 258=item password string 259 260Supply a password. If this token is present, the auto-login 261process will supply the specified string if the remote server 262requires a password as part of the login process. 263 264=item account string 265 266Supply an additional account password. If this token is present, 267the auto-login process will supply the specified string 268if the remote server requires an additional account password. 269 270=item macdef name 271 272Define a macro. C<Net::Netrc> only parses this field to be compatible 273with I<ftp>. 274 275=back 276 277=head1 CONSTRUCTOR 278 279The constructor for a C<Net::Netrc> object is not called new as it does not 280really create a new object. But instead is called C<lookup> as this is 281essentially what it does. 282 283=over 4 284 285=item lookup ( MACHINE [, LOGIN ]) 286 287Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is given 288then the entry returned will have the given login. If C<LOGIN> is not given then 289the first entry in the .netrc file for C<MACHINE> will be returned. 290 291If a matching entry cannot be found, and a default entry exists, then a 292reference to the default entry is returned. 293 294If there is no matching entry found and there is no default defined, or 295no .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 305Return the login id for the netrc entry 306 307=item password () 308 309Return the password for the netrc entry 310 311=item account () 312 313Return the account information for the netrc entry 314 315=item lpa () 316 317Return a list of login, password and account information fir the netrc entry 318 319=back 320 321=head1 AUTHOR 322 323Graham Barr <gbarr@pobox.com> 324 325=head1 SEE ALSO 326 327L<Net::Netrc> 328L<Net::Cmd> 329 330=head1 COPYRIGHT 331 332Copyright (c) 1995-1998 Graham Barr. All rights reserved. 333This program is free software; you can redistribute it and/or modify 334it under the same terms as Perl itself. 335 336=for html <hr> 337 338$Id: //depot/libnet/Net/Netrc.pm#13 $ 339 340=cut 341