expect2_backup.pl

#!/home/djacoby/webserver/perl/bin/perl

# replacement of the shell-based ltl-backup.sh, using Expect.pm, both for me
# to gain experience with Expect and to keep control over output so I do not
# get mail on successful operation.

use strict ;
use warnings ;
use feature qw{ postderef say signatures state } ;
no warnings qw{ experimental::postderef experimental::signatures } ;

use Carp ;
use DateTime ;
use Expect ;
use File::Path qw{ make_path } ;
use Getopt::Long ;
use IO::Interactive qw{ is_interactive } ;
use YAML qw{ DumpFile LoadFile Dump Load } ;

# Expect automates shell commands

# I prefer auto-verbose when running on command-line and
#          auto-quiet when running in batch/cron mode
#          and is_interactive gives me that, but added
#          the --debug flag to show verbose output in
#          non-interactive contexts, so
#   say 'SOMETHING' if is_interactive() || $config->{ debug } ;

my $config  = config() ;
my $tarball = make_tarball( $config ) ;
handle_tarball( $config, $tarball ) ;
exit ;

# extract and return configuration for the file
# this is where I should add help and Pod::Usage
sub config () {
    my $identities = identities() ;
    my $config ;
    GetOptions(
        'debug'      => \$config->{ debug },
        'full'       => \$config->{ full },
        'identity=s' => \$config->{ identity },
        ) ;
    map { $config->{ $_ } = $config->{ $_ } || 0 } qw{ debug full } ;
    croak 'Cannot run without identity' unless $config->{ identity } ;
    croak 'Need valid identity'
        unless $identities->{ $config->{ identity } } ;
    $config->{ identities_obj } = $identities->{ $config->{ identity } } ;
    ( $config->{ date }, $config->{ newer } ) = handle_date( $config ) ;
    return $config ;
    }

# all date handling is in this function
# we need date for the tarball file name
# we need newer for incremental backups, changed within last two days
sub handle_date ($config) {
    my $day   = DateTime->now->set_time_zone( 'floating' ) ;
    my $date  = $day->strftime( '%Y-%m-%d_%H-%M' ) ;
    my $newer = $config->{ newer } = '' ;
    if ( !$config->{ full } ) {
        $day->subtract( days => 2 ) ;
        my $tardate = $day->strftime( '%Y%m%d' ) ;
        $newer = "--newer=$tardate" ;
        }
    return ( $date, $newer ) ;
    }

# extract and return identities file, which determines what will be done
#   backups:
#     model:
#       base: /directory/being/backed/up
#       comment: JSON has no comments, but it DOES have non-used fields
#       dir:
#         - subdirectories_to_back_up
#         - an/array/so/more/than/one
#       fort: where/on/fortress/it/goes
#       identity: model
#       name: user whose directory is being backed up. Not used.
#       outfile: format and location tarball is created
#       scratch: directory location tarball is written
sub identities () {
    my $identities_file = join '/', $ENV{ HOME }, '.expect_backups.yml' ;
    my $identities ;
    if ( -f $identities_file ) {
        my $hash = LoadFile( $identities_file ) ;
        $identities = $hash->{ backups } ;
        }
    else {
        croak 'no identities file' ;
        }
    return $identities ;
    }

# configure and return an Expect object
sub set_up_expect () {
    my $bash   = '/usr/local/bin/bash' ;
    my $prompt = 'XXX $' ;
    my $ps1    = qq{PS1='$prompt '\n} ;
    my $e      = Expect->new ;
    $e->log_stdout( 0 ) ;    # removes echos (?)
    $e->raw_pty( 1 ) ;       # disables echoing
    $e->spawn( $bash ) or die ;    # now we have a bash shell
    $e->send( $ps1 ) ;             # sets PS1 to simplified version rather than .bashrc
    $e->expect( 5, $prompt ) ;     # within 5 seconds, get back $prompt
    $e->clear_accum ;              # flush expect buffers
    return $e ;
    }

