| 96 | rodolico | 1 | #! /usr/bin/env perl
 | 
        
           |  |  | 2 |   | 
        
           |  |  | 3 | use strict;
 | 
        
           |  |  | 4 | use warnings;
 | 
        
           |  |  | 5 |   | 
        
           |  |  | 6 | use Data::Dumper;
 | 
        
           |  |  | 7 | use Time::Local;
 | 
        
           |  |  | 8 | use POSIX qw(strftime);
 | 
        
           |  |  | 9 | use YAML::Tiny; # apt-get libyaml-tiny-perl under debian, BSD Systems: cpan -i YAML::Tiny
 | 
        
           | 97 | rodolico | 10 | use Hash::Merge::Simple qw/ merge clone_merge /; # libhash-merge-simple-perl
 | 
        
           | 96 | rodolico | 11 |   | 
        
           |  |  | 12 |   | 
        
           |  |  | 13 | # globals
 | 
        
           |  |  | 14 | my $CONFIG_FILE_NAME = 'snapShot.yaml';
 | 
        
           |  |  | 15 |   | 
        
           |  |  | 16 |   | 
        
           |  |  | 17 | # This will be read in from snapShot.yaml
 | 
        
           |  |  | 18 | my $config;
 | 
        
           |  |  | 19 |   | 
        
           |  |  | 20 | #
 | 
        
           |  |  | 21 | # find where the script is actually located as cfg should be there
 | 
        
           |  |  | 22 | #
 | 
        
           |  |  | 23 | sub getScriptLocation {
 | 
        
           |  |  | 24 |    use strict;
 | 
        
           |  |  | 25 |    use File::Spec::Functions qw(rel2abs);
 | 
        
           |  |  | 26 |    use File::Basename;
 | 
        
           |  |  | 27 |    return dirname(rel2abs($0));
 | 
        
           |  |  | 28 | }
 | 
        
           |  |  | 29 |   | 
        
           |  |  | 30 | #
 | 
        
           |  |  | 31 | # Read the configuration file from current location 
 | 
        
           |  |  | 32 | # and return it as a string
 | 
        
           |  |  | 33 | #
 | 
        
           |  |  | 34 | sub readConfig {
 | 
        
           |  |  | 35 |    my $scriptLocation = &getScriptLocation();
 | 
        
           |  |  | 36 |    if ( -e "$scriptLocation/$CONFIG_FILE_NAME" ) {
 | 
        
           |  |  | 37 |       my $yaml = YAML::Tiny->read( "$scriptLocation/$CONFIG_FILE_NAME" );
 | 
        
           |  |  | 38 |       # use clone_merge to merge conf file into $config
 | 
        
           |  |  | 39 |       # overwrites anything in $config if it exists in the config file
 | 
        
           |  |  | 40 |       $config = clone_merge( $config, $yaml->[0] );
 | 
        
           |  |  | 41 |       return 1;
 | 
        
           |  |  | 42 |    }
 | 
        
           |  |  | 43 |    return 0;
 | 
        
           |  |  | 44 | }
 | 
        
           |  |  | 45 |   | 
        
           |  |  | 46 |   | 
        
           |  |  | 47 | # parse one single line from the output of `zfs list [-t snapshot]`
 | 
        
           |  |  | 48 | sub parseListing {
 | 
        
           |  |  | 49 |    my ($line,$keys) = @_;
 | 
        
           |  |  | 50 |    chomp $line;
 | 
        
           |  |  | 51 |    my %values;
 | 
        
           |  |  | 52 |    @values{@$keys} = split( /\s+/, $line );
 | 
        
           |  |  | 53 |    return \%values;
 | 
        
           |  |  | 54 | }      
 | 
        
           |  |  | 55 |   | 
        
           |  |  | 56 |   | 
        
           |  |  | 57 | # this will parse the date out of the snapshots and put the values into
 | 
        
           |  |  | 58 | # the hash {'date'}
 | 
        
           |  |  | 59 | sub parseSnapshots {
 | 
        
           |  |  | 60 |    my ( $snapShots, $config) = @_;
 | 
        
           |  |  | 61 |    my $keys = $config->{'snapshot'}->{'parseFields'};
 | 
        
           |  |  | 62 |    foreach my $snapShot ( keys %$snapShots ) {
 | 
        
           |  |  | 63 |       my %temp;
 | 
        
           |  |  | 64 |       # run the regex, capture the output to an array, then populate the hash %temp
 | 
        
           |  |  | 65 |       # using the regex results as the values, and $keys as the keys
 | 
        
           |  |  | 66 |       @temp{@$keys} = ( $snapShot =~ m/$config->{'snapshot'}->{'parse'}/ );
 | 
        
           |  |  | 67 |       # while we're here, calculate the unix time (epoch). NOTE: month is 0 based
 | 
        
           |  |  | 68 |       $temp{'unix'} = timelocal( 0,$temp{'minute'},$temp{'hour'},$temp{'day'},$temp{'month'}-1,$temp{'year'} );
 | 
        
           |  |  | 69 |       # put this into our record
 | 
        
           |  |  | 70 |       $snapShots->{$snapShot}->{'date'} = \%temp;
 | 
        
           |  |  | 71 |    }
 | 
        
           |  |  | 72 | }
 | 
        
           |  |  | 73 |   | 
        
           |  |  | 74 | # run $command, then parse its output and return the results as a hashref
 | 
        
           |  |  | 75 | sub getListing {
 | 
        
           |  |  | 76 |    my ($configuration, $regex, $command )  = @_;
 | 
        
           |  |  | 77 |    my %dataSets;
 | 
        
           |  |  | 78 |   | 
        
           |  |  | 79 |    # get all datasets
 | 
        
           |  |  | 80 |    my @zfsList = `$command`;
 | 
        
           |  |  | 81 |    foreach my $thisSet ( @zfsList ) {
 | 
        
           |  |  | 82 |       my $temp = &parseListing( $thisSet, $configuration->{'listingKeys'} );
 | 
        
           |  |  | 83 |       if (  $temp->{'name'} =~ m/^($regex)$/ ) {
 | 
        
           |  |  | 84 |          $dataSets{$temp->{'name'}} = $temp;
 | 
        
           |  |  | 85 |       }
 | 
        
           |  |  | 86 |    }
 | 
        
           |  |  | 87 |    return \%dataSets;
 | 
        
           |  |  | 88 | }
 | 
        
           |  |  | 89 |   | 
        
           |  |  | 90 | # will convert something like 1 day to the number of seconds (86400) for math.
 | 
        
           |  |  | 91 | # month and year are approximations (30.5 day = a month, 365.2425 days is a year)
 | 
        
           |  |  | 92 | sub period2seconds {
 | 
        
           |  |  | 93 |    my ($count, $unit) = ( shift =~ m/\s*(\d+)\s*([a-z]+)\s*/i );
 | 
        
           |  |  | 94 |    $unit = lc $unit;
 | 
        
           | 97 | rodolico | 95 |    if ( $unit eq 'hour' ) {
 | 
        
           | 96 | rodolico | 96 |       $count *= 3600;
 | 
        
           |  |  | 97 |    } elsif ( $unit eq 'day' ) {
 | 
        
           |  |  | 98 |       $count *= 86400;
 | 
        
           |  |  | 99 |    } elsif ( $unit eq 'week' ) {
 | 
        
           |  |  | 100 |       $count *= 864000 * 7;
 | 
        
           |  |  | 101 |    } elsif ( $unit eq 'month' ) {
 | 
        
           |  |  | 102 |       $count *= 864000 * 30.5;
 | 
        
           |  |  | 103 |    } elsif ( $unit eq 'year' ) {
 | 
        
           |  |  | 104 |       $count *= 86400 * 365.2425;
 | 
        
           |  |  | 105 |    } else {
 | 
        
           |  |  | 106 |       die "Unknown units [$unit] in period2seconds\n";
 | 
        
           |  |  | 107 |    }
 | 
        
           |  |  | 108 |    return $count;
 | 
        
           |  |  | 109 | }
 | 
        
           |  |  | 110 |   | 
        
           |  |  | 111 | # Merges datasets, snapshots and some stuff from the configuration into the datasets
 | 
        
           |  |  | 112 | # hash
 | 
        
           | 97 | rodolico | 113 | sub mergeData {
 | 
        
           | 96 | rodolico | 114 |    my ($datasets,$snapshots,$config) = @_;
 | 
        
           |  |  | 115 |    my $confKeys = $config->{'datasets'};
 | 
        
           |  |  | 116 |    foreach my $thisDataset ( keys %$datasets ) {
 | 
        
           |  |  | 117 |       foreach my $conf (keys %$confKeys ) {
 | 
        
           |  |  | 118 |          if ( $thisDataset =~ m/^$conf$/ ) {
 | 
        
           |  |  | 119 |             $datasets->{$thisDataset}->{'recursive'} = $confKeys->{$conf}->{'recursive'};
 | 
        
           |  |  | 120 |             $datasets->{$thisDataset}->{'frequency'} = &period2seconds( $confKeys->{$conf}->{'frequency'} );
 | 
        
           |  |  | 121 |             $datasets->{$thisDataset}->{'retention'} = &period2seconds( $confKeys->{$conf}->{'retention'} );
 | 
        
           |  |  | 122 |             last;
 | 
        
           |  |  | 123 |          } # if
 | 
        
           |  |  | 124 |       } # foreach
 | 
        
           |  |  | 125 |       foreach my $snapshot ( keys %$snapshots ) {
 | 
        
           |  |  | 126 |          if ( $snapshot =~ m/^$thisDataset@/ ) { # this is a match
 | 
        
           |  |  | 127 |             # copy the snapshot into the dataset
 | 
        
           |  |  | 128 |             $datasets->{$thisDataset}->{'snapshots'}->{$snapshot} = $snapshots->{$snapshot};
 | 
        
           |  |  | 129 |             # track the latest snapshot
 | 
        
           |  |  | 130 |             $datasets->{$thisDataset}->{'lastSnap'} = $snapshots->{$snapshot}->{'date'}->{'unix'}
 | 
        
           |  |  | 131 |                if ! defined( $datasets->{$thisDataset}->{'lastSnap'} ) || $datasets->{$thisDataset}->{'lastSnap'} < $snapshots->{$snapshot}->{'date'}->{'unix'};
 | 
        
           |  |  | 132 |             # delete the snapshot
 | 
        
           |  |  | 133 |             delete $snapshots->{$snapshot};
 | 
        
           |  |  | 134 |          } # if
 | 
        
           |  |  | 135 |       } # foreach
 | 
        
           |  |  | 136 |    } # foreach
 | 
        
           | 97 | rodolico | 137 | } # sub mergeData
 | 
        
           | 96 | rodolico | 138 |   | 
        
           |  |  | 139 | sub checkRetention {
 | 
        
           |  |  | 140 |    my ( $retentionPeriod, $recursive, $snapshots, $now ) = @_;
 | 
        
           |  |  | 141 |    my @toDelete;
 | 
        
           |  |  | 142 |    foreach my $thisSnapshot ( keys %$snapshots ) {
 | 
        
           |  |  | 143 |       # print "checking $thisSnapshot\n\tNow: $now\n\tDate: $snapshots->{$thisSnapshot}->{date}->{unix}\n\tRetention: $retentionPeriod\n\n";
 | 
        
           |  |  | 144 |       if ( $now - $snapshots->{$thisSnapshot}->{'date'}->{'unix'} > $retentionPeriod ) {
 | 
        
           |  |  | 145 |          my $command = 'zfs destroy ' . ($recursive ? '-r ' : '') . $thisSnapshot;
 | 
        
           |  |  | 146 |          push @toDelete, $command;
 | 
        
           |  |  | 147 |       }
 | 
        
           |  |  | 148 |    }
 | 
        
           |  |  | 149 |    return @toDelete;
 | 
        
           |  |  | 150 | }   
 | 
        
           |  |  | 151 |   | 
        
           |  |  | 152 | sub makeSnapshot {
 | 
        
           |  |  | 153 |    my ( $datasetName, $recursive, $snapshotName ) = @_;
 | 
        
           |  |  | 154 |    return 
 | 
        
           |  |  | 155 |       'zfs snapshot ' . 
 | 
        
           |  |  | 156 |       ($recursive ? '-r ' : '') . 
 | 
        
           |  |  | 157 |       $datasetName . $snapshotName;
 | 
        
           |  |  | 158 | }
 | 
        
           |  |  | 159 |   | 
        
           |  |  | 160 |   | 
        
           |  |  | 161 | sub process {
 | 
        
           |  |  | 162 |    my ( $datasets, $now, $snapshotName, $slop ) = @_;
 | 
        
           |  |  | 163 |    my @actions;
 | 
        
           |  |  | 164 |    my @toDelete;
 | 
        
           |  |  | 165 |    my @toAdd;
 | 
        
           |  |  | 166 |   | 
        
           |  |  | 167 |    foreach my $thisDataset ( keys %$datasets ) {
 | 
        
           |  |  | 168 |       push( @toDelete, 
 | 
        
           |  |  | 169 |          &checkRetention( 
 | 
        
           |  |  | 170 |          $datasets->{$thisDataset}->{'retention'}, 
 | 
        
           |  |  | 171 |          $datasets->{$thisDataset}->{'recursive'}, 
 | 
        
           |  |  | 172 |          $datasets->{$thisDataset}->{'snapshots'}, 
 | 
        
           |  |  | 173 |          $now )
 | 
        
           |  |  | 174 |          );
 | 
        
           |  |  | 175 |       if ( $datasets->{$thisDataset}->{'lastSnap'} + $datasets->{$thisDataset}->{'frequency'} < $now + $slop ) {
 | 
        
           |  |  | 176 |          push @toAdd, &makeSnapshot( $thisDataset, $datasets->{$thisDataset}->{'recursive'}, $snapshotName )
 | 
        
           |  |  | 177 |       }
 | 
        
           |  |  | 178 |    }
 | 
        
           |  |  | 179 |    return ( @toDelete, @toAdd );
 | 
        
           |  |  | 180 | }   
 | 
        
           |  |  | 181 |   | 
        
           |  |  | 182 | sub run {
 | 
        
           |  |  | 183 |    my $testing = shift;
 | 
        
           |  |  | 184 |    # bail if there are no commands to run
 | 
        
           |  |  | 185 |    return 1 unless @_;
 | 
        
           |  |  | 186 |    if ( $testing ) { # don't do it, just dump the commands
 | 
        
           |  |  | 187 |       open LOG, ">/tmp/snapShot" or die "could not write to /tmp/snapShot: $!\n";
 | 
        
           |  |  | 188 |       print LOG join( "\n", @_ ) . "\n";
 | 
        
           |  |  | 189 |       close LOG;
 | 
        
           |  |  | 190 |    } else {
 | 
        
           |  |  | 191 |       my $out;
 | 
        
           |  |  | 192 |       return 'Not running right now';
 | 
        
           |  |  | 193 |       while ( my $command = shift ) {
 | 
        
           |  |  | 194 |          $out .= `$command` . "\n";
 | 
        
           |  |  | 195 |          if ( $? ) { # we had an error
 | 
        
           |  |  | 196 |             $out .= "Error executing command\n\t$command\n\t";
 | 
        
           |  |  | 197 |             if ($? == -1) {
 | 
        
           |  |  | 198 |                 $out .= "failed to execute $command: $!";
 | 
        
           |  |  | 199 |             } elsif ($? & 127) {
 | 
        
           |  |  | 200 |                 $out .= sprintf( "child died with signal %d, %s coredump", ($? & 127),  ($? & 128) ? 'with' : 'without' );
 | 
        
           |  |  | 201 |             } else {
 | 
        
           |  |  | 202 |                 $out .= sprintf( "child exited with value %d", $? >> 8 );
 | 
        
           |  |  | 203 |             }
 | 
        
           |  |  | 204 |             $out .= "\n";
 | 
        
           |  |  | 205 |             return $out;
 | 
        
           |  |  | 206 |          }
 | 
        
           |  |  | 207 |       }
 | 
        
           |  |  | 208 |    }
 | 
        
           |  |  | 209 |    return 0;
 | 
        
           |  |  | 210 | }
 | 
        
           |  |  | 211 |   | 
        
           | 97 | rodolico | 212 | &readConfig();
 | 
        
           |  |  | 213 |   | 
        
           | 96 | rodolico | 214 | # grab the time once
 | 
        
           |  |  | 215 | my $now = time;
 | 
        
           |  |  | 216 | # create the string to be used for all snapshots, using $now and the template provided
 | 
        
           |  |  | 217 | my $snapshotName = '@' . strftime($config->{'snapshot'}->{'template'},localtime $now);
 | 
        
           |  |  | 218 | # Create the dataset regex for later use 
 | 
        
           |  |  | 219 | $config->{'dataset_regex'} = '(' . join( ')|(', keys %{ $config->{'datasets'} }  ) . ')' unless $config->{'dataset_regex'};
 | 
        
           |  |  | 220 | #print $config{'dataset_regex'} . "\n";
 | 
        
           |  |  | 221 | $config->{'snapshot_regex'} = '(' . $config->{'dataset_regex'} . ')@' . $config->{'snapshot'}->{'parse'};
 | 
        
           |  |  | 222 | #print $config->{'snapshot_regex'} . "\n\n";
 | 
        
           |  |  | 223 |   | 
        
           |  |  | 224 | #die Dumper( $config ) . "\n";   
 | 
        
           |  |  | 225 | # first, find all datasets which match our keys
 | 
        
           |  |  | 226 | my $dataSets = &getListing( $config, $config->{'dataset_regex'}, 'zfs list'  );
 | 
        
           |  |  | 227 | # and, find all snapshots that match
 | 
        
           |  |  | 228 | my $snapshots = &getListing( $config, $config->{'snapshot_regex'}, 'zfs list -t snapshot'  );
 | 
        
           |  |  | 229 | # get the date/time of the snapshots and store them in the hash
 | 
        
           |  |  | 230 | &parseSnapshots($snapshots, $config );
 | 
        
           | 97 | rodolico | 231 | # mergeData the snapshots into the datasets for convenience
 | 
        
           |  |  | 232 | &mergeData( $dataSets, $snapshots, $config );
 | 
        
           | 96 | rodolico | 233 | # Now, let's do the actual processing
 | 
        
           |  |  | 234 | my @commands  = &process( $dataSets, $now, $snapshotName, &period2seconds( $config->{'slop'} ) );
 | 
        
           |  |  | 235 | my $errors;
 | 
        
           |  |  | 236 | print $errors if $errors = &run( $config->{'TESTING'}, @commands );
 | 
        
           |  |  | 237 |   | 
        
           |  |  | 238 |   | 
        
           |  |  | 239 | #print Dumper( $dataSets );
 | 
        
           |  |  | 240 | #print Dumper( $snapshots );
 | 
        
           |  |  | 241 |   | 
        
           |  |  | 242 | #print join ("\n", sort keys( %$dataSets ) ) . "\n\n";
 | 
        
           |  |  | 243 | #print join( "\n", sort keys( %$snapshots ) ) . "\n";
 | 
        
           |  |  | 244 |   | 
        
           |  |  | 245 | 1;
 |