#!/usr/bin/perl -w
#
# Copyright 2000, 2001 Tivano Software GmbH. This software is
# distributed under the terms of the GNU General Public License. See
# COPYING for additional information.
#
# This is a hacked-up replacement for "taper" to dump backups to a CD-RW.
#
# If the configured tape device does not match the regexp '/dev/scd\d+.*',
# the original taper is executed. Otherwise, the script assumes a dump
# to a CD-RW and handles the taper protocol itself.
#
# The complete content of the intermediate directory(-ies) is written to
# disk when the taper revceives the 'QUIT' command (provided that media
# with matching labels are in the drive). This means that errors in
# burning the CD can't be reported back to amanda. In this case, the
# script mails an error message to the backup admin.
#
# The amanda file header is stripped from the file before the file is
# copied to CD-RW, making the CD contain the "naked" dump/tar
# archives. The information from the amanda file header is put in an
# extra file on CD-RW.

use Fcntl ':flock';
use Socket;
use strict;

my $dir = $0;
$dir =~ s/[^\/]*$//;
push @INC, $dir;
require "taperlib.pm";

# suppress some warnings
my $dummy = $Amanda::Taper::CD_DEVICE_RE;
$dummy = $Amanda::Taper::SENDMAIL;

select (STDOUT); $| = 1;

if ($#ARGV < 0) {
    print STDERR "Usage: $0 <config> [-flush <label> [<label>...]]\n";
    exit 1;
}

# Read the amanda config
my $taper = new Amanda::Taper($ARGV[0], \&error);

# If $tapedev is not a CD-RW device, execute the original taper
if ($taper->{AMANDA_CONF}->{rawtapedev} !~ $Amanda::Taper::CD_DEVICE_RE) {
  unshift @ARGV, $Amanda::Taper::TAPER_ORIG;
  exec @ARGV or die "taper: Cannot execute '$Amanda::Taper::TAPER_ORIG'";
}

print STDERR "taper: pid $$ executable taper version cdrw-taper-$Amanda::Taper::VERSION\n";

if ($#ARGV > 1 && $ARGV[1] eq "-flush") {
    shift @ARGV;
    shift @ARGV;
    &flushDirs($taper, @ARGV);
    exit 0;
}

