Subversion Repositories zfs_utils

#!/usr/bin/env perl

# Simplified BSD License (FreeBSD License)
#
# Copyright (c) 2025, Daily Data Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# cleanSnaps - detect and remove old ZFS snapshots named like YYYY-MM-DD-<N><d|w|m>
# Usage: cleanSnaps [-n] [-f] [-v] [-t <shift>] [-h]
#   -n  dry-run (default)
#   -f  actually destroy snapshots
#   -v  verbose
#   -t  time shift, simulate running at a different time. Examples:
#       -t 2m   (run as if 2 months ago)
#       -t -4w  (run as if 4 weeks earlier)
#       -t +3d  (run as if 3 days in the future)
#   -h  show this help and exit

use strict;
use warnings;
use Getopt::Std;
use Time::Piece;

my %opts;
getopts('nfvht:', \%opts);

my $DRY_RUN = $opts{f} ? 0 : 1;    # default dry-run, -f disables dry-run
my $FORCE = $opts{f} ? 1 : 0;
my $VERBOSE = $opts{v} ? 1 : 0;

my $ZFS_CMD = $ENV{ZFS_CMD} // 'zfs';

sub logmsg { print @_, "\n" if $VERBOSE }

# show help and exit
if ($opts{h}) {
    print "Usage: cleanSnaps [-n] [-f] [-v] [-t <shift>] [-h]\n";
    print "  -n  dry-run (default)\n";
    print "  -f  actually destroy snapshots\n";
    print "  -v  verbose\n";
    print "  -t  time shift, simulate running at a different time (examples: 2m, -4w, +3d)\n";
    print "  -h  show this help and exit\n";
    exit 0;
}

# compute simulated "now" if the user requested a time shift
my $now = time();
if (defined $opts{t} && $opts{t} =~ /^(?:([+-]?)(\d+)([smhdwy]))$/i) {
    my ($sign, $num, $unit) = ($1, $2, lc $3);
    # default behavior: no leading sign => treat as negative (simulate running in the past)
    $sign = '-' unless defined $sign && $sign ne '';
    my %unit_secs = (
        s => 1,
        m => 30 * 86400,   # months approximated as 30 days to match snapshot 'm' semantics
        h => 3600,
        d => 86400,
        w => 7 * 86400,
        y => 365 * 86400,
    );
    if (!exists $unit_secs{$unit}) {
        die "Invalid time unit '$unit' in -t option; use s,m,h,d,w,y\n";
    }
    my $shift_seconds = $num * $unit_secs{$unit};
    $shift_seconds = -$shift_seconds if $sign eq '-';
    $now += $shift_seconds;
    logmsg("Simulating current time with shift $opts{t}; adjusted now -> " . scalar(localtime($now)) );
}
my @candidates;

open my $fh, '-|', "$ZFS_CMD list -H -o name -t snapshot" or die "Failed to run $ZFS_CMD: $!";
while (my $snap = <$fh>) {
    chomp $snap;
    next unless defined $snap && $snap =~ /\S/;

    unless ($snap =~ /@/) {
        logmsg("skipping invalid snapshot name: $snap");
        next;
    }
    my ($dataset, $snapname) = split /@/, $snap, 2;

    # match date + retention tag (allow optional text between date and TTL).
    # Examples matched: 2025-12-01-3d, 2025-12-01-snap-3d, 2025-12-01_foo_bar_2w
    unless ($snapname =~ m/^(\d{4}-\d{2}-\d{2})(?:.*?)(\d+)([dwmy])$/) {
        logmsg("snapshot does not match YYYY-MM-DD ... <N><d|w|m|y>: $snap");
        next;
    }
    my ($snap_date, $num, $unit) = ($1, $2, $3);

    # parse snapshot date using Time::Piece
    my $snap_epoch;
    eval {
        my $tp = Time::Piece->strptime($snap_date, '%Y-%m-%d');
        $snap_epoch = $tp->epoch;
        1;
    } or do {
        logmsg("failed to parse date $snap_date for $snap");
        next;
    };

    my $days;
    if ($unit eq 'd') { $days = $num }
    elsif ($unit eq 'w') { $days = $num * 7 }
    elsif ($unit eq 'm') { $days = $num * 30 }
    elsif ($unit eq 'y') { $days = $num * 365}
    else { logmsg("unknown unit $unit for $snap"); next }

    my $retention_seconds = $days * 86400;
    my $age = $now - $snap_epoch;
    if ($age > $retention_seconds) {
        push @candidates, $snap;
    } else {
        logmsg("keep: $snap (age " . int($age/86400) . "d <= ${days}d)");
    }
}
close $fh;

if (!@candidates) {
    print "No snapshots to remove.\n";
    exit 0;
}

printf "Snapshots to remove (%d):\n", scalar @candidates;
for my $s (@candidates) { printf "  %s\n", $s }

if ($DRY_RUN) {
    print "\nDry-run: no snapshots were destroyed. Use -f to actually remove them.\n";
    exit 0;
}

# actual removal
my $failed = 0;
for my $s (@candidates) {
    printf "Destroying: %s\n", $s;
    my $rc = system($ZFS_CMD, 'destroy', $s);
    if ($rc != 0) {
        printf STDERR "Failed to destroy %s\n", $s;
        $failed = 1;
    }
}

if ($failed) {
    print STDERR "One or more destroys failed.\n";
    exit 1;
}

print "Done.\n";