#!/usr/bin/perl
#
# Manage the snapshots on a GPFS file system such that they will be usable
# with the Samba VFS module shadow_copy2
#
# Written by Jonathan Buzzard <jonathan at buzzard dot me dot uk>
#
#
# When called it creates a snapshot with the current time and removes any
# snapshot that is older than the specified age in hours. It can be configured
# not to create snapshots with a specified time frame in seconds of an existing
# snapshot. It is designed to be called from cron on all the NSD nodes in a
# GPFS cluster. The idea being that if one or more nodes is unavailable for
# whatever reason a snapshot still gets taken. A suitable crontab entry would be
#
# 0 7,10,13,16 * * * root /usr/local/bin/shadowcopy.pl
#
# This creates four snapshots a day at four hour intervals starting at 07:00
# before the working day starts, at 10:00 after an hour of two of work, 13:00
# at lunch, and 16:00 shortly before the end of the day. The idea being to
# provide some role back of files during the day. Everything else should be
# covered by the over night backups.
#
#
# $Log:$
#

use strict;
use warnings;
use Date::Parse;


#
# avoid any localization errors
#
$ENV{LANG} = 'en_US.UTF-8';

#
# system specific parameters, configure to your own requirements.
#
my $age = 23;
my $similar = 300;
my @gpfs = qw { test };
my $lockdir = 'ctdb/quiescence.lock';

# location of the GPFS executables
my $mmcrsnapshot = '/usr/lpp/mmfs/bin/mmcrsnapshot';
my $mmdelsnapshot = '/usr/lpp/mmfs/bin/mmdelsnapshot';
my $mmlssnapshot = '/usr/lpp/mmfs/bin/mmlssnapshot';



#
# Grab the cluster wide quiescence lock
#
sub GetLock {
	my $lock = shift @_;

	mkdir($lock, 664) or die "Unable to get cluster wide quiescence lock";

        return;
}


#
# Remove the cluster wide quiescence lock
#
sub Unlock {
	my $lock = shift @_;

	rmdir($lock);

	return;
}


#
# Generate a date string of the current time in Shadow Copy format
#
sub SnapshotName {

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
	my $date = sprintf("\@GMT-%04d.%02d.%02d-%02d.%02d.00", $year+1900,$mon+1,$mday,$hour,$min);

	return $date;
}


#
# Turn a snapshot name into seconds since the epoch
#
sub Snapshot2Epoch {
	my $name = shift @_;

	# mung the name into a format that str2time will recognize
	$name =~ s/\@GMT-//g;
	$name =~ s/\.//g;
	$name =~ s/-/T/g;
	$name .= 'Z';

	return str2time($name);
}


#
# Return a hash of Shadow Copy snapshots on the system and their creation time
#
sub ListSnapshots {
	my $filesystem = shift @_;


	# grab the output of the mmlssnapshot command to an array
	my @output = `$mmlssnapshot $filesystem`;
	if ($? == -1) {
		die "unable to list snapshots on $filesystem\n";
	} elsif ($? & 127) {
		die "child died while trying to list snapshots\n",
	} elsif (($?>>8) != 0) {
		die "unable to list snapshots on $filesystem\n";
	}

	# add snapshots with names of the form @GMT- to and array
	my %list = ();
	foreach (@output) {
		if (/(^\@GMT-\d{4}.\d{2}.\d{2}-\d{2}.\d{2}.\d{2}).*Valid\s(.*)/) {
			my $epoch = Snapshot2Epoch($1);
			if (!defined($epoch)) {
				die "unable to turn snapshot creation time into seconds since epoch\n";
			}
			$list{$1} = $epoch;
		}
	}
	
	return %list;
}


#
# Create a snapshot with valid Shadow Copy name
#
sub TakeSnapshot {
	my $filesystem = shift @_;

	# get the list of existing snapshots
	my %snapshots = ListSnapshots($filesystem);

	# generate the name of the proposed snapshot
	my $proposed = SnapshotName();
	my $time = Snapshot2Epoch($proposed);

	# test to make sure the snapshot does not already exist
	while (my ($name,$epoch) = each(%snapshots)) {
		if (abs($epoch-$time) <= $similar) {
			warn "a matching snapshot already exists\n";
			return 1;
		}
	}

	# take the snapshot
	system("$mmcrsnapshot $filesystem $proposed");
	if ($? == -1) {
		warn "unable to run snapshot command on $filesystem\n";
		return 1;
	} elsif ($? & 127) {
		printf STDERR "child died with signal %d, %s coredump\n",
		($? & 127), ($? & 128) ? 'with' : 'without';
	} elsif (($?>>8) != 0) {
		warn "failure taking snapshot on $filesystem\n";
		return 1;
	}

	return 0;
}


#
# Delete a snapshot with the specified name
#
sub DeleteSnapshot {
	my ($name, $filesystem) = @_;

	# check the snapshot exists first
	my %snapshots = ListSnapshots($filesystem);
	while (my ($search,$epoch) = each(%snapshots)) {
		if ($search = $name) {
			# delete the snapshot
			system("$mmdelsnapshot $filesystem $name");
			if ($? == -1) {
				warn "unable to run delete snapshot command on $filesystem\n";
				return 1;
			} elsif ($? & 127) {
				printf  STDERR  "child died with signal %d, %s coredump\n",
				($? & 127), ($? & 128) ? 'with' : 'without';
			} elsif (($?>>8) != 0) {
				warn "failure deleting snapshot on $filesystem\n";
				return 1;
			}
			return 0;
		}
	}

	return 1;
}


#
# Remove all snapshots that are older than the age time
#
sub AgeSnapshots {
	my $filesystem = shift @_;

	# get the list of snapshots on the file system
	my %snapshots = ListSnapshots($filesystem);

	# find the ones older than $age hours
	my $now = time;
	$age *= 3600;
	while (my ($name,$epoch) = each(%snapshots)) {
		# delete the old snapshots
		if (($now-$epoch)>$age) {
			DeleteSnapshot($name, $filesystem);
		}
	}

	return;
}


#
# Check the file system is GPFS and mounted
#
sub CheckFilesystem {
	my $filesystem = shift @_;

	open FH, "</etc/mtab";
	foreach (<FH>) {
		my @fields = split(' ', $_);
		if (($fields[0] =~ m/^\/dev\/$filesystem/) && ($fields[2] eq 'gpfs')) {
			return 1;
		}
	}
	close FH;

	return 0;
}


#
# loop through each file system taking and aging the snapshots
#
foreach my $fs (@gpfs) {
	if (CheckFilesystem($fs)) {
		GetLock("/$fs/$lockdir");
		TakeSnapshot($fs);
		AgeSnapshots($fs);
		Unlock("/$fs/$lockdir");
	}
}

exit 0;