File: 01.symtogsafe.t

package info (click to toggle)
libfile-path-tiny-perl 1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 132 kB
  • sloc: perl: 143; makefile: 2
file content (133 lines) | stat: -rw-r--r-- 4,264 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
use strict;
use warnings;

use Test::More;
use Test::Exception;

use File::Path::Tiny;

if ( !-x "/bin/mv" || !-x "/bin/mkdir" ) {    # dragons! patches welcome
    plan skip_all => 'Only operate on systems w/ /bin/mv and /bin/mkdir, for reasons see the cource code comments';
}
else {
    plan tests => 22;
}

use File::Temp;
use Cwd;
use File::Spec;

my $orig_dir = Cwd::cwd();
my $dir      = File::Temp->newdir();
our $catdir_toggle = sub { };
our @catdir_calls;

chdir $dir || die "Could not chdir into temp directory: $!\n";    # so we can pathrm(), dragons!

{
    ##############################################################################
    #### Wrap catdir() to control a symlink toggle in the path traversal loops. ##
    ##############################################################################
    no strict "refs";
    no warnings "redefine", "once";
    my $real_catdir = \&{ $File::Spec::ISA[0] . "::catdir" };
    local *File::Spec::catdir = sub {
        my ( $self, @args ) = @_;
        push @catdir_calls, \@args;
        $catdir_toggle->(@args);
        goto &$real_catdir;
    };

    mkdir "empty_dir";
    mkdir "empty_dir/sanity";
    File::Path::Tiny::empty_dir("empty_dir");
    is( @catdir_calls, 1, "sanity check: catdir was actually called in the empty_dir() loop" );

    mkdir "rm";
    mkdir "rm/sanity";
    File::Path::Tiny::rm("rm");
    is( @catdir_calls, 2, "sanity check: catdir was actually called in the pathrmdir() loop" );

    ####################
    #### Actual tests ##
    ####################

    for my $func (qw(empty_dir rm)) {
        _test( $func, "cwd/foo/bar/baz", "bails when high level changes" );
        _test( $func, "cwd/foo/bar",     "bails when mid level changes" );
        _test( $func, "cwd/foo",         "bails when low level changes" );
        _test( $func, "cwd",             "bails when CWD level changes" );
        _test( $func, "",                "bails when below level changes" );
    }

    # TODO: cover readdir, chdir, and post loop failures
}

chdir $orig_dir || die "Could not chdir back to original directory: $!\n";

###############
#### helpers ##
###############

sub _test {
    my ( $func, $toggle, $label ) = @_;

    _setup_tree($func);

    {
        local @catdir_calls  = ();
        local $catdir_toggle = sub {
            chdir $dir || die "could not toggle dir/symlink (chdir): $!";

            my $parent = "";
            if ($toggle) {
                $parent = $toggle;
                $parent =~ s{[^/]+$}{};

                # use system call since the perl to do this will likely use File::Spec
                system("/bin/mkdir -p moved/$func/$parent") and die "could not toggle dir/symlink (mkdir): $?\n";
            }

            # use system call since the perl to do this will likely use File::Spec
            system("/bin/mv $dir/$func/$toggle $dir/moved/$func/$toggle") and die "could not toggle dir/symlink (mv): $?\n";
            symlink( "$dir/victim", "$dir/$func" . ( $toggle ? "/$toggle" : "" ) ) or die "could not toggle dir/symlink (sym): $!\n";

            chdir "$func/cwd" || die "could not toggle dir/symlink (back into $func/cwd): $!\n";
        };

        throws_ok { no strict "refs"; "File::Path::Tiny::$func"->("foo/bar/baz") }
        qr/directory .* changed: expected dev=.* ino=.*, actual dev=.* ino=.*, aborting/,
          "$func() detected symlink toggle: $label";

        is( @catdir_calls, 1, "sanity check: catdir was actually called in $func() ($label)" );
    }

    _teardown_tree($func);
}

sub _teardown_tree {
    my ($base) = @_;

    chdir $dir || die "Could not chdir back into temp dir: $!\n";

    File::Path::Tiny::rm($base);
    File::Path::Tiny::rm("moved/");
    File::Path::Tiny::rm("victim/");

    return;
}

sub _setup_tree {
    my ($base) = @_;

    for my $dir ( "moved", "victim", "victim/cwd", $base, "$base/cwd", "$base/cwd/foo", "$base/cwd/foo/bar", "$base/cwd/foo/bar/baz" ) {
        mkdir $dir || die "Could not make test tree ($dir): $!\n";
        open my $fh, ">", "$dir/file.txt" || die "Could not make test file in ($dir): $!\n";
        print {$fh} "oh hai\n";
        close($fh);
    }

    chdir "$base/cwd" || die "Could not chdir into $base/cwd: $!\n";

    return;
}