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