1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate if ($ENV{PERL_CORE}) { 5*0Sstevel@tonic-gate chdir 't' if -d 't'; 6*0Sstevel@tonic-gate @INC = '../lib'; 7*0Sstevel@tonic-gate } 8*0Sstevel@tonic-gate if (!eval "require Socket") { 9*0Sstevel@tonic-gate print "1..0 # no Socket\n"; exit 0; 10*0Sstevel@tonic-gate } 11*0Sstevel@tonic-gate if (ord('A') == 193 && !eval "require Convert::EBCDIC") { 12*0Sstevel@tonic-gate print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; 13*0Sstevel@tonic-gate } 14*0Sstevel@tonic-gate} 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gateuse strict; 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gateuse Cwd; 19*0Sstevel@tonic-gateprint "1..20\n"; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gate# for testing _readrc 22*0Sstevel@tonic-gate$ENV{HOME} = Cwd::cwd(); 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gate# avoid "used only once" warning 25*0Sstevel@tonic-gatelocal (*CORE::GLOBAL::getpwuid, *CORE::GLOBAL::stat); 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gate*CORE::GLOBAL::getpwuid = sub ($) { 28*0Sstevel@tonic-gate ((undef) x 7, Cwd::cwd()); 29*0Sstevel@tonic-gate}; 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate# for testing _readrc 32*0Sstevel@tonic-gatemy @stat; 33*0Sstevel@tonic-gate*CORE::GLOBAL::stat = sub (*) { 34*0Sstevel@tonic-gate return @stat; 35*0Sstevel@tonic-gate}; 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate# for testing _readrc 38*0Sstevel@tonic-gate$INC{'FileHandle.pm'} = 1; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate(my $libnet_t = __FILE__) =~ s/\w+.t$/libnet_t.pl/; 41*0Sstevel@tonic-gaterequire $libnet_t; 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gate# now that the tricks are out of the way... 44*0Sstevel@tonic-gateeval { require Net::Netrc; }; 45*0Sstevel@tonic-gateok( !$@, 'should be able to require() Net::Netrc safely' ); 46*0Sstevel@tonic-gateok( exists $INC{'Net/Netrc.pm'}, 'should be able to use Net::Netrc' ); 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gateSKIP: { 49*0Sstevel@tonic-gate skip('incompatible stat() handling for OS', 4), next SKIP 50*0Sstevel@tonic-gate if ($^O =~ /os2|win32|macos|cygwin/i or $] < 5.005); 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate my $warn; 53*0Sstevel@tonic-gate local $SIG{__WARN__} = sub { 54*0Sstevel@tonic-gate $warn = shift; 55*0Sstevel@tonic-gate }; 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gate # add write access for group/other 58*0Sstevel@tonic-gate $stat[2] = 077; 59*0Sstevel@tonic-gate ok( !defined(Net::Netrc::_readrc()), 60*0Sstevel@tonic-gate '_readrc() should not read world-writable file' ); 61*0Sstevel@tonic-gate ok( scalar($warn =~ /^Bad permissions:/), 62*0Sstevel@tonic-gate '... and should warn about it' ); 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gate # the owner field should still not match 65*0Sstevel@tonic-gate $stat[2] = 0; 66*0Sstevel@tonic-gate 67*0Sstevel@tonic-gate if ($<) { 68*0Sstevel@tonic-gate ok( !defined(Net::Netrc::_readrc()), 69*0Sstevel@tonic-gate '_readrc() should not read file owned by someone else' ); 70*0Sstevel@tonic-gate ok( scalar($warn =~ /^Not owner:/), 71*0Sstevel@tonic-gate '... and should warn about it' ); 72*0Sstevel@tonic-gate } else { 73*0Sstevel@tonic-gate skip("testing as root",2); 74*0Sstevel@tonic-gate } 75*0Sstevel@tonic-gate} 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gate# this field must now match, to avoid the last-tested warning 78*0Sstevel@tonic-gate$stat[4] = $<; 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gate# this curious mix of spaces and quotes tests a regex at line 79 (version 2.11) 81*0Sstevel@tonic-gateFileHandle::set_lines(split(/\n/, <<LINES)); 82*0Sstevel@tonic-gatemacdef bar 83*0Sstevel@tonic-gatelogin baz 84*0Sstevel@tonic-gate machine "foo" 85*0Sstevel@tonic-gatelogin nigol "password" drowssap 86*0Sstevel@tonic-gatemachine foo "login" l2 87*0Sstevel@tonic-gate password p2 88*0Sstevel@tonic-gateaccount tnuocca 89*0Sstevel@tonic-gatedefault login "baz" password p2 90*0Sstevel@tonic-gatedefault "login" baz password p3 91*0Sstevel@tonic-gatemacdef 92*0Sstevel@tonic-gateLINES 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gate# having set several lines and the uid, this should succeed 95*0Sstevel@tonic-gateis( Net::Netrc::_readrc(), 1, '_readrc() should succeed now' ); 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gate# on 'foo', the login is 'nigol' 98*0Sstevel@tonic-gateis( Net::Netrc->lookup('foo')->{login}, 'nigol', 99*0Sstevel@tonic-gate 'lookup() should find value by host name' ); 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gate# on 'foo' with login 'l2', the password is 'p2' 102*0Sstevel@tonic-gateis( Net::Netrc->lookup('foo', 'l2')->{password}, 'p2', 103*0Sstevel@tonic-gate 'lookup() should find value by hostname and login name' ); 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate# the default password is 'p3', as later declarations have priority 106*0Sstevel@tonic-gateis( Net::Netrc->lookup()->{password}, 'p3', 107*0Sstevel@tonic-gate 'lookup() should find default value' ); 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gate# lookup() ignores the login parameter when using default data 110*0Sstevel@tonic-gateis( Net::Netrc->lookup('default', 'baz')->{password}, 'p3', 111*0Sstevel@tonic-gate 'lookup() should ignore passed login when searching default' ); 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate# lookup() goes to default data if hostname cannot be found in config data 114*0Sstevel@tonic-gateis( Net::Netrc->lookup('abadname')->{login}, 'baz', 115*0Sstevel@tonic-gate 'lookup() should use default for unknown machine name' ); 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate# now test these accessors 118*0Sstevel@tonic-gatemy $instance = bless({}, 'Net::Netrc'); 119*0Sstevel@tonic-gatefor my $accessor (qw( login account password )) { 120*0Sstevel@tonic-gate is( $instance->$accessor(), undef, 121*0Sstevel@tonic-gate "$accessor() should return undef if $accessor is not set" ); 122*0Sstevel@tonic-gate $instance->{$accessor} = $accessor; 123*0Sstevel@tonic-gate is( $instance->$accessor(), $accessor, 124*0Sstevel@tonic-gate "$accessor() should return value when $accessor is set" ); 125*0Sstevel@tonic-gate} 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gate# and the three-for-one accessor 128*0Sstevel@tonic-gateis( scalar( () = $instance->lpa()), 3, 129*0Sstevel@tonic-gate 'lpa() should return login, password, account'); 130*0Sstevel@tonic-gateis( join(' ', $instance->lpa), 'login password account', 131*0Sstevel@tonic-gate 'lpa() should return appropriate values for l, p, and a' ); 132*0Sstevel@tonic-gate 133*0Sstevel@tonic-gatepackage FileHandle; 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gatesub new { 136*0Sstevel@tonic-gate tie *FH, 'FileHandle', @_; 137*0Sstevel@tonic-gate bless \*FH, $_[0]; 138*0Sstevel@tonic-gate} 139*0Sstevel@tonic-gate 140*0Sstevel@tonic-gatesub TIEHANDLE { 141*0Sstevel@tonic-gate my ($class, $file, $mode) = @_[0,2,3]; 142*0Sstevel@tonic-gate bless({ file => $file, mode => $mode }, $class); 143*0Sstevel@tonic-gate} 144*0Sstevel@tonic-gate 145*0Sstevel@tonic-gatemy @lines; 146*0Sstevel@tonic-gatesub set_lines { 147*0Sstevel@tonic-gate @lines = @_; 148*0Sstevel@tonic-gate} 149*0Sstevel@tonic-gate 150*0Sstevel@tonic-gatesub READLINE { 151*0Sstevel@tonic-gate shift @lines; 152*0Sstevel@tonic-gate} 153*0Sstevel@tonic-gate 154*0Sstevel@tonic-gatesub close { 1 } 155*0Sstevel@tonic-gate 156