#!/usr/athena/bin/perl

# $Id: backup.pl,v 1.9 93/02/08 12:40:54 mhpower Exp $
#
# <marc@mit.edu>

require 'chat2.pl';

($a0 = $0) =~ s!^.*/([^/]+)$!$1!;

# defaults

$volset = "";
$level = "";
$cell = "sipb.mit.edu";
$stattime = 300;
$dumpdir = "/afs/sipb.mit.edu/project/newdump";
$noclone = 0;

sub usage {
    die "Usage: $a0 [-volset] <volume set> [-level] <dump level> [-cell <cell name>] [-stattime <seconds>] [-dumpdir <dirname>] [-noclone]\n";
}

@args = ("volset","level","cell","stattime","dumpdir","noclone", "");
@noarg{"noclone"} = (1);
for ($i=$[;$i<=$#args;$i++) { $next{$args[$i]} = $args[$i+1]; }

$next = "volset";

while ($arg = shift(@ARGV)) {
    if ($arg =~ /^-(.*)$/) {
	defined($next{$1}) || &usage;

	*var = $1;

	if ($noarg{$1}) {
	    $var = 1;
	} else {
	    $var = shift(@ARGV) || &usage;
	}

	$next = $next{$1};
    } else {
	$next || &usage;
	local(*tmp) = $next;
	$tmp = $arg;

	$next = $next{$next};
    }
}

die "-volset and -level must be specified.\n" if !$volset || !$level;

chdir $dumpdir || die "chdir: $!\n";

$tmpdir = "/usr/tmp";
$ext = sprintf("%02d" x 3,(localtime)[5],(localtime)[4]+1,(localtime)[3]);

### Print out args

foreach (@args) {
    local(*arg) = $_;
    next if !$_;
    print '$',$_,' = ',$arg,"\n";
}
print "\n";

###
### do-backups.csh
###

if (!$noclone) {
    open(DBLOG,">$tmpdir/do-backups.".$ext) || die "opening dblog: $!\n";
    select((select(DBLOG),$|=1)[0]);

# This should probably be inlined in perl...
    open(DB,'echo "" | scripts/do-backups.csh 2>&1 |')
	|| die "do-backups: $!\n";

    while(<DB>) {
	print "    db: ",$_;
	print DBLOG || die "dblog: $!\n";
    }

    close(DBLOG) || die "closing dblog: $!\n";
    close(DB);
} else {
    print "    db: Skipping do-backups.csh\n";
}

###
### butc
###

open(BUTCLOG,">$tmpdir/butc.".$ext) || die "opening butclog: $!\n";
select((select(BUTCLOG),$|=1)[0]);

($butc = &chat'open_proc("sh","-c","exec @sys/butc 2>&1"))
    || die "butc: $!\n";

$prog{$butc} = 'butc';

sub butckill {
    sleep 5;
    $butckilled = 1;
    print "Killing butc...\n";
    if ($bpid = &chat'proc_pid($butc)) { kill('INT',$bpid); }
}

sub butclog { 
    print "  butc: ",$butcout,$1,"\n";
    print BUTCLOG $butcout,$1,"\n";
    $butcout = "";
} 

###
### backup
###

open(BACKUPLOG,">$tmpdir/backup.".$ext) || die "opening backuplog: $!\n";
select((select(BACKUPLOG),$|=1)[0]);

($backup = &chat'open_proc("sh","-c","exec @sys/backup -cell $cell 2>&1"))
    || die "backup: $!\n";

$prog{$backup} = 'backup';

&chat'print($backup, "dump $volset $level\n");

sub backupquit {
    $backupquitted = 1;
    print "Quitting backup...\n";
    &chat'print($backup, "quit\n");
}

sub backuplog { 
    print "backup: ",$backupout,$1,"\n";
    print BACKUPLOG $backupout,$1,"\n";
    $backupout = "";
} 

###
### main loop
###

# A backup command has already been issued.  Sit here logging stuff, 
# remembering any errors.
# - Every $stattime seconds, give backup a "status" command. 
# - If butc asks for a return, give it one.
# - If butc exits, sent backup a quit command and register an error.
# - If backup exits, kill butc.
# - If the dump returns an error, send backup a quit command.
# - If the dump finishes, send backup a quit command.
# - If SIGINT, send backup a kill command.
# - When kill command succeeds, send backup a quit command.

sub sigint {
    &chat'print($backup,"kill 0\n");
    print "Killing dump...\n";
    $SIG{'INT'} = 'suicide';
}

sub suicide {
    print "Killing children.\n";
    kill(&chat'proc_pid($butc), &chat'proc_pid($backup));
    exit(1);
}

$SIG{'INT'} = 'sigint';

$stattime = undef if $stattime == 0;

$done = 0;
$error = "";

while($done < 2) {
    @readable = &chat'select($stattime, $butc, $backup, "STDIN");
    unless (@readable) { # if timed out
	&chat'print($backup,"status\n");
    }
    foreach $h (@readable) {
	eval {
	    if ($prog{$h} eq "backup") {
		&chat'expect($h, 0,
			     'EOF',
			     <<'EOC',
			     $done++;
			     &butckill if $done == 1;
			     if (!$backupquitted) { $error .= "backupdied "; }
EOC

			     '^\t([^ ]+) \((\d+)\).*\n',
			     q!$vol{$2} = $1;!,

			     '^.*Dump ID \d+, volume (\d+), bytes transferred (\d+).*\n',
			     <<'EOC',
			     print ("Backup status: dumping volume ",$vol{$1},
				    ", dumped ",$2," bytes so far.\n");
EOC

			     '^(.*Dump [^\s]+ encountered an error.*)\n',
			     <<'EOC',
			     &backuplog;
			     &backupquit;
			     $error .= "dumperror ";
EOC

			     '^(.*Finished doing dump [^\s]+ successfully.*)\n',
			     <<'EOC',
			     &backuplog;
			     &backupquit;
EOC

			     '^(.*Dump [^\s]+ aborted.*)\n',
			     <<'EOC',
			     &backuplog;
			     &backupquit;
EOC

			     '^(.*Job not in use.*)\n',
			     <<'EOC',
			     &backuplog;
			     &backupquit;
EOC

			     '^(.*)\n',
			     q!&backuplog;!,

			     '^(.+)$',
			     q!$backupout .= $1;!,
			     );
	    } elsif ($prog{$h} eq "butc") {
		&chat'expect($h, 0,
			     'EOF',
			     <<'EOC',
			     $done++;
			     &backupquit if $done == 1;
			     if (!$butckilled) { $error .= "butcexit "; }
EOC

			     '^(.*Hit return when done.*)\n',
			     <<'EOC',
			     &butclog;
			     &chat'print($butc,"\n");
EOC

			     '^(.*)\n',
			     q!&butclog;!,

			     '^(.+)$',
			     q!$butcout .= $1;!,
			     );
	    } elsif ($h eq "STDIN") {
		$line = <STDIN>;
		&chat'print($backup, $line);
	    }
	};
    }
    if ($@) {
	print $@;
	&sigint;
    }
}

# close the log files and child procs

close(BUTCLOG) || die "closing butclog: $!\n";
close(BACKUPLOG) || die "closing backuplog: $!\n";
&chat'close($butc);
&chat'close($backup);

# Might want to mail this or something.

print(STDERR "ERRORS: ",$error,"\n") if $error;

# move log files into subdir

opendir(TMPDIR,$tmpdir);
while($f=readdir(TMPDIR)) {
    next if ($f !~ /\.$ext$/);

    system("compress","$tmpdir/$f") && warn "compressing $f: $!\n";
    rename("$tmpdir/$f.Z","last/$f.Z") || warn "renaming $f: $!\n";
}
closedir(DOT);

print "Done.\n";

exit(0);