Subversion Repositories zfs_utils

Rev

Rev 53 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 53 Rev 54
Line 2... Line 2...
2 
use strict;
 2 
use strict;
3 
use warnings;
 3 
use warnings;
4 
use File::Temp qw(tempdir);
 4 
use File::Temp qw(tempdir);
5 
use File::Spec;
 5 
use File::Spec;
6 
use Cwd qw(abs_path);
 6 
use Cwd qw(abs_path);
- 
 
 7 
use File::Basename qw(dirname);
- 
 
 8 
use Time::Piece;
7 
 
 9 
 
8 
my $td = tempdir(CLEANUP => 1);
 10 
my $td = tempdir(CLEANUP => 1);
9 
 
 11 
 
10 
# location of the cleanSnaps script (this test lives in the same directory)
 12 
# location of the cleanSnaps script (this test lives in the same directory as the test file)
11 
my $here = abs_path(File::Spec->rel2abs("."));
 13 
my $here = dirname(abs_path(__FILE__));
12 
my $clean = File::Spec->catfile($here, 'cleanSnaps');
 14 
my $clean = File::Spec->catfile($here, 'cleanSnaps');
13 
unless (-e $clean) {
 15 
unless (-e $clean) {
14 
    die "Could not find cleanSnaps at $clean";
 16 
    die "Could not find cleanSnaps at $clean";
15 
}
 17 
}
16 
 
 18 
 
Line 49... Line 51...
49 
$ENV{ZFS_CMD} = $fake;
 51 
$ENV{ZFS_CMD} = $fake;
50 
 
 52 
 
51 
# execute and capture output (use perl from the environment if available)
 53 
# execute and capture output (use perl from the environment if available)
52 
my $out;
 54 
my $out;
53 
if ($ENV{PERL}) {
 55 
if ($ENV{PERL}) {
54 
    $out = qx{$ENV{PERL} -I. "$clean" -n -v 2>&1};
 56 
    $out = qx{$ENV{PERL} -I. "$clean" -v 2>&1};
55 
} else {
 57 
} else {
56 
    $out = qx{perl "$clean" -n -v 2>&1};
 58 
    $out = qx{perl -I. "$clean" -v 2>&1};
57 
}
 59 
}
58 
 
 60 
 
59 
print "=== cleanSnaps output ===\n$out\n";
 61 
print "=== cleanSnaps output ===\n$out\n";
60 
 
 62 
 
61 
my @lines = split /\n/, $out;
 63 
