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 *
#	Content
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