#!/usr/bin/perl -w
# vim:ai:filetype=perl:sta:sw=4:et:

use strict;
use Getopt::Long;
use Pod::Usage;

Getopt::Long::Configure('gnu_getopt',
                        'prefix_pattern=(--|-)');

my $DEBUG=0;
my $VERSION=1.3;

# Declarations
#
my $TRESHOLD=90;
my $SNAPCOUNT=2;

my ($ACTION, $VOLGRP, $SRCLV, $SNSIZE)=();
my ($VERBOSE, $SNAME, $SCOPE, $MAILTO)=();
my ($OPTIONS, $HELP)=();
my @snaps=();
my $outstr;
my @tmparr;

# main
GetOptions ('option|o' => \$OPTIONS,
            'action|a=s' => \$ACTION,
            'versose|v' => \$VERBOSE,
            'volgroup|V=s' => \$VOLGRP,
            'sourcelv|s=s' => \$SRCLV,
            'scope|S=s' => \$SCOPE,
            'mailto|m=s' => \$MAILTO,
            'snapname|n=s' => \$SNAME,
            'size|L=s' => \$SNSIZE,
            'treshold|t=i' => \$TRESHOLD,
            'snapcount|c=i' => \$SNAPCOUNT,
            'help|h' => \$HELP)
    or pod2usage(-verbose => 0, -exitval => 2);

pod2usage(-verbose => 1) if ($OPTIONS);
pod2usage(-verbose => 2) if ($HELP);


if ( not defined $ACTION or ($ACTION !~ /^s(nap)?$/ and $ACTION !~ /^m(ail)?$/
    and $ACTION !~ /^r(eport)?$/)) {
    print STDERR "Error: missing or invalid action type.\n";
    pod2usage(-verbose => 0, -exitval => 2);
}
elsif (($ACTION =~ /^s/ and (not defined $VOLGRP or not defined $SRCLV))
        or (not defined $SNSIZE and $ACTION =~ /^s/)) {
    print STDERR "Error: missing mandatory option.\n";
    pod2usage(-verbose => 0, -exitval => 2);
}
elsif ($ACTION =~ /^s/ and $SNSIZE !~ /^\d+[kmgt]?$/i) {
    print STDERR "Error: Invalid size value.\n";
    pod2usage(-verbose => 0, -exitval => 2);
}
elsif ($ACTION =~ /^s/ and $SNAPCOUNT < 1) {
    print STDERR "Error: use a positive integer for \"snapcount\".\n";
    pod2usage(-verbose => 0, -exitval => 2);
}
#elsif ($ACTION =~ /^s/ and defined $SNAME and defined $SCOPE) {
#    print STDERR "Error: --snapname and --scope are mutually exclusive.\n";
#    pod2usage(-verbose => 0, -exitval => 2);
#}
elsif ($ACTION =~ /^s/ and ( defined $SCOPE and $SCOPE =~ /[^[:alnum:]]/
            or defined $SNAME and $SNAME =~ /[^[:alnum:]]/)) {
    print STDERR "Error: illegal characters used in --snapname or --scope.\n";
    pod2usage(-verbose => 0, -exitval => 2);
}
elsif ($ACTION =~ /^m/ and $MAILTO !~ /^[\w\.-]+(@[\w-]+(\.[\w-]+)*)?$/) {
    print STDERR "Error: Missing or invalid mail address.\n";
    pod2usage(-verbose => 0, -exitval => 2);
}

# More declarations
my @lvscmd=("/sbin/lvs", "--noheadings", "--options",
    "lv_name,lv_attr,vg_name,origin,snap_percent");
my @lvcrt;
if ($ACTION =~ /^s/) {
    @lvcrt=("/sbin/lvcreate", "--snapshot", "--size", $SNSIZE, "--name", 
        "__FOO__", "--permission", "r", "/dev/$VOLGRP/$SRCLV");
}
my @lvrm=("/sbin/lvremove", "-f", "__FOO__");
my @dfcmd=("/bin/df", "-k");
my @lsofcmd=("/usr/bin/lsof","+D");
my $mailprog="/usr/bin/Mail";

#get lvs info
$outstr=&Backticks(@lvscmd);
chomp $outstr;
@tmparr=split("\n",$outstr);
foreach my $lvsline (@tmparr) {
    my @lvarr=split(" ", $lvsline);
    next if (scalar @lvarr != 5
            or ($ACTION =~/^s/ and ($lvarr[2] ne $VOLGRP or $lvarr[3] ne $SRCLV))
            or ($ACTION =~ /^[mr]/ and
                ((defined $VOLGRP and $lvarr[2] ne $VOLGRP) or
                 (defined $SRCLV and $lvarr[3] ne $SRCLV))));
    next if (defined $SCOPE and  $lvarr[0] !~ /^[[:alnum:]]+_${SCOPE}_\d+$/);
    push @snaps, \@lvarr;
}

