You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
326 lines
7.0 KiB
326 lines
7.0 KiB
# 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 file
|
|
used 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 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<Net::Netrc> only parses this field to be compatible
|
|
with I<ftp>.
|
|
|
|
=back
|
|
|
|
=head1 CONSTRUCTOR
|
|
|
|
The constructor for a C<Net::Netrc> object is not called new as it does not
|
|
really create a new object. But instead is called C<lookup> as this is
|
|
essentially what it does.
|
|
|
|
=over 4
|
|
|
|
=item lookup ( MACHINE [, LOGIN ])
|
|
|
|
Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is given
|
|
then the entry returned will have the given login. If C<LOGIN> is not given then
|
|
the 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 a
|
|
reference 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 modify
|
|
it under the same terms as Perl itself.
|
|
|
|
=cut
|