lib/Net/Netrc.pm

   1 package Net::Netrc;
   2
   3 use Carp;
   4 use strict;
   5
   6 my %netrc = ();
   7
   8 sub _readrc {
   9  my $host = shift;
  10  my $file = (getpwuid($>))[7] . "/.netrc";
  11  my($login,$pass,$acct) = (undef,undef,undef);
  12  local *NETRC;
  13  local $_;
  14
  15  $netrc{default} = undef;
  16
  17  my @stat = stat($file);
  18
  19  if(@stat)
  20   {
  21    if($stat[2] & 077)
  22     {
  23      carp "Bad permissions: $file";
  24      return ();
  25     }
  26    if($stat[4] != $<)
  27     {
  28      carp "Not owner: $file";
  29      return ();
  30     }
  31   }
  32
  33  if(open(NETRC,$file))
  34   {
  35    my($mach,$macdef,$tok,@tok) = (0,0);
  36
  37    while(<NETRC>)
  38     {
  39      undef $macdef if /\A\n\Z/;
  40
  41      if($macdef)
  42       {
  43        push(@$macdef,$_);
  44        next;
  45       }
  46
  47      push(@tok, split(/[\s\n]+/, $_));
  48
  49 TOKEN:
  50      while(@tok)
  51       {
  52        if($tok[0] eq "default")
  53         {
  54          shift(@tok);
  55          $mach = $netrc{default} = {};
  56
  57          next TOKEN;
  58         }
  59
  60        last TOKEN unless @tok > 1;
  61        $tok = shift(@tok);
  62
  63        if($tok eq "machine")
  64         {
  65          my $host = shift @tok;
  66          $mach = $netrc{$host} = {};
  67         }
  68        elsif($tok =~ /^(login|password|account)$/)
  69         {
  70          next TOKEN unless $mach;
  71          my $value = shift @tok;
  72          $mach->{$1} = $value;
  73         }
  74        elsif($tok eq "macdef")
  75         {
  76          next TOKEN unless $mach;
  77          my $value = shift @tok;
  78          $mach->{macdef} = {} unless exists $mach->{macdef};
  79          $macdef = $mach->{machdef}{$value} = [];
  80         }
  81       }
  82     }
  83    close(NETRC);
  84   }
  85 }
  86
  87 sub lookup {
  88  my $pkg = shift;
  89  my $mach = shift;
  90
  91  _readrc() unless exists $netrc{default};
  92
  93  return bless \$mach if exists $netrc{$mach};
  94
  95  return bless \("default") if defined $netrc{default};
  96
  97  return undef;
  98 }
  99
 100 sub login {
 101  my $me = shift;
 102  $me = $netrc{$$me};
 103  exists $me->{login} ? $me->{login} : undef;
 104 }
 105
 106 sub account {
 107  my $me = shift;
 108  $me = $netrc{$$me};
 109  exists $me->{account} ? $me->{account} : undef;
 110 }
 111
 112 sub password {
 113  my $me = shift;
 114  $me = $netrc{$$me};
 115  exists $me->{password} ? $me->{password} : undef;
 116 }
 117
 118 sub lpa {
 119  my $me = shift;
 120  ($me->login, $me->password, $me->account);
 121 }
 122
 123 1;