Fix permissions on temp dirs

lib/App/Yath/Command/test.pm

@@ -333,6 +333,7 @@ sub build_run {
     my $run = $settings->build(run => 'Test2::Harness::Run');
 
     mkdir($run->run_dir($dir)) or die "Could not make run dir: $!";
+    chmod(1777, $dir) or warn "Could not chmod run dir: $!\n";
 
     return $self->{+RUN} = $run;
 }

lib/App/Yath/Options/Workspace.pm

@@ -46,6 +46,7 @@ option_group {prefix => 'workspace', category => "Workspace Options"} => sub {
             }
             else {
                 mkdir($workdir) or die "Could not create workdir: $!";
+                chmod(1777, $workdir) or warn "Could not chmod work dir: $!\n";
             }
 
             return;
@@ -59,6 +60,7 @@ option_group {prefix => 'workspace', category => "Workspace Options"} => sub {
             DIR     => $settings->workspace->tmp_dir,
             CLEANUP => !($settings->debug->keep_dirs || $params{command}->always_keep_dir),
         );
+        chmod(1777, $tmpdir) or warn "Could not chmod temp dir: $!\n";
 
         $settings->workspace->field(workdir => $tmpdir);
     };

lib/Test2/Harness/Collector.pm

@@ -76,7 +76,14 @@ sub process {
             my $done = $jdir->done or next;
 
             delete $jobs->{$job_try};
-            remove_tree($jdir->job_root, {safe => 1, keep_root => 0}) unless $self->settings->debug->keep_dirs;
+            unless ($self->settings->debug->keep_dirs) {
+                my $job_path = $jdir->job_root;
+                # Needed because we set the perms so that a tmpdir under it can be used.
+                # This is the only remove_tree that needs it because it is the
+                # only one in a process that did not initially create the dir.
+                chmod(0700, $job_path);
+                remove_tree($job_path, {safe => 1, keep_root => 0});
+            }
 
             delete $self->{+PENDING}->{$jdir->job_id} unless $done->{retry};
         }

lib/Test2/Harness/Runner.pm

@@ -84,6 +84,7 @@ sub init {
     my $tmp_dir = File::Spec->catdir($self->{+DIR}, 'tmp');
     unless (-d $tmp_dir) {
         mkdir($tmp_dir) or die "Could not create temp dir: $!";
+        chmod(1777, $tmp_dir) or warn "Could not chmod temp dir: $!\n";
     }
     $self->{+TMP_DIR} = $tmp_dir;
 

lib/Test2/Harness/Runner/Job.pm

@@ -310,6 +310,7 @@ sub job_dir {
 
     my $job_dir = File::Spec->catdir($self->run_dir, $self->{+TASK}->{job_id} . '+' . $self->is_try);
     mkdir($job_dir) or die "$$ $0 Could not create job directory '$job_dir': $!";
+    chmod(1777, $job_dir) or warn "Could not chmod job dir: $!\n";
     $self->{+JOB_DIR} = $job_dir;
 }
 
@@ -319,6 +320,7 @@ sub tmp_dir {
     return $self->{+TMP_DIR} if $self->{+TMP_DIR};
 
     my $tmp_dir = File::Temp::tempdir("XXXXXX", DIR => $self->runner->tmp_dir);
+    chmod(1777, $tmp_dir) or warn "Could not chmod temp dir: $!\n";
 
     $self->{+TMP_DIR} = clean_path($tmp_dir);
 }
@@ -465,6 +467,7 @@ sub env_vars {
         TEST2_RUN_DIR       => $self->run_dir,
         TMPDIR              => $self->tmp_dir,
         TEMPDIR             => $self->tmp_dir,
+        SYSTEM_TMPDIR       => $self->{+SETTINGS}->harness->orig_tmp,
 
         HARNESS_IS_VERBOSE    => $verbose,
         T2_HARNESS_IS_VERBOSE => $verbose,

scripts/yath

@@ -10,6 +10,7 @@ BEGIN {
 
     package App::Yath::Script;
 
+    my $ORIG_TMP;
     my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => $SIG{$_}) : ()} keys %SIG;
     my @ORIG_ARGV = @ARGV;
     my @ORIG_INC = @INC;
@@ -157,6 +158,7 @@ BEGIN {
     require Cwd;
     require File::Spec;
 
+    $ORIG_TMP = File::Spec->tmpdir();
     $SCRIPT = Cwd::realpath(__FILE__) // File::Spec->rel2abs(__FILE__);
 
     if ($maybe_exec && -e 'scripts/yath') {
@@ -198,6 +200,7 @@ BEGIN {
     require Test2::Harness::Settings;
     my $settings = Test2::Harness::Settings->new(
         harness => {
+            orig_tmp        => $ORIG_TMP,
             orig_sig        => \%ORIG_SIG,
             orig_argv       => \@ORIG_ARGV,
             orig_inc        => \@ORIG_INC,

t/yath_script.t

@@ -332,7 +332,7 @@ sub test_exec {
 
     my @ORIG_ARGV = ('-xyz');
     my $SCRIPT;
-    my ($exec, $die, @warn);
+    my ($exec, $die, @warn, $ORIG_TMP);
     my $maybe_exec = '-D';
 
     my $res;
@@ -380,7 +380,7 @@ sub test_create_app {
         )
     );
 
-    my (%ORIG_SIG, @ORIG_ARGV, @ORIG_INC, @DEVLIBS, @ARGV, %CONFIG, $NO_PLUGINS);
+    my (%ORIG_SIG, @ORIG_ARGV, @ORIG_INC, @DEVLIBS, @ARGV, %CONFIG, $NO_PLUGINS, $ORIG_TMP);
     $NO_PLUGINS = 2;
     my $SCRIPT = "foobar";
     eval $code or die $@;

t2/tmp_perms.t

@@ -0,0 +1,32 @@
+use Test2::V0;
+use File::Spec;
+use Test2::Harness::Util qw/clean_path/;
+
+my $path = $ENV{TMPDIR};
+
+sub mode { ((stat($_[0]))[2] & 07777) }
+
+is(mode($path), 1777, "tempdir '$path' has mode 1777");
+
+my $system_tmp = clean_path($ENV{SYSTEM_TMPDIR});
+
+my $last = $path;
+my $cnt = 0;
+while ($system_tmp) {
+    my $next = clean_path(File::Spec->catdir($last, File::Spec->updir()));
+    last if $next eq $system_tmp;    # We hit system temp, we can stop
+    last if $next eq $last;          # We probably hit root
+    last if $cnt++ > 10;             # Something went wrong, no need to loop forever
+    $last = $next;
+
+    my @mode = split //, mode($next);
+
+    shift (@mode) while @mode > 3;
+    subtest "parent '$next'" => sub {
+        ok($mode[0] >= 5, "Owner permission is 5+");
+        ok($mode[1] >= 5, "Group permission is 5+");
+        ok($mode[2] >= 5, "World permission is 5+");
+    };
+}
+
+done_testing;