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