Subversion Repositories sysadmin_scripts

#! /usr/bin/env perl

use strict;

use warnings;

use Data::Dumper;

use Time::Local qw( timelocal_posix timegm_posix );

use Getopt::Long;

Getopt::Long::Configure ("bundling");

use constant SECONDS_IN_DAY => 86400;

my $config = {};

# runs a command, redirecting stderr to stdout (which it ignores)

# then returns 0 and $output on success.

# if error, returns error code and string describing error

sub run {

   my $command = shift;

   my $output = qx/$command 2>&1/;

   if ($? == -1) {

      return (-1,"failed to execute: $!");

   } elsif ($? & 127) {

      return ($?, sprintf "child died with signal %d, %s coredump",

        ($? & 127),  ($? & 128) ? 'with' : 'without' );

   } else {

      return ($? >> 8, sprintf "child exited with value %d", $? >> 8 ) if $? >> 8;

   }

   return (0,$output);

}

sub dateToUnixTime {

   my ( $date, $time ) = @_;

   my ($year,$month,$day) = split( /\D/, $date );

   my ($hour,$minute,$second) = split( /\D/, $time );

   $second = '00' unless $second;

   return timelocal_posix( $second,$minute,$hour,$day,$month-1,$year-1900);

}

sub getSnaps {

   my $config = shift;

   my %snaps;

   my ($error,$output) = &run( 

      # 'H' uses a single tab between fields

      "zfs list -H" . 

      # if they asked for recursion, add the 'r' flag

      ( $config->{'recurse'} ? 'r' : '' ) . 

      # type snap, and the dataset name

      "t snap $config->{dataset}" );

#   die $output;

   my @snaps = split( "\n", $output );

   chomp @snaps;

   while ( my $thisSnap = pop @snaps ) {

      my ($name,$used,$avail,$refer,$mountpoint) = split( "\t", $thisSnap );

      if ( $name =~ m/$config->{'filter'}/ ) {

         my $created = &dateToUnixTime( $1,$2 );

         $snaps{$name}->{'date'} = $created if ( $created < $config->{'pruneBefore'} );

      }

   }

   return \%snaps;

}

sub makeDestroyCommands {

   my @commands;

#   die Dumper( @_ ) . "\n";

   while ( my $snap = shift ) {

      push @commands, "zfs destroy $snap";

   }

   return \@commands;

}

sub help {

   my $message = shift;

   print "\n== $message ==\n\n" if $message;

   my $help =  <<"      EOF";

      usage: $0 [options] dataset

         --dataset - Dataset to process. May also be defined with no flags

                     REQUIRED

         --recurse - If set, will recurse through child datasets

                     default: do not recurse

         --ttl     - Time To Live, in days. Anything older will be destroyed

                     default: 90 days

         --filter  - Perl Regular Expression to match snapshots. Non-match are

                     ignored

                     default: matches YYYY.MM.DD.HH.MM where . is any character

         --dryrun  - Do not actually do the destroy. -n is short version

         --verbose - Be verbose (only one level)

      Simple script to prune old snapshots. Snapshots must have date/time

      stamp, which must be surrounded by parenthesis in filter.

      Examples:

      $0 storage

         destroy all snapshots older than 90 days (default) in dataset storage

      $0 -r -d 'storage'

         destroy all snapshots older than 90 days in dataset storage and all

         child datasets

      $0  -rvt 120 -f 'weekly_(\\d{4}-\\d{2}-\\d{2})_(\\d{2}-\\d{2})' storage

         destroy all snapshots older and 120 days from storage/ and all

         children which have the form weekly_YYYY-MM-DD_HH-MM

      EOF

   $help =~ s/^ {6}//gm;

   print $help;

   exit();

}

# set some defaults

# default time to live, in days. Everything older will be destroyed

$config->{'ttl'} = 90;

# regex to match snapshot names. Default is just YYYY?MM?DD?HH?MM, where ? is aany delimiter

$config->{'filter'} = '(\d{4}.\d{2}.\d{2}).(\d{2}.\d{2})';

GetOptions( $config,

   'dataset|d=s',

   'ttl|t=i',

   'filter|f=s',

   'dryrun|n',

   'recurse|r',

   'verbose|v',

   'help|h'

);

$config->{'dataset'} = @ARGV ? shift : '' unless $config->{'dataset'};

#print Dumper( $config );

&help() if $config->{'help'};

&help( 'No dataset defined')  unless $config->{'dataset'};

$config->{'now'} = time;

printf "Starting prune of ZFS Snapshots at %s\n", scalar localtime( $config->{'now'} ) if $config->{'verbose'};

$config->{'pruneBefore'} = $config->{'now'} - $config->{'ttl'} * SECONDS_IN_DAY;

printf "Pruning before %s \n", scalar localtime($config->{'pruneBefore'}) if $config->{'verbose'};

$config->{'snaps'} = &getSnaps( $config );

#die Dumper( $config->{'snaps'} ) . "\n";

my $commands = &makeDestroyCommands( sort keys %{ $config->{'snaps'} } );

#die Dumper( $commands ) . "\n";

if ( @$commands ) {

   for ( my $i=0; $i < @$commands; $i++ ) {

      print $commands->[$i] . "\n" if $config->{'dryrun'}  || $config->{'verbose'};

      next if $config->{'dryrun'};

      #my ($error,$output) = &run ($commands->[$i]);

      #print "Error running command\n$commands->[$i]\n$output\n" if ( $error );

   }

} else {

   print "No snapshots found to destroy\n" if $config->{'verbose'};

}

printf "Prune completed at %s\n", scalar localtime( time ) if $config->{'verbose'};   

1;