my $filenum = 0;
my $cmd = "";
my ($bytes_read, $args, $DATESTAMP);
while ($cmd ne "QUIT") {
  my $line = '';
  my $char = '';
  my $error = '';
  while (($bytes_read = read(STDIN, $char, 1)) && $char ne "\n") {
    $line .= $char;
  }
  last if !$bytes_read;
  next if !$line;
  ($cmd, $args) = ($line =~ /([\w-]+)\s*(.*)/);
  my $response = "BAD-COMMAND \"[No support for '$line']\"";
  if ($cmd eq "START-TAPER") {
	$DATESTAMP = $args;
	if ($#{$taper->{usableMedia}} < 0) {
	    $response = "TAPE-ERROR \"[no media available]\"";
	    $taper->log_add("ERROR", "no-tape [no media available]");
	} else {
	    $response = "TAPER-OK";
	    $taper->log_add("START", "datestamp $DATESTAMP label ".$taper->{usableMedia}->[0]." tape 0");
	}
  } elsif ($cmd eq "FILE-WRITE" || $cmd eq "PORT-WRITE") {
	my $timestamp = time();
	my ($handle, $filename, $hostname, $diskname, $level);
	my ($fs, $infofile);
	if ($args =~ /^(\S+)\s+/) {
	    $handle = $1;
	    $args = $';
	    if ($cmd eq "PORT-WRITE") {
		if ($args =~ /^(\S+)\s+(\S+)\s+(\S+\s+)?(\d+)\s+(\d+)\s*$/) {
		    ($hostname, $diskname, $level) = ($1, $2, $4);
		    $filename = &portWrite($taper, $handle, $hostname, $diskname, $level);
		    $fs = $taper->fileSize($filename) + 16; # $filename has only data, add 32k
		    $infofile = $filename;
		    $infofile =~ s/\.(tar|dump)(\.gz)?$/.info/;
		} else {
		    $error = "Can't parse '$line'";
		    $taper->log_add("FAIL", $error);
		    $response = "TAPE-ERROR $handle \"[$error]\"";
		}
	    } else { # FILE-WRITE
		if ($args =~ /^(\S+)\s+(\S+)\s+(\S+\s+)?(\S+)\s+(\d+)\s+(\d+)\s*$/) {
		    ($filename, $hostname, $diskname, $level) = ($1, $2, $4,$5);
		    $fs = $taper->fileSize($filename);
		} else {
		    $error = "Can't parse '$line'";
		    $taper->log_add("FAIL", $error);
		    $response = "TAPE-ERROR $handle \"[$error]\"";
		}
	    }
	} else {
	    $error = "No handle in '$line'";
	    $taper->log_add("FAIL", $error);
	    $response = "BAD-COMMAND \"[$error]\"";
	}
	if ($error eq '') {
	    $filenum++;
	    my $dir = $taper->findMediaDir($fs);
	    if (!defined($dir)) {
	        $error = "No more disks";
	        $taper->log_add("FAIL", "$hostname $diskname $level [$error]");
	        $response = "TAPE-ERROR $handle \"[$error]\"";
	        if ($cmd eq "PORT-WRITE") {
		    unlink($filename);
		    unlink($infofile);
	        }
	    } else {
	        if ($cmd eq "PORT-WRITE") {
		    rename($filename, "$Amanda::Taper::DUMP_DIR/$dir/".substr($filename,length($Amanda::Taper::DUMP_DIR)));
		    rename($infofile, "$Amanda::Taper::DUMP_DIR/$dir/".substr($infofile,length($Amanda::Taper::DUMP_DIR)));
	        } else {
	            $error = $taper->dump_file($filename, "$Amanda::Taper::DUMP_DIR/$dir");
	        }
    	        my $elapsed = time() - $timestamp;
	        if ($error) {
		    $taper->log_add("FAIL", "$hostname $diskname $level [$error]");
		    $response = "TAPE-ERROR $handle \"[$error]\"";
	        } else {
		    $taper->{usedMedia}->{$dir}->{freeBlocks} -= $fs;
		    my $speed = ($elapsed? $fs * $Amanda::Taper::BLOCKSIZE / $elapsed : 0.0);
		    my $size = $fs * $Amanda::Taper::BLOCKSIZE;
		    $response = "DONE $handle $dir $filenum \"[sec $elapsed.000 kb $size kps $speed (null)]\"";
#		    # Don't log success here, wait until the CD-RW is written
#		    push @log_success, "$hostname $diskname $DATESTAMP $level [sec $elapsed.000 kb $size kps $speed]";
		    $taper->log_add("SUCCESS", "$hostname $diskname $DATESTAMP $level [sec $elapsed.000 kb $size kps $speed (null)]");
	        }
	    }
	}
  } elsif ($cmd eq "QUIT") {
    # Don't send the final message until the CD-RW is written...
    $response = "";
  }
  if ($response) {
    print "$response\n";
  }
}

my $error = "";
# Mark the disk as recently used in $tapelist
if (!open(ML, ">$taper->{AMANDA_CONF}->{tapelist}.$$")) {
    $error = "Could not write the new media list to $taper->{AMANDA_CONF}->{tapelist}.$$: $!\n";
} else {
    foreach my $media (keys %{$taper->{usedMedia}}) {
	print ML "$DATESTAMP $media reuse\n";
    }
    foreach my $entry (@{$taper->{medialist}}) {
	my ($datestamp, $label, $reuse_flag) = split /\s+/, $entry;
	if (!exists($taper->{usedMedia}->{$label})) {
	    print ML "$datestamp $label $reuse_flag\n";
	}
    }
    close ML;
    # FIXME: if write above fails don't rename!
    if (!rename("$taper->{AMANDA_CONF}->{tapelist}.$$",
		"$taper->{AMANDA_CONF}->{tapelist}")) {
	$error = "Could not rename $taper->{AMANDA_CONF}->{tapelist}.$$ to $taper->{AMANDA_CONF}->{tapelist}: $!\n";
    }
}

