#! /usr/bin/perl
###############################################################################
# The "mercury" program was written and packaged by Brian White <bcwhite@pobox.com>.
# It has been released in to the public domain (the only true "free").
###############################################################################

use IO::Handle;
use Fcntl;

$Debug	= 0;

$Port	= "/dev/mercury";
$Unit	= 0x80;
$Fifo	= "/var/run/mercury";
$Info	= "/etc/mercury";



###############################################################################



sub HashDump
{
	my($hash) = @_;
	my($key,$val);

	while (($key,$val) = each %$hash) {
		print "  $key  ->  $val\n" if ($Debug);
	}
}



sub Crc
{
	my($data,$crc) = @_;
	my($i,$c);

	foreach $c (split(//,$data)) {
		$crc ^= ord($c) << 8;
		for ($i=0; $i < 8; ++$i) {
			if (($crc ^ $c) & 0x8000) {
				$crc = ($crc << 1) ^ 0x1021;
			} else {
				$crc = ($crc << 1);
			}
		}
	}

	$crc &= 0x0000FFFF;
	return $crc;
}



sub OpenPort
{
	print "Opening port '$Port'...\n" if ($Debug);
	system "stty -F $Port 9600 cs8 raw -echo";
#	open(PORT,"+<$Port") || die "Error: could not open '$Port' -- $!\n";
	sysopen(PORT,$Port,O_RDWR|O_NDELAY|O_NOCTTY) || die "Error: could not open '$Port' -- $!\n";
	binmode(PORT);
	PORT->autoflush(1);
}



sub InfoMap
{
	my($slot,$name,$time,$orig) = @_;

	$name = undef unless ($name ne "");
	$time = 0	  unless ($time  >  0);

	delete $SlotName{$slot};
	delete $SlotTime{$slot};
	delete $SlotOrig{$slot};
	delete $NameSlot{$SlotName{$slot}};

	return unless (defined $name);

	$SlotName{$slot} = $name;
	$SlotTime{$slot} = $time;
	$SlotOrig{$slot} = $orig;
	$NameSlot{$name} = $slot;
}

sub InfoRead
{
	if (open(FILE,"<$Info")) {
		while (<FILE>) {
			chomp;
			s/\#.*$//;
			next if (m/^\s*$/);
			InfoMap(split(/\s+/));
		}
		close(FILE);
	}
}

sub InfoWrite
{
	if (open(FILE,">$Info")) {
		foreach (sort keys %SlotName) {
			print FILE "$_\t$SlotName{$_}\t$SlotTime{$_}\t$SlotOrig{$_}\n";
		}
		close(FILE);
	}
}



sub ReadBlock
{
	my($maxtime) = @_;
	my($block,$byte);

	local $abort = 0;
	local $SIG{ALRM} = sub { print "timeout\n" if ($Debug); $abort = 1; return; };
	local $/ = chr(0);

	$maxtime = 5 unless $maxtime;
	alarm($maxtime);
#	$block = <PORT>;
 	while (!$abort) {
		$amt = sysread(PORT,$byte,1);
		next if ($amt  == 0);
		$block .= $byte;
		printf "%02X ",ord($byte) if ($Debug);
		last if (ord($byte) == 0);
	}
	alarm(0);

	print "recv: $block\n" if ($Debug);
	return $block;
}

sub WriteBlock
{
	my($block) = @_;
	if ($Debug) {
		printf "%02X ",ord($_) foreach (split(//,$block));
	}
#	print PORT $block;
 	syswrite(PORT,$block,length($block));
	print "send: $block\n" if ($Debug);
}



sub ExtractResult
{
	my($block) = @_;
	my($crc,$zero);

	$block=~ s/(....)(.)$//;
	$crc  = $1;
	$zero = $2;

	return undef if (length($zero) != 1 || ord($zero) != 0);
	return undef if (Crc($block) != hex($crc));
	return undef unless ($block =~ m/^(.)(.)(..)(.*)$/);

	# return (ID, CODE, STAT, PARM)
	return (wantarray ? (ord($1)-64,ord($2),hex($3),$4) : hex($3));
}

sub CreateCommand
{
	my($id,$code,$parm) = @_;
	my($block);

	$block  = sprintf("%c%c%s",$id,$code,$parm);
	$block .= sprintf("%04X%c",Crc($block),0);
	return $block;
}



###############################################################################



sub ExecuteCommand
{
	my($unit,$code,$parm) = @_;
	my($cmd,$res,$rst,$runit,$rcode,$rstat,$rparm);

	$cmd = CreateCommand($unit,$code,$parm);
	WriteBlock($cmd); $res = ReadBlock();
	($runit,$rcode,$rstat,$rparm) = ExtractResult($res);
	printf "runit=%02X; rcode=%02X; rstat=%02X; rparm=%s\n",$runit,$rcode,$rstat,$rparm if ($Debug);

	if ($runit != $unit || $rcode != $code || !defined $rstat || ($rstat >= 0x30 && $rstat < 0x40)) {
		$rst = CreateCommand($unit,0x20,"00");
		WriteBlock($rst);
		ReadBlock(10);
		WriteBlock($cmd);
		$res = ReadBlock();
		($runit,$rcode,$rstat,$rparm) = ExtractResult($res);
	} elsif ($rstat == 0x42) { # medium changed -- try again
		WriteBlock($cmd); $res = ReadBlock();
		($runit,$rcode,$rstat,$rparm) = ExtractResult($res);
		printf "runit=%02X; rcode=%02X; rstat=%02X; rparm=%s\n",$runit,$rcode,$rstat,$rparm if ($Debug);
	}

	return (wantarray ? ($rstat,$rparm) : $rstat);
}



sub ExchangeMedium
{
	my($unit,$frst,$scnd) = @_;
	print "Sending 'exchange-medium' command...\n" if ($Debug);

	my $stat = ExecuteCommand($unit,0x25,$frst.$scnd);
	return $stat;
}

sub InitializeElementStatus
{
	my($unit) = @_;
	print "Sending 'initialize-element-status' command...\n" if ($Debug);

	my $stat = ExecuteCommand($unit,0x26);
	return $stat;
}

sub Inquiry
{
	my($unit) = @_;
	print "Sending 'inquiry' command...\n" if ($Debug);

	my($stat,$parm) = ExecuteCommand($unit,0x21);
	return if ($stat != 0x00);

	my($vi,$pi,$pr,$pd,$pn,$sn,$rf,$rd,$lp,$mc,$cc,$tc,$ps) =
		($parm =~ m/^(.{8})(.{16})(....)(.{8})(.{8})(.{12})(....)(.{8})(....)(..)(..)(..)(.*)$/);

	my @ps=();
	push @ps,$1 while ($ps =~ s/^(..)//);

	return (VendorIdent	=> $vi,
			ProductIdent=> $pi,
			ProductRev	=> $pr,
			ProductDate	=> $pd,
			PartNum		=> $pn,
			SerialNum	=> $sn,
			FirmwareVer	=> $rf,
			FirmwareDate=> $rd,
			IeElement	=> $lp,
			MagazineCnt	=> $mc,
			MediaCnt	=> $cc,
			TransferCnt	=> $tc,
			TransferPos	=> \@ps);
}

sub MoveMedium
{
	my($unit,$dst,$src) = @_;
	my($key,$val);

	$src = $NameSlot{$src} unless ($src =~ m/^\d{4}$/);
	$dst = $NameSlot{$SlotOrig{$src}} if (!$dst);
	$dst = $NameSlot{$dst} unless ($dst =~ m/^\d{4}$/);
	return 0x12 unless ($src ne "" && $dst ne "");
	return 0x12 if ($src eq "0000" || $dst eq "0000");
	return 0x12 if ($src =~ m/^00/ && $dst =~ m/^00/);
	return 0x12 if ($src !~ m/^00/ && $dst !~ m/^00/);
	return 0x12 if ($src =~ m/^00/ && $dst ne $NameSlot{$SlotOrig{$src}});

	# if source is already in another drive, move it out first
	while (($key,$val) = each %SlotOrig) {
		if ($val eq $SlotName{$src} && $dst =~ m/^00/) {
			return 0 if ($key eq $dst); # already there
			MoveMedium($unit,undef,$key);
			last;
		}
	}

	my $stat = ExecuteCommand($unit,0x24,$src.$dst);
	if ($stat == 0) {
		$SlotTime{$src} = 0;
		$SlotTime{$dst} = time();
		$SlotOrig{$dst} = $SlotName{$src} if ($dst =~ m/^00/);
		$SlotOrig{$src} = undef;
	}
	return $stat;
}

sub EjectMedium
{
	my($unit,$src) = @_;
	my $stat = ExecuteCommand($unit,0x24,$src."0000");
	if ($stat == 0) {
		$SlotTime{$src} = 0;
	}
	return $stat;
}

sub LoadMedium
{
	my($unit,$dst) = @_;
	my $stat = ExecuteCommand($unit,0x24,"0000".$dst);
	if ($stat == 0) {
		$SlotTime{$dst} = time();
	}
	return $stat;
}



###############################################################################


$Debug = 1 if ($ARGV[0] eq "--debug");

OpenPort();
InitializeElementStatus($Unit);
%inq = Inquiry($Unit);
#HashDump(\%inq);

InfoMap("0000","mailslot");
InfoMap("0001","drive1");
InfoMap("0002","drive2");
InfoMap("0003","drive3");
InfoMap("0004","drive4");
InfoRead();

unlink($Fifo);
system "mkfifo -m600 $Fifo";
die "Error: could not make FIFO '$Fifo'\n" if (! -p $Fifo);
close(STDIN);

$ejected="";
while (1) {
	open(STDIN,"<$Fifo") || die "Error: could not open '$Fifo' -- $!\n";
	$_=<STDIN>; chomp;
	print "\nCommand: $_\n\n" if ($Debug);
	@cmd = split(/\s+/);

	if ($cmd[0] eq "mount" && @cmd == 3) {
		MoveMedium($Unit,$cmd[2],$cmd[1]);
		InfoWrite();
	} elsif ($cmd[0] eq "umount" && @cmd == 2) {
		MoveMedium($Unit,undef,$cmd[1]);
		InfoWrite();
	} elsif ($cmd[0] eq "eject" && @cmd == 2) {
		if ($ejected eq $cmd[1]) {
			print STDERR "Error: mailslot is already open\n";
		} else {
			InfoMap($cmd[1]);
			EjectMedium($Unit,$cmd[1]);
			InfoWrite();
			$ejected=$cmd[1];
		}
	} elsif ($cmd[0] eq "load" && (@cmd == 2 || @cmd == 3)) {
		if ($ejected ne $cmd[1]) {
			EjectMedium($Unit,$cmd[1]);
			sleep(10);
		}
		LoadMedium($Unit,$cmd[1]);
		InfoMap($cmd[1],$cmd[2],time());
		InfoWrite();
		$ejected = "";
	} else {
		print STDERR "Error: Unknown command '@cmd'\n" if ($cmd ne "");
	}

	close(STDIN);
}
