Repository List / sysadmin-cookbook / recepies / zfs / zfs-expire-snapshot.pl @ HEAD

#!/usr/bin/perl

use warnings;
use strict;

use DateTime;
use Data::Dump qw/dump/;

my $debug = 0;

my $config = {
	'default' => {
		21 => 5,
		30 => 10,
		60 => 30,
	},
	'212052' => {	# koha-dev
		7 => 10,
		14 => 30,
	},
	'212056' => {	# webpac2
		7 => 5,
	}
};

my $now = DateTime->now();

my $last_backup;

open(my $fs, '-|', 'zfs list -H');
while(<$fs>) {
	chomp;
	my ( $name, $used, $avail, $refer, $mountpoint ) = split(/\t/,$_,6);

	next unless $name =~ m{(.+)@(\d\d\d\d)-(\d\d)-(\d\d)};

	my $host = $1;

	my $date = DateTime->new( year => $2, month => $3, day => $4 );

	my $age = $now->delta_days( $date )->delta_days;

	my $op = ' ';
	my $last = 0;

	my $c = (grep { $host =~ m{\Q$_\E} } keys %$config)[0];
	$c = 'default' unless defined $c;

	warn "# config: $c\n" if $debug;

	my $h = $host;
	$h =~ s{,+/([^/]+)$}{}; # just hostname without path

	$c = $config->{$c} || die "can't find config for $c";

	warn "# c = ",dump($c) if $debug;

	my $keep_every_days;
	my $older_than_days;
	foreach ( sort keys %$c ) {
		$older_than_days = $_;
		$keep_every_days = $c->{$_};
		warn "## $host $age > $older_than_days" if $debug;
		last if $age > $older_than_days;
	}

	my $config_applied = '';

	if ( $age > $older_than_days ) {

		$config_applied = "> $older_than_days keep $keep_every_days";

		$last_backup->{$host} ||= $date;
		$last = $last_backup->{$host}->delta_days( $date )->delta_days;

		if ( $last && $last < $keep_every_days ) {
			$op = 'D';
		} else {
			$op = ' ';
			$last_backup->{$host} = $date;
		}
	} else {
		$config_applied = 'none';
	}

	print "$op $name\t$used\t$refer\t$age\t$last\t$config_applied\n";

	system "zfs destroy $name" if $op eq 'D' && @ARGV;
}