BackupPC_report

#!/usr/bin/env perl

#========================================================================
# BackupPC_report
#========================================================================
# Version 0.0.8
#========================================================================

use strict;
use warnings;                # global flag -w produces warnings from BackupPC::Lib
use lib '/usr/local/lib';    # <<< change path prefix to match your installation
use BackupPC::Lib;
use POSIX qw( getuid getgid setuid setgid floor );
use Getopt::Long;
use Pod::Usage;

my $bpcUser = 'backuppc';

#
# Clean up %ENV for taint checking.
# Untaint path to groff that required to display POD.
#
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{PATH} = '/usr/bin';

our ( $opt_a, $opt_f, $opt_l, $opt_s, @types, $opt_w, $opt_help, $opt_man );
$opt_f = "report";
GetOptions( "a", "f=s", "l=i", "s", "t=s" => \@types, "w=f", "help|?", "man" ) || pod2usage(2);
pod2usage( -exitstatus => 0, -verbose => 2 )                      if $opt_man;
pod2usage(1)                                                      if $opt_help;
pod2usage( -msg => "Unsupported value for -f", -exitstatus => 2 ) if $opt_f !~ /^(report|csv)$/i;

# Set backuppc UID/GID
my ( undef, undef, $bpcUID, $bpcGID ) = getpwnam($bpcUser);
defined $bpcUID
  or die "user $bpcUser does not exist\n";
setuid($bpcUID) if ( getuid() != $bpcUID );
setgid($bpcGID) if ( getgid() != $bpcGID );

#
# Verify we are running as the correct user
#
die "Wrong user: my userid is $>, instead of $bpcUID ($bpcUser).
Please su [-m] $bpcUser first.\n"
  if ( $> != $bpcUID );

my $bpc = BackupPC::Lib->new( '', '', '', 0 )
  or die "BackupPC::Lib->new failed\n";

my @backups;    # info on all backups of one host

my @hosts = sort keys %{ $bpc->HostInfoRead() };    # array of hosts

# print 'hosts =>', (join '<, >', @hosts), "<=\n";

my ( $lastStartTime, @Report );
my $warnOutdated = my $warnErr = my $hostsDisabled = my $warnActive = my $warnPartial = 0;
my $hostColWidth = 9;

