#!/afs/athena/contrib/perl/perl
#
# run 'tar' over various directories, write a tape device.
#
# by Albert Dvornik <bert@mit.edu>
#
# $Id$

unshift(@INC, '/afs/athena.mit.edu/user/b/e/bert/project/tape');
require('pipecmd.pl');

### defaults

$DEVICE = '/dev/nrmt0h';	# tape device

$tar = '/afs/athena/project/gnu/bin/gtar';
$dd  = 'dd';
$mt  = 'mt';
@rsh = ('/usr/athena/bin/rsh', 'hodge', '-l', 'bert');

### sighandler...
sub handler {
    local($sig) = @_;
    print "*** CAUGHT SIG$sig: QUITTING AFTER THIS OPERATION COMPLETES ***\n";
    print LOG "(CAUGHT SIG$sig: QUITTING AFTER THIS OPERATION COMPLETES)\n";
    $QUIT++;
    # I don't think this is needed at all, but it can't hurt.
    $SIG{$sig} = 'IGNORE';
}

### usage info

sub usage {
    local($prog) = $0;
    $prog =~ s@.*/@@g;
    print <<"EndOfUsage";

Usage: $prog [options] [list-of-dirs [tape-device]]
Options:
  -d    debug
  -n    don't do anything
  -v    verbose
  -e    don't eject the tape when done

The device defaults to $DEVICE.

Ctrl-C will abort the operation *after* the operation in progress is finished.

EndOfUsage
    exit 0;
}

### main body

# Ctrl-C exits in a more controlled fashion.
# $SIG{'INT'} = $SIG{'QUIT'} = 'handler';

# arg parsing

$| = 1;

while ($ARGV[0] =~ /^-/) {
    ($ARGV[0] =~ /^-d/)  && (shift @ARGV, $debug++, next);
    ($ARGV[0] =~ /^-v/)  && (shift @ARGV, $verbose++, next);
    ($ARGV[0] =~ /^-n/)  && (shift @ARGV, $dontdoit++, next);
    ($ARGV[0] =~ /^\+e/) && (shift @ARGV, $noeject=0, next);
    ($ARGV[0] =~ /^-e/)  && (shift @ARGV, $noeject++, next);
    &usage();
}

$infile = shift(@ARGV) if @ARGV;
$DEVICE = shift(@ARGV) if @ARGV;

@ARGV && &usage();

@ARGV = ($infile);

# set up environment

$DEVICE='/dev/null' if $dontdoit;
@remote = @rsh unless $dontdoit;

$krbtkfile = '/tmp/tkt.bert';
$krbtkfile = $ENV{'KRBTKFILE'} if ( ! -e $krbtkfile );

%ENV = ('PATH', $ENV{'PATH'} . ":/mit/gnu/bin",
	'TAPE', $DEVICE,
	'KRBTKFILE', $krbtkfile);

# attach gnu if necessary
# system('/bin/athena/attach', 'gnu') if ( ! -e '/mit/gnu' );

# rewind the tape

&check_exit_code('mt rewind', system(@remote, $mt, '-f', $DEVICE, 'rewind'))
    unless $dontdoit;

# just write the device while we can.

while (<>) {
    chop;
    unless (/^\#/ || /^\s+$/) {
	local($hostdir,@args) = split(/\s+/);
	local(@hostdir) = split(/:/,$hostdir,2);
	local($host,$dir);

	print "Backing up $hostdir\n";
	if ($#hostdir > 0) {
	    ($host,$dir) = @hostdir;
	    warn "Ignoring host `$host' (not supported yet)\n";
	} else {
	    $dir = $hostdir;
	    undef $host;
	}

	&tar_directory($dir, @args);
    }
}

# rewind and eject, unless -e was given

&check_exit_code('mt offline', system(@remote, $mt, '-f', $DEVICE, 'offline'))
    unless ($dontdoit || $noeject);

# tar up a directory, starting from its parent.

sub tar_directory {
    local($dirname,@rest) = @_;
    local($cwd, $nwd, @nwd, $top);

    @dir = split(m@/@, $dirname);

    $cwd = `pwd`;
    chop $cwd;

    unless (chdir($dirname)) {
	warn "chdir($dirname) failed: $!, ignored\ncontinuing";
	return undef;
    }
    $nwd = `pwd`;
    chop $nwd;
    @nwd = split(m@/@, $nwd);
    $top = pop(@nwd) || '.';
    $nwd = join('/', @nwd) || '/';
    warn "warning: I will be archiving `$dirname' under `$top'.\n"
	if (($top ne $dir[$#dir]) && ($dirname ne '/'));

    unless (chdir($nwd)) {
	warn "chdir($nwd) failed: $!, ignored\ncontinuing";
	return undef;
    }

    print ">> tar'ing up $top for $nwd/$top\n" if ($debug>1);

    &tar_and_write($top,@rest);

    chdir($cwd) || (warn "chdir($cwd) failed: $!, ignored\ncontinuing",
		    return undef);
}

# tar up a directory, write it to disk.

sub tar_and_write  {
    local($dirname, @tar_args) = @_;

    # run "tar cf | dd", but with slightly more control

    &pipecmd'set_upstream_cmd('$tquit++; @tar=($err,$sig);',
			      $tar, @tar_args, '-cvf', '-', $dirname);
    &pipecmd'set_downstream_cmd('$dquit++; @dd=($err,$sig);',
			   @remote, $dd, 'bs=10k', 'conv=block', "of=$DEVICE");
    &pipecmd'run();
    &pipecmd'wait (undef, $debug);

    die "tar failed, error code $tar[0] (signal $tar[1])\naborting" if $tquit;
    die "dd failed, error code $dd[0] (signal $dd[1])\naborting" if $dquit;
}

# check error return from system()

sub check_exit_code {
    local($name, $sys) = @_;
    print ">> `$name' returned $sys.\n" if $debug;
    if ($sys) {
	local($err,$sig) = ($sys >> 8, $sys & 0xFF);
	die "`$name' failed with error code $err (signal $sig)\ngiving up";
    }
}