|
|
# Net::Netrc.pm## Copyright (c) 1995-1998 Graham Barr <[email protected]>. 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.10"; # $Id: //depot/libnet/Net/Netrc.pm#4$
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}; $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') { 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; push(@tok, $+) while(length && s/^("([^"]*)"|(\S+))\s*//);
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<Net::Netrc> is a class implementing a simple interface to the .netrc fileused as by the ftp program.
C<Net::Netrc> 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 hasread and write access. If these conditions are not met then a warning isoutput and the .netrc file is not read.
=head1 THE .netrc FILE
The .netrc file contains login and initialization information used by theauto-login process. It resides in the user's home directory. The followingtokens 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 searchesthe .netrc file for a machine token that matches the remote machinespecified. Once a match is made, the subsequent .netrc tokensare 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 matchesany name. There can be only one default token, and it must beafter all machine tokens. This is normally used as:
default login anonymous password user@site
thereby giving the user automatic anonymous login to machinesnot 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 thespecified name.
=item password string
Supply a password. If this token is present, the auto-loginprocess will supply the specified string if the remote serverrequires 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 stringif the remote server requires an additional account password.
=item macdef name
Define a macro. C<Net::Netrc> only parses this field to be compatiblewith I<ftp>.
=back
=head1 CONSTRUCTOR
The constructor for a C<Net::Netrc> object is not called new as it does notreally create a new object. But instead is called C<lookup> as this isessentially what it does.
=over 4
=item lookup ( MACHINE [, LOGIN ])
Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is giventhen the entry returned will have the given login. If C<LOGIN> is not given thenthe first entry in the .netrc file for C<MACHINE> will be returned.
If a matching entry cannot be found, and a default entry exists, then areference to the default entry 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 <[email protected]>
=head1 SEE ALSO
L<Net::Netrc>L<Net::Cmd>
=head1 COPYRIGHT
Copyright (c) 1995-1998 Graham Barr. All rights reserved.This program is free software; you can redistribute it and/or modifyit under the same terms as Perl itself.
=cut
|
