lib/Net/Netrc.pm

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