# given the configuration, makes the tarball, return the tarball's file location
sub make_tarball ( $config ) {
    my $scratch = $config->{ identities_obj }{ scratch } ;
    if ( !-d $scratch ) {
        my @dirs = make_path( $scratch ) ;
        }
    my $base    = $config->{ identities_obj }{ base } ;
    my $tarball = $config->{ identities_obj }{ outfile } ;
    $tarball =~ s{DATE}{$config->{date}}mix ;
    $tarball =~ s{NAME}{$config->{identity}}mix ;
    if   ( $config->{ full } ) { $tarball =~ s{FULL}{full}mix }
    else                       { $tarball =~ s{FULL}{partial}mix }
    my $tar    = '/bin/tar' ;
    my $prompt = 'XXX $' ;
    my $e      = set_up_expect() ;

    for my $d ( $config->{ identities_obj }{ dir }->@* ) {
        my $dir = join '/', $base, $d ;
        my $cmd = join ' ', $tar, '--append', "--file=$tarball", $config->{ newer }, $dir, "\n" ;
        say $cmd if is_interactive() || $config->{ debug } ;
        $e->send( $cmd ) ;
        $e->expect( 60, $prompt ) ;
        say 'B:  ' . $e->before
            if is_interactive() || $config->{ debug } ;    # output of the tar command
        $e->clear_accum ;
        }
    $e->close ;
    return $tarball ;
    }

# 'handling' the tarball means
#       * pulling an index so you know which tarball to pull
#       * gzipping the tarball (indexing is why zipping doesn't occur first)
#       * putting the tarball on Fortress
#       * cleaning up the scratch directory
sub handle_tarball ( $config, $tarball ) {
    my $e     = set_up_expect() ;
    my $index = $tarball ;
    $index =~ s{tar$}{txt} ;
    my ( $filename ) = reverse split m{/}, $tarball ;
    my $remote = join '/', $config->{ identities_obj }{ fort }, $filename . '.gz' ;
    my $put = join ' ', 'put', $tarball . '.gz', ':', $remote, "\n" ;
    my @post ;
    push @post, "/bin/tar   tvf $tarball > $index" ;       # creating index for later lookup
    push @post, "/bin/mv    $index ~/.backup_index/." ;    # moving backup to home dir
    push @post, "/bin/gzip  $tarball" ;                    # gzipping tarball
    push @post, "/opt/hsi/bin/hsi $put " ;                 # putting tarball into fortress
    push @post, "/bin/rm    $tarball" ;                    # clearing local tarball
    push @post, "/bin/rm    $tarball.gz" ;                 # clearing local gzipped tarball

    for my $cmd ( map { $_ . "\n" } @post ) {
        do_command( $e, $cmd ) ;
        }
    $e->close ;
    return 1 ;
    }

# actually use expect to do the command
sub do_command ( $e, $cmd ) {
    my $prompt  = 'XXX $' ;
    my $timeout = 10 ;
    $timeout = 600 if $cmd =~ /gz/mix ;    # we expect gzip and transfer to take longe
    say 'COMMAND:' . $cmd     if is_interactive() || $config->{ debug } ;
    say 'TIMEOUT:' . $timeout if is_interactive() || $config->{ debug } ;
    $e->send( $cmd ) ;
    $e->expect( $timeout, $prompt ) ;
    say 'BEFORE: ' . $e->before if is_interactive() || $config->{ debug } ;
    say 'FLAKE! ' . $cmd unless defined $e->match ;    # no matter what -- shows error in batch mode
    say 'MATCH:  ' . $e->match if is_interactive() || $config->{ debug } ;
    say 'AFTER:  ' . $e->after if is_interactive() || $config->{ debug } ;
    $e->clear_accum ;
    }

# actually use expect to do the command
sub do_command_alternative ( $cmd ) {
    # SHOULD call set_up_expect() once
    # and keep the $e in local scope each time.
    # I lose the good way to $e->close() ,
    # but that'll happen when program closees anyway.
    state $e = set_up_expect() ; 
    my $prompt  = 'XXX $' ;
    my $timeout = 10 ;
    $timeout = 600 if $cmd =~ /gz/mix ;                # we expect gzip and transfer to take longe
    say 'COMMAND:' . $cmd     if is_interactive() || $config->{ debug } ;
    say 'TIMEOUT:' . $timeout if is_interactive() || $config->{ debug } ;
    $e->send( $cmd ) ;
    $e->expect( $timeout, $prompt ) ;
    say 'BEFORE: ' . $e->before if is_interactive() || $config->{ debug } ;
    say 'FLAKE! ' . $cmd unless defined $e->match ;    # no matter what -- shows error in batch mode
    say 'MATCH:  ' . $e->match if is_interactive() || $config->{ debug } ;
    say 'AFTER:  ' . $e->after if is_interactive() || $config->{ debug } ;
    $e->clear_accum ;
    }