Safe Cleanup of Scratch and Run Areas

Part II · Module 17 · Chapter 17.6 · Safe Cleanup of Scratch and Run Areas

1. Why a Pattern Is Not a Check

The tempting cleanup looks like this:

rmtree($dir) if $dir =~ m{/runs/};        # looks like a run directory

Three things are wrong with it, and none of them is obvious:

It tests the spelling, not the location. /proj/chipA/rtl/runs_notes/ matches. So does /home/someone/runs/thesis.

It cannot see through a symbolic link. A path that spells out as a run directory may be somewhere else entirely.

It says nothing about ownership. Matching /runs/ does not establish that this script created it, or that anything in it is disposable. Chapter 17.2's role table exists precisely because disposability is a property of the directory's role, not of its name.

The replacement is a containment test: resolve the target, resolve the directory you own, and require the first to be strictly underneath the second. That is a short function and the rest of this chapter is about getting its edges right.

2. The Containment Test

use strict;
use warnings;
use Cwd qw(abs_path);
use File::Spec;
use File::Temp qw(tempdir);
use File::Path qw(make_path);

# ---- a sample layout: a run area we own, and something outside it
my $base = tempdir(CLEANUP => 1);
chdir $base or die "cannot chdir: $!\n";
make_path("owned/runs/alu_1", "outside/precious");
open my $w, ">", File::Spec->catfile("outside", "precious", "data.txt")
    or die "cannot write: $!\n";
print $w "somebody's only copy\n";
close $w;
# a symlink from inside the run area to the thing outside it
symlink File::Spec->catdir("..", "..", "outside", "precious"),
        File::Spec->catdir("owned", "runs", "link_out")
    or die "cannot symlink: $!\n";

my $OWNED = abs_path("owned/runs");

sub may_remove {
    my ($target) = @_;

    # 1. an empty or undefined target FIRST -- see section 3
    return (0, "empty or undefined") unless defined $target && length $target;

    # 2. resolve it. abs_path follows symlinks and collapses "..", which is
    #    exactly what makes this a location test rather than a spelling test.
    my $real = abs_path($target);
    return (0, "cannot resolve") unless defined $real;

    # 3. the owned root itself is not a legal target
    return (0, "is the owned root itself") if $real eq $OWNED;

    # 4. and it must be strictly underneath. The trailing slash matters:
    #    without it, "/scratch/runs-old" would pass against "/scratch/runs".
    return (0, "outside the owned root")
        unless index($real, $OWNED . "/") == 0;

    return (1, "ok");
}

printf "owned root = %s\n\n", $OWNED =~ s{.*/owned}{<base>/owned}r;
printf "%-38s %-8s %s\n", "TARGET", "VERDICT", "REASON";
for my $t ("owned/runs/alu_1",
           "owned/runs",
           "owned/runs/../../outside/precious",
           "owned/runs/link_out",
           "/tmp",
           "",
           "owned/runs/nope") {
    my ($ok, $why) = may_remove($t);
    printf "%-38s %-8s %s\n", "'$t'", ($ok ? "SAFE" : "REJECT"), $why;
}

# ---- and WHY the resolution step is what does the work
print "\nwhat abs_path does to each of those:\n";
for my $t ("owned/runs/../../outside/precious", "owned/runs/link_out") {
    my $r = abs_path($t);
    printf "  %-36s -> %s\n", "'$t'",
        (defined $r ? $r =~ s{.*/(owned|outside)}{<base>/$1}r : "undef");
}

owned root = <base>/owned/runs

TARGET                                 VERDICT  REASON
'owned/runs/alu_1'                     SAFE     ok
'owned/runs'                           REJECT   is the owned root itself
'owned/runs/../../outside/precious'    REJECT   outside the owned root
'owned/runs/link_out'                  REJECT   outside the owned root
'/tmp'                                 REJECT   outside the owned root
''                                     REJECT   empty or undefined
'owned/runs/nope'                      SAFE     ok

