Added suid_is_cached features.

UID.pm

@@ -13,6 +13,7 @@ Proc::UID - Manipulate a variety of UID and GID settings.
 	drop_gid_perm($new_gid); # Throws an exception on failure.
 	drop_uid_perm($new_uid); # Throws an exception on failure.
 
+	print "Saved-UIDs are cached\n" if suid_is_cached();
 
 =head1 WARNING
 
@@ -185,7 +186,11 @@ it under the same terms as Perl itself.
 
 =head1 TESTING STRATEGY
 
-Proc::UID's testing strategy is designed to be very complete.
+Proc::UID's testing strategy is designed to be very complete.  Should
+any tests fail when building Proc::UID on your system, then it is
+recommended that you do not use Proc::UID.
+
+For complete testing, Proc::UID's tests need to run as root.
 
 =head1 SEE ALSO
 
@@ -208,8 +213,8 @@ $VERSION = 0.04;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(	getruid geteuid getrgid getegid
 			setruid seteuid setrgid setegid
-			getsuid getsgid
-			setsuid setsgid
+			getsuid getsgid setsuid setsgid
+			suid_is_cached
 			drop_uid_temp drop_uid_perm restore_uid
 			drop_gid_temp drop_gid_perm restore_gid
 			$RUID $EUID $RGID $EGID $SUID $SGID);
@@ -219,6 +224,7 @@ $VERSION = 0.04;
 	funcs => [qw(	getruid geteuid getrgid getegid
 			setruid seteuid setrgid setegid
 			getsuid getsgid setsuid setsgid
+			suid_is_cached
 			drop_uid_temp drop_uid_perm restore_uid
 			drop_gid_temp drop_gid_perm restore_gid
 	)],

UID.xs

@@ -65,6 +65,12 @@ int getrgid()
 
 #ifdef SYS_getresuid
 
+int suid_is_cached()
+	CODE:
+		RETVAL = 0;
+	OUTPUT:
+		RETVAL
+
 int
 getsuid()
 	PREINIT:
@@ -73,7 +79,7 @@ getsuid()
 	CODE:
 		ret = getresuid(&ruid, &euid, &suid);
 		if (ret == -1) {
-			RETVAL = -1;
+			croak("getresuid() returned failure.  Error in Proc::UID?");
 		} else {
 			RETVAL = suid;
 		}
@@ -90,7 +96,7 @@ getsgid()
 	CODE:
 		ret = getresgid(&rgid, &egid, &sgid);
 		if (ret == -1) {
-			RETVAL = -1;
+			croak("getresgid() returned failure.  Error in Proc::UID?");
 		} else {
 			RETVAL = sgid;
 		}
@@ -102,6 +108,12 @@ getsgid()
 # This records our saved privileges upon startup.  Yes, this is
 # is caching.  I wish there were a better way.
 
+int suid_is_cached()
+	CODE:
+		RETVAL = 1;
+	OUTPUT:
+		RETVAL
+
 void
 init()
 	CODE:
@@ -270,6 +282,8 @@ restore_uid()
 # Now let's do the same for gid functions.
 # TODO - Think about getgroups / setgroups, how do they best fit in?
 
+# XXX - These need to be fixed for resuid/non-resuid systems.
+
 void
 drop_gid_temp(new_gid)
 		int new_gid;

t/01_defined_subs.t

@@ -9,8 +9,8 @@ BEGIN {
 	@subs_to_test= qw(
 		getruid geteuid getrgid getegid
 		setruid seteuid setrgid setegid
-		getsuid getsgid
-		setsuid setsgid
+		getsuid getsgid setsuid setsgid
+		suid_is_cached
 		drop_uid_temp drop_uid_perm restore_uid
 		drop_gid_temp drop_gid_perm restore_gid
 	);

t/02_user_tests.t

@@ -46,9 +46,18 @@ if ($EUID == 0) {
 
 eval {$EUID = 0;}; ok($@,qr/./,"Unexpectedly set EUID = 0");	#12
 eval {$RUID = 0;}; ok($@,qr/./,"Unexpectedly set RUID = 0");	#13
-eval {$SUID = 0;}; ok($@,qr/./,"Unexpectedly set SUID = 0");	#14
+
+if (suid_is_cached()) {
+	skip("Cannot set saved-UID directly on this system",1);		#14
+} else {
+	eval {$SUID = 0;}; ok($@,qr/./,"Unexpectedly set SUID = 0");	#14
+}
 
 eval {$EGID = 0;}; ok($@,qr/./,"Unexpectedly set EGID = 0");	#15
 eval {$RGID = 0;}; ok($@,qr/./,"Unexpectedly set RGID = 0");	#16
-eval {$SGID = 0;}; ok($@,qr/./,"Unexpectedly set SGID = 0");	#17
 
+if (suid_is_cached()) {
+	skip("Cannot set saved-GID correctly on this system",1);
+} else {
+	eval {$SGID = 0;}; ok($@,qr/./,"Unexpectedly set SGID = 0");	#17
+}