#!/usr/bin/perl -w

=head1 NAME

backup - automates copies of remote filesystems

=head1 SYNOPSIS

B<backup> [ <options> ]

=head1 DESCRIPTION

This script is designed to take advantage of the fact that disk is
cheap.  The idea is to have a system with enough disk to make a
duplicate of whatever data you care about.

By default, this will be done filesystem-by-filesystem with rsync
running over ssh, but the mechanism is flexible enough to back up
just about anything.

=cut

# Copyright (C) 2001 Steven Pritchard <steve@silug.org>
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# $Id: backup,v 1.1 2002/08/22 02:07:56 steve Exp $

use strict;

use FileHandle;
use DirHandle;
use Carp;
use Getopt::Long;
use POSIX;# qw(pause :errno_h);
use IO::Handle;

use vars qw($backup_dir $config_file %conf $default_backup_command);
use vars qw(@extraflags @hosts %host $maxchildren @children $done);
use vars qw($debug $verbose $config_dir $timeout $rsync);
use vars qw($daily $weekly $monthly);

sub read_config_file($$);
sub read_host_conf($);
sub backup($$@);
sub my_system(@);
sub safe_chdir($);
sub debug(@);
sub bold($);
sub touch(@);
sub mkdirp($$);

$rsync="rsync";
$default_backup_command="RSYNC -e 'ssh -c blowfish-cbc' -axHS"
                      . " HOST:PATH/. ."
                      . " --numeric-ids --timeout=TIMEOUT --partial"
                      . " --exclude /lost+found/ --exclude /.journal"
		      . " --exclude '*.mp3' --exclude '*.iso'"
		      . " --exclude core --delete EXTRAFLAGS";
$maxchildren=undef;

=head1 OPTIONS

=over

=item B<--extraflags=>I<flags>

Add I<flags> to rsync (or whatever the backup command is set to).

In the past, this was especially useful for occasionally running rsync
with C<--delete> (C<--extraflags=--delete>), but now that this program
saves backup copies of everything, that's part of the default command.

To add multiple options, use C<--extraflags="--option1 --option2"> or
use C<--extraflags> multiple times.

=item B<--host=>I<host>

Only backup I<host>.  (This can be used multiple times to backup
multiple hosts.)

The default is to backup all hosts.

=item B<--maxchildren=>I<number>

Backup up to I<number> systems at once.

=item B<--backupdir=>I<path>

The script creates directories under I<path> for each system.

=item B<--configfile=>I<filename>

Use I<filename> for the config file.  The default is F</etc/backup.conf>.

=item B<--configdir=>I<path>

Look for files describing what will be backed up under I<path>.  The
default is F</etc/backup.d>.

This script will look for directories named C<monthly>, C<weekly>,
C<daily>, and C<unscheduled> under this directory.  The files must be
under those directories.

=item B<--verbose>

