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";