if ($ACTION =~ /^s/) {
    while (scalar(@snaps) >= $SNAPCOUNT)  {
        # Delete oldest
        my $oldest="";
        my $percent=0;
        foreach my $lvline (@snaps) {
            if ($oldest eq "") {
                $oldest=$lvline->[0];
                $percent=$lvline->[4];
            }
            else {
                if ($lvline->[4] > $percent) {
                    $oldest=$lvline->[0];
                    $percent=$lvline->[4];
                }
                else {
                }
            }
        }
        # remove the entry from from @snaps
        @tmparr=();
        foreach my $lvline (@snaps) {
            push @tmparr, $lvline if ($lvline->[0] ne $oldest);
        }
        @snaps=@tmparr;
        # Check if the snapshot is mounted
        my @filesys=&Unfold(@dfcmd);
        foreach my $dfline(@filesys) {
            my $dash = ($VOLGRP =~ /-/) ? "--" : "-";
            my @dfres=split(" ", $dfline, 6);
            next if ($dfres[0] ne "/dev/mapper/$VOLGRP$dash$oldest");
            my @pids;
            my $lsofoutp=&Backticks(@lsofcmd, $dfres[5]);
            foreach my $line (split "\n", $lsofoutp) {
                chomp $line;
                next if ($line =~ /^COMMAND/);
                my @elems=split(" ",$line);
                unshift @pids, $elems[1];
            }
            # kill processes on the mounted snapshot
            if (scalar(@pids) > 0) {
                print STDERR "killing pids: ".join(" ",@pids)."\n" if ($VERBOSE);
                my $dummy=&Backticks("/bin/kill","-KILL",@pids);
            }
            # umount the snapshot
            print STDERR "unmounting snapshot $oldest\n" if ($VERBOSE);
            my $dummy=&Backticks("/bin/umount",$dfres[5]);
            die "Could not umount snapshot \"$oldest\".\n" if ($?);
        }
        print STDERR "removing snapshot $oldest\n" if ($VERBOSE);
        $lvrm[2]="/dev/$VOLGRP/$oldest";
        # remove the snapshot
        my $dummy=&Backticks(@lvrm);
        die "Could not remove old snapshot \"$oldest\".\n" if ($?);
    }
    $SNAME = "snap" if (not defined $SNAME or $SNAME eq "");
    my $SCSEP=(defined $SCOPE)?"_${SCOPE}_":"_";
    my ($min,$hour,$day,$mon);
    ($_,$min,$hour,$day,$mon,$_,$_,$_,$_)=localtime();
    $mon=sprintf("%02d",++$mon);
    $day=sprintf("%02d",$day);
    $hour=sprintf("%02d",$hour);
    $min=sprintf("%02d",$min);
    $SNAME.="$SCSEP$mon$day$hour$min";
    $lvcrt[5]=$SNAME;
    print STDERR "creating new snapshot: $SNAME\n" if ($VERBOSE);
    my $dummy=&Backticks(@lvcrt);
    die "Could not create new snapshot.\n" if ($?);
    exit 0;
}
else {
    #ACTION eq mail|report
    my $mailbody="";
    foreach my $snap (@snaps) {
        if ($VERBOSE) {
            $mailbody .= "Snapshot percentage for $snap->[0] is $snap->[4]\%\n";
        }
        if ($snap->[1] =~ /^S/) {
            $mailbody .= "ERROR: snapshot $snap->[0] is broken!\n";
        }
        elsif ($snap->[4] >= $TRESHOLD) {
            $mailbody .= "WARNING: snapshot $snap->[0] is filled " . 
                "above treshold ($snap->[4]\%)\n";
        }
    }
    if ($mailbody ne "") {
        if ($ACTION =~ /^m/) {
            die "No mailaddress specified\n" if (not defined $MAILTO);
            my $pid=undef;
            my @mailcmd=($mailprog,"-s","Snapshot report for /dev/$VOLGRP/$SRCLV",
                $MAILTO);
            if ($pid = open (CHILD,"|-")) {
                print CHILD $mailbody;
            }
            else {
                die "Cannot fork.\n" unless defined $pid;
                exec @mailcmd;
            }
        }
        else {
            print STDERR $mailbody;
        }
    }
}

# Start of subs
sub Unfold {
    my $result=&Backticks(@_);
    chomp $result;
    $result=~s/\n\s+/ /g;
    my @res=split("\n",$result);
    return @res;
}

sub Backticks {
    my @arr=@_;
    my ($result,$pid);
    if ($pid = open (CHILD,"-|")) {
        local $/;
        return <CHILD>;
    }
    else {
        if ( ! defined $pid ) {
            die "Cannot fork.\n";
        }
        if ( ! -x $arr[0] ) {
            die "Cannot execute $arr[0]\n";
        }
        print STDERR "executing ".join(" ",@arr)."\n" if ($DEBUG);
        exec @arr;
    }
}