for my $host ( @ARGV ? @ARGV : @hosts ) {

    # Read the host-specific config
    if ( defined( my $error = $bpc->ConfigRead($host) ) ) {
        print("*ERROR* Can't read $host host's configuration file: $error\n");
        next;
    }

    next if ( $bpc->{Conf}{XferMethod} eq "archive" );

    unless ( @backups = $bpc->BackupInfoRead($host) ) {
        print "*ERROR* Can't get backup info for host $host\n";
        next;
    }

    if ( defined $opt_l
        || @types && !( $types[0] eq 'all' && $opt_a ) )
    {
        my @selected;
        if ( defined $opt_l ) {
            for ( reverse @backups ) {
                if ( $_->{level} == $opt_l ) {
                    push @selected, $_;
                    last unless $opt_a;
                }
            }
        }
        else {
            my %found;
            if ( $types[0] eq 'all' ) {
                for ( reverse @backups ) {
                    next if ( exists( $found{ $_->{type} } ) );
                    $found{ $_->{type} } = '';
                    push @selected, $_;
                }
            }
            else {
                for ( reverse @backups ) {
                    for my $type (@types) {
                        if ( $_->{type} eq $type ) {
                            next if ( !$opt_a && exists( $found{ $_->{type} } ) );
                            $found{ $_->{type} } = '';
                            push @selected, $_;
                        }
                    }
                    last if ( !$opt_a && keys %found == @types );
                }
            }
        }
        next unless (@selected);
        @backups = reverse @selected;
    }
    elsif ( !$opt_a ) {

        # [-1] in the line below implies most recent backup for each host.
        @backups = $backups[-1];
    }

    for (@backups) {
        my $active = $_->{type} eq 'active';

        push @Report, [
            $active ? '*' : '',    # warning flags
            $_->{num},
            $host,
            POSIX::strftime( '%Y-%m-%d %H:%M', localtime $_->{startTime} ),
            $_->{size} eq '' ? '' : sprintf( '%.f', $_->{size} / 1024 / 1024 ),    # Size (MB)
            $_->{level},

            # Duration in minutes
            $active             ? '*' : '',                                        # The backup is in progress
            $_->{endTime} eq '' ? ''  : sprintf( '%.f', ( ( $active ? time : $_->{endTime} ) - $_->{startTime} ) / 60 ),

            $_->{xferErrs},
            $_->{xferBadShare},
            $_->{xferBadFile},
            $_->{tarErrs},

            # Backup age in days, rounded to floor
            floor( ( time - $_->{startTime} ) / ( 24 * 3600 ) )
        ];

        if ($active) {
            $warnActive = 1;
        }
        elsif ( $_->{type} eq 'partial' ) {
            $warnPartial = 1
              unless $bpc->{Conf}{BackupsDisable};
            $Report[$#Report][0] .= "P";
        }

        # Rise warning on errors
        if (   $_->{xferErrs}
            || $_->{xferBadShare}
            || $_->{xferBadFile}
            || $_->{tarErrs} )
        {
            $warnErr = 1
              unless $bpc->{Conf}{BackupsDisable};
            $Report[$#Report][0] .= "E";
        }
    }

    $hostColWidth = length $host if ( length $host > $hostColWidth );

    # Get backup period for current host.
    my $period;
    if ( $bpc->{Conf}{FullPeriod} <= 0 || $bpc->{Conf}{IncrPeriod} <= 0 ) {
        print(
"*WARNING* nonpositive '\$Conf{FullPeriod}' or '\$Conf{IncrPeriod}' configured for host $_. Using 1d instead.\n"
        );
        $period = 1;
    }
    else {
        $period = (
              $bpc->{Conf}{IncrPeriod} < $bpc->{Conf}{FullPeriod}
            ? $bpc->{Conf}{IncrPeriod}
            : $bpc->{Conf}{FullPeriod}
        );
    }

    # Rise warning if start time of most recent backup is older than
    # $period days + backup window
    if ( time > ( $backups[-1]->{startTime} + $period * 86400 + ( $opt_w ? $opt_w : 1 ) * 3600 ) ) {
        $warnOutdated = 1
          unless $bpc->{Conf}{BackupsDisable};
        $Report[$#Report][0] .= "O";
    }

    if ( $bpc->{Conf}{BackupsDisable} ) {
        $Report[$#Report][0] .= "D";
        $hostsDisabled++;
    }
}

# Supress report if no warnings
!$opt_s || $warnOutdated || $warnErr || $warnActive || $warnPartial || exit 0;

if ( $opt_f =~ /^csv$/i ) {

    # csv header
    printf
      "%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
      "warn_flags", "backup_number", "host_name", "date_time", "size_mb",
      "lvl", "duratation_min", "xfer_err", "share_err", "file_err", "tar_err",
      "age_days";

    # csv content
    map { printf "%s,%d,%s,%s,%s,%d,%s%s,%s,%s,%s,%s,%d\n", @$_; } @Report;
}
else {

    # Print report header
    print POSIX::strftime( '%Y-%m-%d %H:%M', localtime(time) ), "       ",
      scalar @hosts, " host(s) configured ($hostsDisabled disabled)\n\n";
    print "*WARNING* Some backups with ERRORs!",                                   "\n\n" if $warnErr;
    print "*WARNING* Most recent backups for some hosts are older than expected!", "\n\n"
      if $warnOutdated;
    print "*WARNING* There are in-progress backups!", "\n\n" if $warnActive;
    print "*WARNING* There are partial backups!",     "\n\n" if $warnPartial;

    # Print BackupPC URL
    printf "\nURL: $bpc->{Conf}{CgiURL}\n\n";

    # Print table header
    printf "%4s %6s %-${hostColWidth}s %-16s %6s %3s %6s | %4s %5s %4s %3s | %6s\n",
      "warn", "backup", "host name", "date/time", "size", "", "durat.",
      "xfer", "Share", "File", "tar", "age";
    printf
      "%4s %6s %-${hostColWidth}s %-16s %6s %3s %6s | %-4s %-5s %-4s %3s | %6s\n",
      "flag", "number", "", "", "(MB)", "lvl", "(min)",
      "Err", "Err", "Err", "Err", "(days)";
    print "-" x ( $hostColWidth + 78 ), "\n";

    # Print the rest of the table
    map { printf "%4s [%4d] %-${hostColWidth}s %-16s %6s %3d %1s%5s | %4s %5s %4s %3s | %6d\n", @$_; } @Report;
}

__END__

=head1 NAME

BackupPC_report - reporting tool for BackupPC

=head1 SYNOPSIS

B<BackupPC_report> [options] [F<host> ...]

B<BackupPC_report> --help | -? | --man

=head1 DESCRIPTION

The BackupPC_report(1) is a Perl script that produces reports regarding BackupPC backups on STDOUT.

Brief reports provide a quick overview of available backups, calling out warnings that may require attention.

=head2 Warning flags

BackupPC_report(1) marks corresponding rows with flags and prepends warning messages to the head of the report if
backups included in the report have errors or the most recent backups for some hosts are older than expected.

Flags:

=over

=item B<*>

the backup is in progress;

=item B<P>

the backup is partial;

=item B<E>

errors occurred during the backup;

=item B<O>

the most recent backup is older than expected;

=item B<D>

backups disabled for this host.

=back

=head1 ARGUMENTS

Multiple space separated F<host> arguments may be specified, each processed in order. If argument is omitted, the
report will be generated for all hosts.

Note: any reports not include archive hosts.

=head1 OPTIONS

=over

=item  B<-a>

Include all available backups in the report. The default is the most recent backups only.

=item  B<-f> I<format>

Outputs the report in the given I<format>. Possible values are "report" and "csv". The default is "report" printing the
report with additional header lines. "csv" will print the backup information table in a more machine readable CSV
format.

=item  B<-l> I<backup_level>

Level of backups to include in the report. The default is any level.

=item  B<-s>

Suppress output if there are no warnings. Useful in conjunction with B<mail -E>. See crontab example below.

=item  B<-t> I<backup_type> or B<-t all>

Type of backups to include in the report. The default is any type. The option can be specified multiple times. Also you
can use I<-t all> to include backups of each type.

=item  B<-w> I<backup_window>

Specify a backup window in hours (floating). The backup window is a difference between the earliest expected backup
start time and the latest expected backup completion time. The default is 1 hour. If start time of the most recent
backup for a host is older than sum of I<$Conf{IncrPeriod}> (or I<$Conf{FullPeriod}> if incremental backups are
disabled) and the backup window then warning flag "O" will be set to corresponded report row and warning message
perpended to the report header.

=item B<--help -?>

Brief help.

=item B<--man>

Full documentation.

=back

=head1 REQUIREMENTS

=over

=item *

A Linux, Solaris, or Unix based server.

=item *

Perl version 5.8.0 or later.  If you do not have Perl, please see L<http://www.cpan.org>.

=item *

Installed BackupPC backup system. See L<http://backuppc.sourceforge.net>.

=back

=head1 INSTALLATION

=over

=item 1

Place BackupPC_report where you want.

=item 2

Change lib path at the beginning of the script code to match your installation. E.g. for Debian/Ubuntu the lib path
should be I</usr/share/backuppc/lib> . The default is I</usr/local/lib> .

=back

=head1 EXAMPLES

To get report consist of the most recent backups for all hosts:

B<[su -m backuppc -c] BackupPC_report>

To get report consist of all available backups for the specified hosts:

B<[su -m backuppc -c] "BackupPC_report -a F<host1 host2>">

Cron jobs to get reports in mailbox at schedule:

 # Send reports on Monday mornings
 5  8  *  *  1    /usr/local/bin/perl /somedir/BackupPC_report | mail -s "BackupPC@`hostname` `date '+\%Y-\%m-\%d \%H:\%M'` weekly report" root
 # Other days send report only if it has warnings
 5  8  *  *  2-7  /usr/local/bin/perl /somedir/BackupPC_report -s | mail -Es "BackupPC@`hostname` `date '+\%Y-\%m-\%d \%H:\%M'` warning" root

=head1 AUTHOR

Alexander Moisseev E<lt>moiseev@mezonplus.ruE<gt>

=head1 CREDITS

The idea and initial quick-hack script by Holger Parplies.

=head1 LICENSE and COPYRIGHT

Copyright (c) 2012-2018, Alexander Moisseev

This software is licensed under the terms of the GNU General Public License, version 2 or later.

For the license details, see the file 'LICENSE' included with this distribution.

=cut