foreach my $label (@{$taper->{availableMedia}}) {
    if (exists($taper->{usedMedia}->{$label})) {
	my $err = $taper->burnDir("$Amanda::Taper::DUMP_DIR/$label", $label);
	if ($err) {
	    $error .= "Errors for $label:\n$err";
	} else {
	    if ($Amanda::Taper::DELETE_DIRS) {
	        unlink <$Amanda::Taper::DUMP_DIR/$label/*>;
	        rmdir "$Amanda::Taper::DUMP_DIR/$label";
	    }
	    $taper->{usedMedia}->{$label}->{"burnt"} = 1;
	}
    }
}

if ($Amanda::Taper::WRITE_NON_ERASABLE) {
    foreach my $label (keys %{$taper->{usedMedia}}) {
	if ($#{$taper->{nonErasable}} < 0) { last; }
        if (!$taper->{usedMedia}->{$label}->{"burnt"}) {
	    my $err = $taper->burnDir("$Amanda::Taper::DUMP_DIR/$label", 0);
	    if ($err) {
	        $error .= "Errors for $label:\n$err\n";
	    } else {
	        if ($Amanda::Taper::DELETE_DIRS) {
	            unlink <$Amanda::Taper::DUMP_DIR/$label/*>;
	            rmdir "$Amanda::Taper::DUMP_DIR/$label";
	        }
	        $taper->{usedMedia}->{$label}->{"burnt"} = 1;
	    }
        }
    }
}

foreach my $label (keys %{$taper->{usedMedia}}) {
    if (!$taper->{usedMedia}->{$label}->{"burnt"}) {
        $error .= "The directory for $label remains to be dumped.\n";
    }
}

# Log success for all dumps
#foreach my $msg (@log_success) {
#    taperlib::log_add("SUCCESS", $msg);
#}

if ($error ne "") {
    &error($taper, $error);
}

# OK, send the acknowledge for "QUIT"
print "QUITTING\n";

exit 0;

# Flush a set of intermediate directories to any available media
sub flushDirs {
    my $taper = shift;
    my @labels = @_;

    foreach my $label (@labels) {
	if ( -d "$Amanda::Taper::DUMP_DIR/$label" && -r "$Amanda::Taper::DUMP_DIR/$label/AMANDA_LABEL" ) {
	    if (open(AMLABEL, "<$Amanda::Taper::DUMP_DIR/$label/AMANDA_LABEL")) {
		my $lbl = <AMLABEL>;
		close AMLABEL;
		$lbl =~ s/[\r\n]+//g;
		if ($lbl ne $label) {
		    print STDERR "Label in $Amanda::Taper::DUMP_DIR/$label/AMANDA_LABEL doesn't match $label!\n";
		} else {
		    my $err = $taper->burnDir("$Amanda::Taper::DUMP_DIR/$label", $label);
		    if ($err) {
			if ($Amanda::Taper::WRITE_NON_ERASABLE && $#{$taper->{nonErasable}} >= 0) {
			    $err = $taper->burnDir("$Amanda::Taper::DUMP_DIR/$label", 0);
			}
		    }
		    if ($err) {
			print STDERR "$err\n";
		    } else {
			if ($Amanda::Taper::DELETE_DIRS) {
			    unlink <$Amanda::Taper::DUMP_DIR/$label/*>;
			    rmdir "$Amanda::Taper::DUMP_DIR/$label";
			}
			print STDERR "Flushed $label.\n";
		    }
		}
	    } else {
		print STDERR "Couldn't read $Amanda::Taper::DUMP_DIR/$label/AMANDA_LABEL!\n";
	    }
	} else {
	    print STDERR "No amanda dump dir found for $label!\n";
	}
    }
    print STDERR "Done.\n";
}

# Port-Write command: listen on a socket and read data from it
sub portWrite {
    my $taper = shift;
    my ($handle, $host, $disk, $level) = @_;

    $disk =~ s=/=_=g;
    my $filename = "$Amanda::Taper::DUMP_DIR/$host.$disk.$level";

    my $port = int(20000 + rand(10000)); # choose one randomly, try the next 10
    my $proto = getprotobyname('tcp');
    socket(Server, PF_INET, SOCK_STREAM, $proto);
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
    my $i = 0;
    while (!bind(Server, sockaddr_in($port, INADDR_ANY)) && $i++ < 10) {
	$port++;
    }
    listen(Server,SOMAXCONN);
#    print "PORT $handle $port\n";
    print "PORT $port\n";
    accept(Client, Server);

    my $header = "";
    my $eof = 0;
    while (length($header) < 32*1024 && !$eof) {
	my $buf;
	my $res = read(Client, $buf, 32*1024 - length($header));
	$eof = ($res eq "0");
	$header .= $buf;
    }

    if ($eof) {
	$taper->log_add("FATAL", "PORT-WRITE: short data");
	exit 1;
    }

    $header =~ s/\0*$//s;
    my ($compext, $dumpext) =
	($header =~ /AMANDA: FILE \d+ [-\w.]+ \S+ lev \d+ comp (\S+) program (\S+)/);
    if ($compext && $dumpext) {
	if ($compext eq "N") { $compext = ""; }
	$dumpext =~ s%.*/%%;
	$dumpext = "tar" if $dumpext =~ /^g?tar$/;
	$dumpext = ".$dumpext";
	if (open(OUT, ">$filename.info")) {
	    print OUT $header;
	    close OUT;
	    $filename .= "$dumpext$compext";
	    if (open(OUT, ">$filename")) {
		my $buf;
		while (read(Client, $buf, 32*1024)) {
		    print OUT $buf;
		}
		close OUT;
		close Client;
	    } else {
		$taper->log_add("FATAL", "PORT-WRITE: can't open dump file $filename");
		exit 1;
	    }
	} else {
	    $taper->log_add("FATAL", "PORT-WRITE: can't open dump file $filename.info");
	    exit 1;
	}
    } else {
	$taper->log_add("FATAL", "PORT-WRITE: can't parse amanda header: '$header'");
	exit 1;
    }
    close Server;

    return $filename;
}

# Send an error message to every mail address in @mailto and exit. This is
# used to report errors that happen while burning the CD-RW
# (i.e. after the "QUIT" command) and can't be reported in a normal
# way.
sub error {
    my $taper = shift;
  my ($msg) = @_;
  # Report to STDERR anyway, maybe the driver is still logging.
  print STDERR "taper: ERROR: $msg\n";

  # Send the mail
  open(MAIL, "|".$taper->{SENDMAIL}." -t") or die "taper: Cannot send mail: $!";
  print MAIL "Subject: AMANDA CDRW-TAPER ERROR\n" or die "taper: Cannot send mai
l: $!";
  my $username = getpwuid($<);
  print MAIL "From: $username\n";
  foreach my $name (@{$taper->{AMANDA_CONF}->{mailto}}) {
    print MAIL "To: $name\n" or die "taper: Cannot send mail: $!";
  }
  print MAIL "\n" or die "taper: Cannot send mail: $!";
  print MAIL "$msg\n" or die "taper: Cannot send mail: $!";
  close MAIL or die "taper: Cannot send mail: $!";

  # Send the final acknowledge to the driver
  print "QUITTING";
  exit 1;
}