my @lines = split /\n/, $out;
62 
my @removed = map { s/^\s+//; $_ } grep { /^\s+\S+@/ } @lines;
 64 
my @removed = map { s/^\s+//; $_ } grep { /^\s+\S+@/ } @lines;
63 
 
 65 
 
64 
my %removed = map { $_ => 1 } @removed;
 66 
my %removed = map { $_ => 1 } @removed;
65 
 
 67 
 
- 
 
 68 
# Compute expected removals using the same rules as cleanSnaps so the test is
- 
 
 69 
# robust against clock/time differences. Read the sample snapshot list by
- 
 
 70 
# executing the fake zfs list script and parse each snapshot name.
66 
my @should_be_removed = (
 71 
my $snap_output = qx{$fake};
- 
 
 72 
my @snap_lines = split /\n/, $snap_output;
- 
 
 73 
 
- 
 
 74 
my @fmts = (
67 
    'pool/fs@2025-01-01-3d',
 75 
    '%Y-%m-%d %H:%M:%S',
68 
    'pool/fs@2025-12-10-3d',
 76 
    '%Y-%m-%dT%H:%M:%S',
69 
    'pool/fs@2025-11-01-snap-4w',
 77 
    '%Y-%m-%d %H:%M',
70 
    'pool/fs@2025-12-01T12:00:00_1h',
 78 
    '%Y-%m-%d_%H.%M.%S',
71 
    'pool/fs@prefix_2025-12-01 13:00:00_2h',
 79 
    '%Y-%m-%d_%H.%M',
- 
 
 80 
    '%Y-%m-%d',
72 
);
 81 
);
73 
 
 82 
 
74 
my @should_be_kept = (
 83 
sub parse_and_should_remove {
75 
    'pool/fs@2025-12-14-2d',
 84 
    my ($snap, $now) = @_;
- 
 
 85 
    # expect full snapshot name like pool/fs@name
76 
    'pool/fs@2025-12-01_foo_1m',
 86 
    return 0 unless $snap =~ /@/;
- 
 
 87 
    my (undef, $snapname) = split /@/, $snap, 2;
- 
 
 88 
    return 0 unless $snapname =~ m/.*?(\d{4}-\d{2}-\d{2}(?:[T _]\d{2}[:\.]\d{2}(?:[:\.]\d{2})?)?)(?:.*?)(\d+)([smhdwy])$/;
- 
 
 89 
    my ($snap_date, $num, $unit) = ($1, $2, $3);
- 
 
 90 
    # parse date/time
- 
 
 91 
    my $snap_epoch;
- 
 
 92 
    my $parsed = 0;
- 
 
 93 
    for my $fmt (@fmts) {
- 
 
 94 
        eval {
- 
 
 95 
            my $tp = Time::Piece->strptime($snap_date, $fmt);
- 
 
 96 
            $snap_epoch = $tp->epoch;
- 
 
 97 
            $parsed = 1;
- 
 
 98 
            1;
- 
 
 99 
        };
77 
    'pool/fs@badname',
 100 
        last if $parsed;
- 
 
 101 
    }
- 
 
 102 
    return 0 unless $parsed;
- 
 
 103 
    my $retention_seconds;
- 
 
 104 
    if ($unit eq 's') { $retention_seconds = $num }
- 
 
 105 
    elsif ($unit eq 'm') { $retention_seconds = $num * 30 * 86400 }
- 
 
 106 
    elsif ($unit eq 'h') { $retention_seconds = $num * 3600 }
- 
 
 107 
    elsif ($unit eq 'd') { $retention_seconds = $num * 86400 }
- 
 
 108 
    elsif ($unit eq 'w') { $retention_seconds = $num * 7 * 86400 }
- 
 
 109 
    elsif ($unit eq 'y') { $retention_seconds = $num * 365 * 86400 }
- 
 
 110 
    else { return 0 }
- 
 
 111 
    my $age = $now - $snap_epoch;
- 
 
 112 
    return $age > $retention_seconds ? 1 : 0;
- 
 
 113 
}
- 
 
 114 
 
- 
 
 115 
my $now = time();
- 
 
 116 
my %expected_removed;
- 
 
 117 
for my $line (@snap_lines) {
- 
 
 118 
    next unless $line =~ /@/;
- 
 
 119 
    my $should = parse_and_should_remove($line, $now);
- 
 
 120 
    $expected_removed{$line} = $should if $should;
78 
);
 121 
}
79 
 
 122 
 
80 
my $ok = 1;
 123 
my $ok = 1;
81 
for my $s (@should_be_removed) {
 124 
for my $snap (keys %expected_removed) {
82 
    unless ($removed{$s}) {
 125 
    unless ($removed{$snap}) {
83 
        print "FAIL: expected $s to be marked for removal\n";
 126 
        print "FAIL: expected $snap to be marked for removal\n";
84 
        $ok = 0;
 127 
        $ok = 0;
85 
    }
 128 
    }
86 
}
 129 
}
87 
for my $s (@should_be_kept) {
 130 
for my $line (@snap_lines) {
- 
 
 131 
    next unless $line =~ /@/;
- 
 
 132 
    unless ($expected_removed{$line}) {
88 
    if ($removed{$s}) {
 133 
        if ($removed{$line}) {
89 
        print "FAIL: expected $s to be kept but it was marked for removal\n";
 134 
            print "FAIL: expected $line to be kept but it was marked for removal\n";
90 
        $ok = 0;
 135 
            $ok = 0;
- 
 
 136 
        }
91 
    }
 137 
    }
92 
}
 138 
}
93 
 
 139 
 
94 
if ($ok) {
 140 
if ($ok) {
95 
    print "TEST PASS\n";
 141 
    print "TEST PASS\n";