Makes rsync more verbose (equivalent to C<--extraflags="--verbose
--progress">).  In a future revision, it might also make this script a
bit more verbose.

=item B<--debug>

Spews lots of debugging information as the program runs.  It might be
useful when debugging problems, or it might not.

This is equivalent to adding "debug=yes" to the config file.

=item B<--timeout>

Sets the I/O timeout in seconds for rsync.

=item B<--daily>

Run daily backups.  This is the default if no hosts or other schedule
(C<--weekly> or C<--monthly>) are specified.

=item B<--weekly>

Run weekly backups.

=item B<--monthly>

Run monthly backups.

=back

=cut

GetOptions("extraflags=s"   => \@extraflags,
           "host=s"         => \@hosts,
           "maxchildren=i"  => \$maxchildren,
	   "debug"          => \$debug,
	   "verbose"        => \$verbose,
	   "backupdir=s"    => \$backup_dir,
	   "configfile=s"   => \$config_file,
	   "configdir=s"    => \$config_dir,
	   "timeout=i"      => \$timeout,
	   "daily"          => \$daily,
	   "weekly"         => \$weekly,
	   "monthly"        => \$monthly,
);

$debug=$debug || $ENV{'DEBUG'};

$config_file=$config_file || (($debug ? "" : "/etc/") . "backup.conf");

read_config_file($config_file, \%conf);

=head1 FILES

=over

=item F</etc/backup.conf>

Configuration options can be given in this file in the form

    parameter = value

=over

=item B<debug>

Setting this option to "yes" is equivalent to adding B<--debug> to the
command-line.

=cut

$debug=1 if (defined($conf{'debug'}) and
             ($conf{'debug'}==1 or
              $conf{'debug'} eq "yes" or
              $conf{'debug'} eq "on"));

push(@extraflags, "--verbose --progress")
    if ($debug || ($verbose && -t(STDERR)));

=item B<default command>

This can be used to specify an alternative default command.  Certain
special strings can be used, including C<DEFAULT>.  See L</"COMMANDS">.

=cut

if (defined($conf{'default command'}))
{
    $conf{'default command'}=~s/DEFAULT/$default_backup_command/g;
    $default_backup_command=$conf{'default command'};
}

=item B<backupdir>

This is equivalent to the B<--backupdir> command-line option.

=cut

$backup_dir=$backup_dir || $conf{'backupdir'};
die "No directory specified for backups!\n" if (!$backup_dir);

=item B<maxchildren>

This is equivalent to the B<--maxchildren> command-line option.

=cut

if (!defined($maxchildren))
{
    if (defined($conf{'maxchildren'}))
    {
        $maxchildren=$conf{'maxchildren'};
    }
    else
    {
	$maxchildren=0;
    }
}
$maxchildren=int($maxchildren);
debug "\$maxchildren set to '$maxchildren'";

=item B<configdir>

This is equivalent to the B<--configdir> command-line option.

=cut

$config_dir=$config_dir
	    || $conf{'configdir'}
            || (($debug ? "" : "/etc/") . "backup.d");

=item B<timeout>

This is equivalent to the B<--timeout> command-line option.

=cut

$timeout=$timeout || $conf{'timeout'};

=back

=item F</etc/backup.d/*>

Each host to be backed up should have a file under this directory.
The file's name must be the name of the host to backup.

The format of the file is

    /path/to/backup	command

The command is optional.

=back

=cut

$daily=$daily || !($weekly || $monthly);

debug("daily = $daily" . (defined($weekly) ? ", weekly = $weekly" : "")
      . (defined($monthly) ? ", monthly = $monthly" : ""));

safe_chdir $config_dir or die "chdir($config_dir) failed: $!\n";
for my $type (qw(unscheduled monthly weekly daily))
{
    my $dir=new DirHandle $type
        or warn "Failed to open $config_dir/$type: $!\n";

    for my $file ($dir->read)
    {
        next if ($file=~/^\.\.?$/);

	warn "Redefining " . $host{$file}->{'_schedule'}
	   . " backup for $file as $type.  Previous settings will be ignored.\n"
	    if (defined($host{$file}));

        $host{$file}=read_host_conf("$type/$file");
	warn "A _schedule filesystem exists for $file."
	   . "  It will not be backed up.\n"
	    if (defined($host{$file}->{'_schedule'}));
	$host{$file}->{'_schedule'}=$type;
    }
}

if (!keys(%host))
{
    print STDERR "No hosts defined, exiting...\n";
    exit 0;
}

@children=();
$done=0;

$SIG{'CHLD'}=\&reaper;
$SIG{'ALRM'}=sub { debug "[$$] Caught SIGALRM"; alarm(30); kill('CHLD', $$); };
for my $signal (qw(HUP INT QUIT TERM CONT TSTP))
{
    $SIG{$signal}=\&kill_em_all;
}

if (!@hosts)
{
    @hosts=grep {
            (defined($daily) && $daily)
	        && $host{$_}->{"_schedule"} eq "daily"
            or (defined($weekly) && $weekly)
	        && $host{$_}->{"_schedule"} eq "weekly"
            or (defined($monthly) && $monthly)
	        && $host{$_}->{"_schedule"} eq "monthly"
        } keys(%host);
}

if (!@hosts)
{
    print STDERR "No hosts scheduled for backup, exiting.\n";
    exit 0;
}

alarm(30);
for my $hostname (@hosts)
{
    last if ($done);

    if (!defined($host{$hostname}))
    {
	warn "Host '$hostname' specified on the command line is not defined!\n";
	next;
    }

    if ($maxchildren)
    {
        debug "Checking for available slots...";
	while (@children >= $maxchildren)
	{
	    # *FIXME* - A SIGCHLD right now would be a Bad Thing.
	    debug "Waiting for slot to open...";
	    pause; # But after this it would be OK.
	}
	my $pid=fork;
	if ($pid > 0)
	{
	    push(@children, $pid);
	    debug scalar(@children), " children...";
	}
	elsif ($pid == 0)
	{
	    $SIG{'ALRM'}='IGNORE'; # Not necessary, but what the hell?
            for my $signal (qw(TSTP CHLD))
            {
                $SIG{$signal}='DEFAULT';
            }
            for my $signal (qw(HUP INT QUIT TERM CONT))
            {
                #$SIG{$signal}=sub { debug "Child got signal '$_[0]'."; $done=1; $SIG{$_[0]}='DEFAULT'; kill $_[0], $$; };
                #$SIG{$signal}=sub { debug "Child got signal '$_[0]'."; $done=1; };
            }
            debug "[$$] Backing up $hostname...";
            for my $path (grep { $_ ne "_schedule" } keys(%{$host{$hostname}}))
            {
                last if ($done);
                backup($hostname, $path, @{$host{$hostname}->{$path}});
            }
            touch "$backup_dir/.$hostname-last-updated";
            wait;
	    exit 0;
	}
	else
	{
	    warn "fork() failed: $!";
	}
    }
    else
    {
        debug "Backing up $hostname...";
        for my $path (grep { $_ ne "_schedule" } keys(%{$host{$hostname}}))
        {
            backup($hostname, $path, @{$host{$hostname}->{$path}});
        }
        touch "$backup_dir/.$hostname-last-updated";
    }
}

if ($maxchildren)
{
    while (@children)
    {
        debug "Waiting for children to exit...";
	pause;
    }
}

debug "Exiting...";

sub read_config_file($$)
{
    my ($config_file, $conf)=@_;

    my $config=new FileHandle "<$config_file"
	or return;
	#or die "Failed to open $config_file: $!\n";

    my $last;
    while (<$config>)
    {
	chomp;
	s/(?<!\\)#.*$//; # Strip comments ("\" escapes "#")
	$_=$last.$_ if ($last);
	if (s/\\\s*$//)
	{
	    $last=$_;
	    next;
	}
	else
	{
	    $last="";
	}
	next if (/^\s*$/); # Skip blank lines

	my ($param,$value)=/^\s*([^=]*?)\s*=\s*(.*?)\s*$/;
	if (!$param)
	{
	    warn "Skipping bogus line $. of $config_file...\n";
	    next;
	}
	warn "Redefining $param! ($config_file line $.)\n"
	    if (defined($conf->{$param}));
	$conf->{$param}=$value;
	debug $param, "=", bold("'"), $value, bold("'");
    }
    close($config);
}

sub read_host_conf($)
{
    my $config_file=shift;

    my $config=new FileHandle "<$config_file"
        or die "Failed to open $config_file: $!\n";

    debug "Reading file '$config_file'...";

    my (%conf,$last);
    while (<$config>)
    {
        chomp;
        s/(?<!\\)#.*$//; # Strip comments ("\" escapes "#")
        $_=$last.$_ if ($last);
        if (s/\\\s*$//)
        {
            $last=$_;
	    next;
        }
        else
        {
            $last="";
        }
        next if (/^\s*$/); # Skip blank lines

        my ($path,@command)=split;
        warn "Re-defining $config_file:$path, line $.\n"
            if (defined($conf{$path}));
        $conf{$path}=[@command];
    }
    close($config);

    return \%conf;
}

sub backup($$@)
{
    my ($hostname,$path,@command)=@_;

    debug "\t$hostname:$path";

    safe_chdir $backup_dir or die "safe_chdir '$backup_dir' failed: $!\n";

    if (!safe_chdir $hostname)
    {
        mkdir $hostname, 0700;
	safe_chdir $hostname or die "safe_chdir '$backup_dir/$hostname': $!\n";
    }

    if (!safe_chdir "./$path")
    {
        debug "need to create './$path'";
        for my $part (split '/', $path)
	{
            next if (!$part);
	    debug "creating '$part'";
	    mkdir $part, 0700;
	    safe_chdir $part
	        or die "safe_chdir '$backup_dir/$hostname/$path: $!\n";
	}
    }

=head1 COMMANDS

Any commands to run specified in the configuration files will have the
following substitutions performed on them:

=over

=item C<DEFAULT>

This will be replaced with the default command.

=item C<EXTRAFLAGS>

This will be replaced with any flags specified with B<--extraflags> on
the command line.

=item C<HOST>

This will be replaced with the name of the host being backed up.

=item C<PATH>

This will be replaced with the path being backed up.

=back

All commands are run from the directory where backups for that host
and filesystem should be stored.

=cut

    my $command="@command" || $default_backup_command;

    $command=~s/DEFAULT/$default_backup_command/g;
    if (@extraflags and $command=~/EXTRAFLAGS/)
    {
	my $extraflags="@extraflags";
        $command=~s/EXTRAFLAGS/$extraflags/g;
    }
    else
    {
        $command=~s/\s+EXTRAFLAGS//g;
        $command=~s/EXTRAFLAGS\s+//g;
        $command=~s/EXTRAFLAGS//g;
    }
    $command=~s/HOST/$hostname/g;
    $command=~s/PATH/$path/g;
    $command=~s/TIMEOUT/$timeout/g;

    if ($command=~/RSYNC/)
    {
	my $rsync_command=$rsync;

	if (-f "$backup_dir/.$hostname-last-updated")
	{
	    my $mtime=(stat("$backup_dir/.$hostname-last-updated"))[9];
	    # Sanity check - I'm implementing this feature at
	    # time_t==1019229210
	    # Fri Apr 19 10:13:30 CDT 2002
	    # We'll use the value, but at least there will be a warning.
	    warn "Timestamp on $backup_dir/.$hostname-last-updated, "
	        . scalar(localtime($mtime)), ", makes no sense.\n"
		if ($mtime<1000000000);
	    my @then=localtime($mtime);
	    my $last=sprintf("%d%02d%02dT%02d%02d%02d",
		             $then[5]+1900, # year
			     $then[4]+1,    # month
			     $then[3],      # day
			     $then[2],      # hour
			     $then[1],      # minute
			     $then[0]);     # second
	    my $archive_path="$backup_dir/.archive/$hostname/$last/$path";
	    mkdirp $archive_path, 0700
	    #mkdir "$backup_dir/.archive", 0700;
	    #mkdir "$backup_dir/.archive/$hostname", 0700;
	    #mkdir "$backup_dir/.archive/$hostname/$last", 0700;
	        or die "Failed to create $archive_path: $!\n";
	        #if (!-d "$backup_dir/.archive/$hostname/$last");
	    $rsync_command.=" -b --backup-dir"
                          . " $archive_path";
	}
        $command=~s/RSYNC/$rsync_command/g;
    }

    debug "Running";
    debug "    $command";
    debug "in $backup_dir/$hostname/$path";
    my $ret=my_system $command;
    if ($ret != 0)
    {
        print STDERR "'$command' failed: ";
        if ($ret == -1)
        {
            print STDERR "$!\n";
        }
        else
        {
            if ($ret & 127)
            {
                print STDERR "exited on signal ", $ret & 127;
                print STDERR ", core dumped" if ($ret & 128);
            }
            else
            {
                print STDERR "exit value ", $ret >> 8;
            }
            print STDERR "\n";
        }
    }
}

sub my_system(@)
{
    my $pid=fork;

    if ($pid > 0)
    {
        @children=($pid);
        waitpid($pid, 0);
	return $?;
    }
    elsif ($pid == 0)
    {
        exec @_ or return -1;
    }
    else
    {
        return -1;
    }
}

sub safe_chdir($)
{
    my $dir=shift;

    if (!$dir)
    {
        carp "empty directory passed to safe_chdir, ignoring";
    }
    else
    {
        chdir $dir;
    }
}

sub debug(@)
{
    return if (!$debug);
    if (!@_)
    {
        print STDERR "\n";
    }
    else
    {
        print STDERR bold("d: "), @_, "\n";
    }
    STDERR->flush;
}

sub bold($)
{
    return @_ if (!-t STDERR);
    return "\033[37;1m" . $_[0] . "\033[0m";
}

sub reaper
{
    for (my $n=0;$n<@children;$n++)
    {
        if (waitpid($children[$n], 1)!=0) # *FIXME* Should be WNOHANG (not 1)
	{
	    debug "[$$] PID $children[$n] exited.";
	    splice(@children, $n, 1);
	}
    }
}

sub kill_em_all
{
    my $sig=$_[0];

    debug "[$$] Got signal '$sig'";

    for my $child (@children)
    {
        debug "[$$] killing PID $child...";
        kill $sig, $child;
    }

    $done=1
        if ($sig eq 'HUP' or $sig eq 'INT' or $sig eq 'QUIT' or $sig eq 'TERM');
}

sub touch(@)
{
    my $now=time;
    for my $file (@_)
    {
	debug "touch($file)";
	# Create the file if it doesn't already exist.
        my $fh=new FileHandle $file, O_WRONLY|O_CREAT|O_EXCL;
	if ($fh)
	{
	    close($fh);
	}
	else
	{
            utime($now, $now, $file) or die "utime() failed on $file: $!\n";
	}
    }
}

sub mkdirp($$)
{
    my ($dir, $mode)=@_;

    my @parts=split '/', $dir;

    my $path="";
    $path="/" if ($dir=~/^\//);

    for my $part (@parts)
    {
	next if ($part eq "");

	$path.="$part";
        if (!-d $path)
	{
            debug "Doing mkdir($path, " . sprintf("%04o", $mode) . ")...";
            if (!mkdir $path, $mode)
	    {
	        return 0 if ($! != EEXIST);
	    }
	}
	$path.="/";
    }

    return 1;
}

=head1 SEE ALSO

L<rsync(1)>, L<ssh(1)>, L<run1(1)>, L<mount(8)>, L<smbmount(8)>,
L<umount(8)>

=head1 AUTHOR

Steven Pritchard <F<steve@silug.org>>

=cut