# Net::Netrc.pm # # Copyright (c) 1995-1998 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Net::Netrc; use Carp; use strict; use FileHandle; use vars qw($VERSION); $VERSION = "2.12"; my %netrc = (); sub _readrc { my $host = shift; my ($home, $file); if ($^O eq "MacOS") { $home = $ENV{HOME} || `pwd`; chomp($home); $file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc"); } else { # Some OS's don't have `getpwuid', so we default to $ENV{HOME} $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE}; $file = $home . "/.netrc"; } my ($login, $pass, $acct) = (undef, undef, undef); my $fh; local $_; $netrc{default} = undef; # OS/2 and Win32 do not handle stat in a way compatable with this check :-( unless ($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'MacOS' || $^O =~ /^cygwin/) { my @stat = stat($file); if (@stat) { if ($stat[2] & 077) { carp "Bad permissions: $file"; return; } if ($stat[4] != $<) { carp "Not owner: $file"; return; } } } if ($fh = FileHandle->new($file, "r")) { my ($mach, $macdef, $tok, @tok) = (0, 0); while (<$fh>) { undef $macdef if /\A\n\Z/; if ($macdef) { push(@$macdef, $_); next; } s/^\s*//; chomp; while (length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) { (my $tok = $+) =~ s/\\(.)/$1/g; push(@tok, $tok); } TOKEN: while (@tok) { if ($tok[0] eq "default") { shift(@tok); $mach = bless {}; $netrc{default} = [$mach]; next TOKEN; } last TOKEN unless @tok > 1; $tok = shift(@tok); if ($tok eq "machine") { my $host = shift @tok; $mach = bless {machine => $host}; $netrc{$host} = [] unless exists($netrc{$host}); push(@{$netrc{$host}}, $mach); } elsif ($tok =~ /^(login|password|account)$/) { next TOKEN unless $mach; my $value = shift @tok; # Following line added by rmerrell to remove '/' escape char in .netrc $value =~ s/\/\\/\\/g; $mach->{$1} = $value; } elsif ($tok eq "macdef") { next TOKEN unless $mach; my $value = shift @tok; $mach->{macdef} = {} unless exists $mach->{macdef}; $macdef = $mach->{machdef}{$value} = []; } } } $fh->close(); } } sub lookup { my ($pkg, $mach, $login) = @_; _readrc() unless exists $netrc{default}; $mach ||= 'default'; undef $login if $mach eq 'default'; if (exists $netrc{$mach}) { if (defined $login) { my $m; foreach $m (@{$netrc{$mach}}) { return $m if (exists $m->{login} && $m->{login} eq $login); } return undef; } return $netrc{$mach}->[0]; } return $netrc{default}->[0] if defined $netrc{default}; return undef; } sub login { my $me = shift; exists $me->{login} ? $me->{login} : undef; } sub account { my $me = shift; exists $me->{account} ? $me->{account} : undef; } sub password { my $me = shift; exists $me->{password} ? $me->{password} : undef; } sub lpa { my $me = shift; ($me->login, $me->password, $me->account); } 1; __END__ =head1 NAME Net::Netrc - OO interface to users netrc file =head1 SYNOPSIS use Net::Netrc; $mach = Net::Netrc->lookup('some.machine'); $login = $mach->login; ($login, $password, $account) = $mach->lpa; =head1 DESCRIPTION C is a class implementing a simple interface to the .netrc file used as by the ftp program. C also implements security checks just like the ftp program, these checks are, first that the .netrc file must be owned by the user and second the ownership permissions should be such that only the owner has read and write access. If these conditions are not met then a warning is output and the .netrc file is not read. =head1 THE .netrc FILE The .netrc file contains login and initialization information used by the auto-login process. It resides in the user's home directory. The following tokens are recognized; they may be separated by spaces, tabs, or new-lines: =over 4 =item machine name Identify a remote machine name. The auto-login process searches the .netrc file for a machine token that matches the remote machine specified. Once a match is made, the subsequent .netrc tokens are processed, stopping when the end of file is reached or an- other machine or a default token is encountered. =item default This is the same as machine name except that default matches any name. There can be only one default token, and it must be after all machine tokens. This is normally used as: default login anonymous password user@site thereby giving the user automatic anonymous login to machines not specified in .netrc. =item login name Identify a user on the remote machine. If this token is present, the auto-login process will initiate a login using the specified name. =item password string Supply a password. If this token is present, the auto-login process will supply the specified string if the remote server requires a password as part of the login process. =item account string Supply an additional account password. If this token is present, the auto-login process will supply the specified string if the remote server requires an additional account password. =item macdef name Define a macro. C only parses this field to be compatible with I. =back =head1 CONSTRUCTOR The constructor for a C object is not called new as it does not really create a new object. But instead is called C as this is essentially what it does. =over 4 =item lookup ( MACHINE [, LOGIN ]) Lookup and return a reference to the entry for C. If C is given then the entry returned will have the given login. If C is not given then the first entry in the .netrc file for C will be returned. If a matching entry cannot be found, and a default entry exists, then a reference to the default entry is returned. If there is no matching entry found and there is no default defined, or no .netrc file is found, then C is returned. =back =head1 METHODS =over 4 =item login () Return the login id for the netrc entry =item password () Return the password for the netrc entry =item account () Return the account information for the netrc entry =item lpa () Return a list of login, password and account information fir the netrc entry =back =head1 AUTHOR Graham Barr =head1 SEE ALSO L L =head1 COPYRIGHT Copyright (c) 1995-1998 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut