stas 2003/01/30 16:53:45
Modified: perl-framework/Apache-Test/lib/Apache TestRun.pm
Log:
# handle the cases when the test suite is run under 'root':
#
# 1. When user 'bar' is chosen to run Apache with, files and dirs
# created by 'root' might be not writable/readable by 'bar'
#
# 2. when the source is extracted as user 'foo', and the chosen user
# to run Apache under is 'bar', in which case normally 'bar' won't
# have the right permissions to write into the fs created by 'foo'.
#
# We solve that by 'chown -R bar.bar t/' in a portable way.
#
# at the end of the run we restore the perms to the original ones
Revision Changes Path
1.100 +46 -0
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
Index: TestRun.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -r1.99 -r1.100
--- TestRun.pm 30 Jan 2003 23:59:40 -0000 1.99
+++ TestRun.pm 31 Jan 2003 00:53:45 -0000 1.100
@@ -20,6 +20,7 @@
use subs qw(exit_shell exit_perl);
my %core_files = ();
+my %original_t_perms = ();
my @std_run = qw(start-httpd run-tests stop-httpd);
my @others = qw(verbose configure clean help ssl http11);
@@ -451,6 +452,8 @@
}
}
+ $self->adjust_t_perms();
+
if ($opts->{'start-httpd'}) {
exit_perl 0 unless $server->start;
}
@@ -489,6 +492,8 @@
sub stop {
my $self = shift;
+ $self->restore_t_perms;
+
return $self->{server}->stop if $self->{opts}->{'stop-httpd'};
}
@@ -645,6 +650,47 @@
# old core file at the end of the run and not complain then
$core_files{$core} = -M $core;
}, $vars->{top_dir});
+}
+
+# this function handles the cases when the test suite is run under
+# 'root':
+#
+# 1. When user 'bar' is chosen to run Apache with, files and dirs
+# created by 'root' might be not writable/readable by 'bar'
+#
+# 2. when the source is extracted as user 'foo', and the chosen user
+# to run Apache under is 'bar', in which case normally 'bar' won't
+# have the right permissions to write into the fs created by 'foo'.
+#
+# We solve that by 'chown -R bar.bar t/' in a portable way.
+sub adjust_t_perms {
+ my $self = shift;
+ %original_t_perms = (); # reset global
+
+ my $user = getpwuid($>) || '';
+ if ($user eq 'root') {
+ my $vars = $self->{test_config}->{vars};
+ my $user = $vars->{user};
+ my($uid, $gid) = (getpwnam($user))[2..3]
+ or die "Can't find out uid/gid of '$user'";
+ warning "root mode: changing the fs ownership to '$user'
($uid:$gid)";
+ finddepth(sub {
+ $original_t_perms{$File::Find::name} = [(stat $_)[4..5]];
+ chown $uid, $gid, $_;
+ }, $vars->{t_dir});
+ }
+}
+
+sub restore_t_perms {
+ my $self = shift;
+
+ if (%original_t_perms) {
+ my $vars = $self->{test_config}->{vars};
+ while (my($file, $ids) = each %original_t_perms) {
+ next unless -e $file; # files could be deleted
+ chown @$ids, $file;
+ }
+ }
}
sub run_request {
