1# 2# Copyright (c) 2004, Oracle and/or its affiliates. All rights reserved. 3# 4 5# 6# test script for Sun::Solaris::Ucred 7# 8 9$^W = 1; 10use strict; 11use Data::Dumper; 12use English; 13$Data::Dumper::Terse = 1; 14$Data::Dumper::Indent = 0; 15 16 17use Sun::Solaris::Privilege qw(:ALL); 18use Sun::Solaris::Project qw(:ALL); 19 20# 21# Status reporting utils 22# 23 24use vars qw($test); 25$test = 1; 26 27sub pass 28{ 29 print("ok $test $@\n"); 30 $test++; 31} 32 33sub fail 34{ 35 print("not ok $test $@\n"); 36 $test++; 37} 38 39sub fatal 40{ 41 print("not ok $test $@\n"); 42 exit(1); 43} 44 45my $errs; 46 47sub report 48{ 49 if ($errs) { 50 fail(); 51 } else { 52 pass(); 53 } 54 $errs = 0; 55} 56 57sub ucred_verify 58{ 59 my ($ucred) = @_; 60 61 my $pid = ucred_getpid($ucred); 62 63 $errs++ unless (!defined $pid || $pid == $$); 64 $errs++ unless (ucred_geteuid($ucred) == $EUID); 65 $errs++ unless (ucred_getruid($ucred) == $UID); 66 $errs++ unless (ucred_getegid($ucred) == $EGID); 67 $errs++ unless (ucred_getrgid($ucred) == $GID); 68 $errs++ unless (ucred_getprojid($ucred) == getprojid()); 69 foreach my $f (PRIV_AWARE, PRIV_DEBUG) { 70 $errs++ unless (ucred_getpflags($ucred, $f) == getpflags($f)); 71 } 72 73 # Get a sorted list of groups; the real gid is first and we need 74 # to shift that one out of the way first. 75 my @gr = split(/\s+/, $(); 76 shift @gr; 77 @gr = sort {$a <=> $b} (@gr); 78 my @ucgr = sort {$a <=> $b} ucred_getgroups($ucred); 79 80 $errs++ unless ("@gr" eq "@ucgr"); 81 82 foreach my $s (keys %PRIVSETS) { 83 my $set = ucred_getprivset($ucred, $s); 84 $errs++ unless priv_isequalset($set, getppriv($s)); 85 } 86} 87 88# 89# Main body of tests starts here 90# 91 92my ($loaded, $line) = (1, 0); 93my $fh = do { local *FH; *FH; }; 94 95# 96# 1. Check the module loads 97# 98BEGIN { $| = 1; print "1..5\n"; } 99END { print "not ok 1\n" unless $loaded; } 100use Sun::Solaris::Ucred qw(:ALL); 101$loaded = 1; 102pass(); 103 104# 105# 2. ucred_get works. 106# 107 108my $ucred = ucred_get($$); 109 110$errs++ unless defined $ucred; 111 112report(); 113 114# 115# 3. Returned ucred matches perl's idea of the process' credentials. 116# 117if (defined $ucred) { 118 ucred_verify($ucred); 119} 120report(); 121 122# 123# 4. Create a socketpair; make sure that the ucred returned 124# is mine. 125# 126 127use IO::Socket::UNIX; 128 129my ($unix) = new IO::Socket::UNIX; 130my ($s1, $s2) = $unix->socketpair(AF_UNIX, SOCK_STREAM, 0); 131 132if ($ucred = getpeerucred(fileno($s1))) { 133 ucred_verify($ucred); 134} else { 135 $errs++; 136} 137close($s1); 138close($s2); 139 140($s1, $s2) = $unix->socketpair(AF_UNIX, SOCK_SEQPACKET, 0); 141 142if ($ucred = getpeerucred(fileno($s1))) { 143 ucred_verify($ucred); 144} else { 145 $errs++; 146} 147close($s1); 148close($s2); 149report(); 150 151# 152# 5. Create a AF_INET loopback connected socket and call getpeerucred(). 153# 154use IO::Socket::INET; 155 156my $inet = new IO::Socket::INET; 157 158$s1 = $inet->socket(AF_INET, SOCK_STREAM, 0); 159$inet = new IO::Socket::INET; 160$s2 = $inet->socket(AF_INET, SOCK_STREAM, 0); 161 162$s1->bind(0, inet_aton("localhost")); 163$s1->listen(0); 164 165$s2->connect($s1->sockname); 166my $s3 = $s1->accept(); 167 168# getpeerucred on the accepter should fail 169$errs++ if getpeerucred(fileno($s1)); 170# but on the other two it should succeed. 171 172foreach my $s ($s2, $s3) { 173 if ($ucred = getpeerucred(fileno($s))) { 174 ucred_verify($ucred); 175 } else { 176 $errs++; 177 } 178} 179report(); 180