# Net::Netrc.pm

#

# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. 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"; # $Id: //depot/libnet/Net/Netrc.pm#13 $

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<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.

If there is no matching entry found and there is no default defined, or

no .netrc file is found, then C<undef> 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 <gbarr@pobox.com>

=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.

=for html <hr>

$Id: //depot/libnet/Net/Netrc.pm#13 $

=cut