what abs_path does to each of those:
  'owned/runs/../../outside/precious'  -> <base>/outside/precious
  'owned/runs/link_out'                -> <base>/outside/precious

Five of the seven targets are rejected, and each for a different reason worth understanding.

owned/runs/alu_1 is accepted. The normal case.

owned/runs is rejected as the root itself. Deleting the run area rather than a run inside it is a one-character mistake — a missing /$test in an interpolation — and this is the check that catches it.

owned/runs/../../outside/precious is rejected. abs_path collapsed the .. segments, and what came back is not under the owned root. A spelling test would have seen /runs/ in the string and accepted it.

owned/runs/link_out is rejected, and this is the important one. It is a symbolic link that lives inside the run area and points outside it. Every character of its path says it is a run directory. abs_path followed the link and the resolved location is outside/precious, so the test rejects it. The bottom section of the output shows both resolutions side by side.

/tmp is rejected — a plausible argument from a careless command line.

'' is rejected by the first guard, which section 3 is entirely about.

owned/runs/nope is accepted even though it does not exist. That is deliberate and worth stating: the test answers "would it be legal to remove this", not "is there something there". Removing a non-existent path is a no-op, so accepting it is harmless — and a separate -e test is the right place to decide whether absence is an error.

3. The Empty-Target Hazard

This is the measurement that makes the ordering in that function matter.

use strict;
use warnings;
use Cwd qw(abs_path getcwd);
use File::Spec;
use File::Temp qw(tempdir);
use File::Path qw(make_path);

my $base = tempdir(CLEANUP => 1);
my $START = getcwd();
END { chdir $START if defined $START }
chdir $base or die "cannot chdir: $!\n";
make_path("owned/runs/alu_1");
my $OWNED = abs_path("owned/runs");

