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