[Summary view] [Print] [Text view]

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