# A: no empty-string guard. EVERYTHING ELSE IS CORRECT -- it resolves, it
#    rejects the root, and it requires containment with a trailing slash.
sub no_guard {
    my ($t) = @_;
    my $real = abs_path($t // "");
    return (0, "cannot resolve") unless defined $real;
    return (0, "is the root")    if $real eq $OWNED;
    return (index($real, "$OWNED/") == 0) ? (1, "ok") : (0, "outside");
}

# B: the same, with the guard first.
sub with_guard {
    my ($t) = @_;
    return (0, "empty") unless defined $t && length $t;
    my $real = abs_path($t);
    return (0, "cannot resolve") unless defined $real;
    return (0, "is the root")    if $real eq $OWNED;
    return (index($real, "$OWNED/") == 0) ? (1, "ok") : (0, "outside");
}

chdir File::Spec->catdir("owned", "runs", "alu_1") or die "cannot chdir: $!\n";
printf "running from       %s\n", getcwd()      =~ s{.*/owned}{<base>/owned}r;
printf "abs_path(\"\") here  %s\n\n", abs_path("") =~ s{.*/owned}{<base>/owned}r;

printf "%-14s %-24s %s\n", "TARGET", "no empty guard", "with the guard first";
for my $t ("", undef, "alu_1") {
    my ($a, $aw) = no_guard($t);
    my ($b, $bw) = with_guard($t);
    printf "%-14s %-24s %s\n", (defined $t ? "'$t'" : "undef"),
        sprintf("%s (%s)", ($a ? "SAFE" : "reject"), $aw),
        sprintf("%s (%s)", ($b ? "SAFE" : "reject"), $bw);
}

running from       <base>/owned/runs/alu_1
abs_path("") here  <base>/owned/runs/alu_1

TARGET         no empty guard           with the guard first
''             SAFE (ok)                reject (empty)
undef          SAFE (ok)                reject (empty)
'alu_1'        SAFE (ok)                SAFE (ok)

abs_path("") returns the current directory.

That single fact is the hazard. Without the empty guard, an empty target resolves to wherever the script happens to be standing — and if the script is standing inside the run area, as a cleanup script very often is, the resolved path is under the owned root and the containment test says SAFE. An rmtree after that deletes the directory the script is sitting in.

And an empty target is not a contrived input. It is what you get from:

• $opt{rundir} when --rundir was not passed and there is no default
• a hash lookup for a key that is not there
• $ENV{RUN_DIR} set to the empty string rather than unset — which Chapter 15.5 measured as a distinct state that || hides and // preserves
• the last line of a file read into a list, when the file ends with a blank line

The third row of the table is the control. 'alu_1' is accepted by both versions, which proves the guard is not simply rejecting everything — the difference is specific to the empty case.

4. The Remove, and Its Report

With the test in place, the removal itself is short — and should still report rather than assume.

use File::Path qw(remove_tree);

my ($ok, $why) = may_remove($target);
unless ($ok) {
    print STDERR "refusing to remove '$target': $why\n";
    exit 2;                                  # 15.4: a usage error
}

if ($opt{"dry-run"}) {
    print "would remove: $target\n";
    exit 0;
}

my $count = remove_tree($target, { error => \my $err, safe => 1 });
if (@{ $err || [] }) {
    for my $item (@$err) {
        my ($file, $message) = %$item;
        print STDERR "cleanup error: " . ($file eq "" ? "(general)" : $file) . ": $message\n";
    }
    exit 1;                                  # 15.4: tried and failed
}
printf STDERR "removed %d item(s) under %s\n", $count, $target;

Five things in those lines earn their place:

--dry-run before anything irreversible. Print what would go and exit 0. For a cleanup script this is not a nicety; it is how somebody checks your containment logic against their tree before trusting it. Make it the behaviour you demonstrate in the usage message.

safe => 1. remove_tree will otherwise chmod directories it cannot enter in order to delete them. With safe, it refuses instead. For a run area you own, either is defensible; for anything reached by accident, refusing is what you want.

The error list, unpacked. Same shape as Chapter 17.5's make_path: one single-key hash per failure. Note the $file eq "" case — remove_tree uses an empty filename for a general error that is not about one specific file.

remove_tree returns a count of files and directories removed. Reporting it turns "cleanup ran" into "cleanup removed 412 items", which is the difference between a log line and evidence.

Distinct exit codes. 2 for "I refuse", 1 for "I tried and failed", 0 for success. Chapter 15.4 measured why a flow needs these separated.

5. What To Remember

• A pattern on the path tests the spelling, not the location, and cannot see through a symlink.
• The replacement is containment: resolve the target, resolve the owned root, require the first strictly under the second.
• Measured: 5 of 7 targets rejected, each for a different reason.
• The owned root itself must be rejected explicitly — a missing /$test in an interpolation is a one-character mistake.
• abs_path collapses .., so runs/../../outside is caught.
• A symlink inside the run area pointing outside it is caught — every character of its path looks like a run directory, and the resolved location does not.
• The trailing slash in $OWNED . "/" is load-bearing — without it /scratch/runs-old passes against /scratch/runs.
• Resolve BOTH sides. Chapter 17.1 measured abs_path rewriting /var to /private/var; comparing resolved against unresolved rejects everything.
• A non-existent target is legal to remove — the test answers "would this be legal", not "is anything there".
• Measured: abs_path("") returns the current directory.
• So with no empty guard, an empty target is judged SAFE when the script stands inside the run area — and rmtree then deletes the cwd.
• An empty target is ordinary: a missing option, an absent hash key, RUN_DIR="", a trailing blank line.
• Guard empty and undefined FIRST, before resolving anything.
• A demonstration whose two sides agree is a broken demonstration — mine did, and the fix was to compare against no guard at all.
• Always offer --dry-run, and demonstrate it in the usage message.
• Use remove_tree with safe => 1 and unpack its error list; $file eq "" means a general error.
• Report the count removed, and use distinct exit codes: 2 refused, 1 failed, 0 done.
• Never system("rm -rf $dir") — a space in the path removes two things.
• Age is not ownership. Containment first, then age.

Chapter 17.7 turns from directories to the files inside them. A tool setup file has to be updated by a script without disturbing the comments and settings that somebody else put there deliberately.