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;
  10 use strict;
  11 use Data::Dumper;
  12 use English;
  13 $Data::Dumper::Terse = 1;
  14 $Data::Dumper::Indent = 0;
  15 
  16 
  17 use Sun::Solaris::Privilege qw(:ALL);
  18 use Sun::Solaris::Project qw(:ALL);
  19 
  20 #
  21 # Status reporting utils
  22 #
  23 
  24 use vars qw($test);
  25 $test = 1;
  26 
  27 sub pass
  28 {
  29         print("ok $test $@\n");
  30         $test++;
  31 }
  32 
  33 sub fail
  34 {
  35         print("not ok $test $@\n");
  36         $test++;
  37 }
  38 
  39 sub fatal
  40 {
  41         print("not ok $test $@\n");
  42         exit(1);
  43 }
  44 
  45 my $errs;
  46 
  47 sub report
  48 {
  49         if ($errs) {
  50                 fail();
  51         } else {
  52                 pass();
  53         }
  54         $errs = 0;
  55 }
  56 
  57 sub 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 
  92 my ($loaded, $line) = (1, 0);
  93 my $fh = do { local *FH; *FH; };
  94 
  95 #
  96 # 1. Check the module loads
  97 #
  98 BEGIN { $| = 1; print "1..5\n"; }
  99 END   { print "not ok 1\n" unless $loaded; }
 100 use Sun::Solaris::Ucred qw(:ALL);
 101 $loaded = 1;
 102 pass();
 103 
 104 #
 105 # 2. ucred_get works.
 106 #
 107 
 108 my $ucred = ucred_get($$);
 109 
 110 $errs++ unless defined $ucred;
 111 
 112 report();
 113 
 114 #
 115 # 3. Returned ucred matches perl's idea of the process' credentials.
 116 #
 117 if (defined $ucred) {
 118         ucred_verify($ucred);
 119 }
 120 report();
 121 
 122 #
 123 # 4. Create a socketpair; make sure that the ucred returned
 124 # is mine.
 125 #
 126 
 127 use IO::Socket::UNIX;
 128 
 129 my ($unix) = new IO::Socket::UNIX;
 130 my ($s1, $s2) = $unix->socketpair(AF_UNIX, SOCK_STREAM, 0);
 131 
 132 if ($ucred = getpeerucred(fileno($s1))) {
 133         ucred_verify($ucred);
 134 } else {
 135         $errs++;
 136 }
 137 close($s1);
 138 close($s2);
 139 
 140 ($s1, $s2) = $unix->socketpair(AF_UNIX, SOCK_SEQPACKET, 0);
 141 
 142 if ($ucred = getpeerucred(fileno($s1))) {
 143         ucred_verify($ucred);
 144 } else {
 145         $errs++;
 146 }
 147 close($s1);
 148 close($s2);
 149 report();
 150 
 151 #
 152 # 5. Create a AF_INET loopback connected socket and call getpeerucred().
 153 #
 154 use IO::Socket::INET;
 155 
 156 my $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);
 166 my $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 
 172 foreach my $s ($s2, $s3) {
 173         if ($ucred = getpeerucred(fileno($s))) {
 174                 ucred_verify($ucred);
 175         } else {
 176                 $errs++;
 177         }
 178 }
 179 report();