__END__

=head1 NAME

snaprotate.pl - Use rotating snapshots as a backup means.

=head1 SYNOPSIS

B<snaprotate.pl> B<-a>|B<--action> I<s[nap] | m[ail] | r[eport]>
[B<-V>|B<--volgroup> I<vg>] [B<-s>|B<--sourcelv> I<lv>]
[B<-L>|B<--size> I<snapsize>] [B<-n>|B<--snapname> I<snapvol>]
[B<-S>|B<--scope> I<scope>] [B<-m>|B<--mailto> I<user@fqdn>] 
[B<-t>|B<--treshold> I<value>] [B<-c>|B<--snapcount> I<value>] 
[B<-v>|B<--verbose>] 

B<snaprotate.pl> B<-h>|B<--help>

B<snaprotate.pl> B<-o>|B<--options>

=head1 DESCRIPTION

This script will either rotate between snapshots of a logical volume or
report if a snapshot volume is used more than a treshold value (default 90%).
When rotating, the snapshot volume with most usage is deleted and a new one
is created. 

=head1 OPTIONS

=over 4

=item B<-a, --action> I<s[nap] | m[ail] | r[eport]>

Mandatory option. The I<snap> option will delete the oldest snapshot if
all snapshots are used (or more oldest if more snapshots are used). After this
a new snapshot is created.  WARNING: if a snapshot to be deleted is mounted, it
will first be unmounted.  If the filesystem is busy, all processed on the
filesystem are killed with a SIGKILL.

The I<report> and I<mail> options check if a snapshot is used more than
the treshold value or if a snapshot became invalid. I<report> prints the
message to stderr and I<mail> sends the message to a mail address.

=item B<-V, --volgroup> I<vg>

The volume group that the logical volumes are members of. This option is
mandatory if the I<snap> action is used and optional for the I<mail> and
I<report> actions.  In the latter cases, the scope of reporting is limited to
the specified volumegroup.

=item B<-s, --sourcelv> I<lv>

The logical volume that is snapped. Analogous to the B<--volgroup> option, this
option is mandatory for the I<snap> action and optional for the reporting
actions.

=item B<-n, --snapname> I<string>

Use this option to assign the first part of the name of the snapshot. If undefined,
this will default to the string "B<snap>".  Use this name as the name for the
newly created snapshot (optional). This option is disregarded unless the
I<snap> action is used. If the I<--scope> option is unused, the
name of the snapshot will be named "I<E<lt>snapnameE<gt>_E<lt>timestampE<gt>>". 

=item B<-S, --scope> I<scope>

This option enables you to make multiple sets of snapshots for the same logical
volume (e.g. short-term and long_term snapshots).  If used with the I<snap>
action, it will create a snaphot named
"I<E<lt>snapnameE<gt>_E<lt>scopeE<gt>_E<lt>timestampE<gt>>" and only delete old
snapshots with similar names of the same scope. If used with the I<report> or
I<mail> actions, the reporting is also limited to similarily named snapshots of
the specified scope.

=item B<-L, --size> I<snapsize>

The size of the logical volume (use a suffix of K, M or G for Kibi, Mebi or
Gibibytes). This option is mandatory for the I<snap> action, else ignored.

=item B<-m, --mailto> I<user@fqdn>

The user to where a warning of the snap utilization is mailed to. This option
is ignored unless the I<mail> action is used but is mandatory when it is.

=item B<-t, --treshold> I<value>

The percentage of snap usage where the report option will generate an warning.
The default value is 90. This value is only used by the I<mail> and 
I<report> actions.

=item B<-c, --snapcount> I<value> 

The number of snapshots to cycle through. When fewer snapshots are available,
nothing is deleted. If more than this number are available, the excess plus one
more are deleted. The default number is 2. This option is only used by the 
I<snap> action.

=item B<-v, --verbose>

When used with the I<snap> action, this option will print what the program does
in the process. With the reporting actions, info for all snapshots in the scope
is reported.

=item B<-o, --options>

Print the list of command line options.

=item B<-h, --help>

Show the manpage.

=back

=head1 AUTHOR

Rob S. Wolfram E<lt>propdf@hamal.nlE<gt>

=head1 LICENSE

This program is licensed according to the GNU General Public License
(GPL) Version 2, or at your discretion, any later version. A copy of the
license text can be obtained from E<lt>http://www.gnu.org/licenses/gpl.htmlE<gt>
or by mailing the author. In short it means that there are no restrictions on
its use, but distributing the program or derivative works is only allowed
according to the terms of the GPL.

=cut