#!/usr/bin/perl -w
#
# (c) 2001-2005  Rudolf Cejka <cejkar@fit.vutbr.cz>
#
# $Id: m2,v 0.27 2005/06/21 14:27:27 bacula Exp $
#

use strict;
use Math::BigInt;
use Getopt::Std;

sub DEFAULTDEV () { "sa0.ctl" }

sub CAMCONTROL () { "/sbin/camcontrol" }

sub TRUE () { 1 }
sub FALSE () { 0 }

sub LOG_SENSE_10 () { 1 }
sub MODE_SENSE_6 () { 2 }

my $prog;
($prog = $0) =~ s/.*\///;

sub usage()
{
	printf STDERR <<"END", $prog, DEFAULTDEV;
Usage: %s [-d device] [-p pages|-r|-R] [-x]
    -d device   Queried device (default "%s")
    -p pages    Print supported pages (p), write errors (w), read errors (r),
                tape alerts (a), tape history (h), data compression (c), drive
                usage (u), drive temperature (t) (default: pwrahcut - all)
    -r          Reset cumulative values
    -R          Reset cumulative values and threshold values with comparison
    -x          Display compression information on Exabyte 8505XL
END
}

sub error($)
{
	die "$prog: $_[0]\n";
}

sub encode_shell($)
{
	my $str = $_[0];
	if (defined($str)) {
		$str =~ s/([`"\$\\])/\\$1/g;
	} else {
		$str = "";
	}
	return "\"" . $str . "\"";
}

sub cdb_mode_sense_6($$$)
{
	my ($pagecode, $pc, $size) = @_;
	return sprintf "1a 8 %x 0 %x 0",
	    (($pc & 0x03) << 6) | ($pagecode & 0x3F),
	    $size & 0xFF;
}

sub cdb_log_sense_10($$$)
{
	my ($pagecode, $pc, $size) = @_;
	return sprintf "4d 0 %x 0 0 0 0 %x %x 0",
	    (($pc & 0x03) << 6) | ($pagecode & 0x3F),
	    ($size >> 8) & 0xFF, $size & 0xFF;
}

sub cdb_parameter_reset10($)
{
	my ($hard) = @_;
	return ($hard) ? "4c 2 0 0 0 0 0 0 0 0" : "4c 0 c0 0 0 0 0 0 0 0";
}

sub WD () { 32 }	# Item width: C => 8, n => 16, N => 32
sub BL () { 512 }	# Block read size

sub call($)
{
	my $r = "";
	open(FH, $_[0] . " |")
	    or error("open(): Execute error");
	while (read(FH, $r, BL, length($r))) { }
	close(FH)
	    or error("close(): Execute error");
	return unpack("N*", $r);
}

sub query($$$$)
{
	my ($device, $type, $pagecode, $pc) = @_;
	my ($cdb, $size);
	if ($type eq LOG_SENSE_10) {
		$size = 511;
		$cdb = cdb_log_sense_10($pagecode, $pc, $size);
	} elsif ($type eq MODE_SENSE_6) {
		$size = 255;
		$cdb = cdb_mode_sense_6($pagecode, $pc, $size);
	} else {
		return ();
	}
	return call(CAMCONTROL . " cmd " . encode_shell($device)
	    . " -v -c \"" . $cdb . "\" -i " . $size . " -");
}

sub parameter_reset($$)
{
	my ($device, $hard) = @_;
	call(CAMCONTROL . " cmd " . encode_shell($device)
	    . " -v -c \"" . cdb_parameter_reset10($hard) . "\"");
}

sub get_mask($)
{
	return (($_[0] < WD) ? 1 << $_[0] : 0) - 1;
}

sub get_bits($$$$)
{
	my ($data, $ofs, $len, $signed) = @_;
	my ($i, $j, $f, $l, $r, $tmp);
	
	if ($ofs < 0 || $len < 0 || $len > 64
	    || $ofs + $len > scalar(@$data) * WD) {
		return undef;
	}
	$f = TRUE;
	while ($len > 0) {
		$l = WD - ($ofs % WD);
		if ($l > $len) {
			$r = $l - $len;
			$l = $len;
		} else {
			$r = 0;
		}
		if ($f) {
			$i = new Math::BigInt(($signed && ((@$data[$ofs / WD]
			    >> ($r + $l - 1)) & 1) != 0) ? -1 : 0);
			$f = FALSE;
		}
		$i *= 2 ** $l;
		$tmp = (@$data[$ofs / WD] >> $r) & get_mask($l);
		$i += $tmp;
		$len -= $l;
		$ofs += $l;
	}
	($i = "$i") =~ s/^\+//;
	return $i;
}

sub get_value($$$@)
{
	my ($data, $pos, $code, @items) = @_;
	my ($p, $c, $l, $i, $s, @r);
	$p = $$pos * 8;
	$c = get_bits($data, $p, 16, FALSE);
	$l = get_bits($data, $p + 24, 8, FALSE);
	$p += 32;
	@r = ();
	$s = 0;
	if (scalar(@items) < 1) {
		@items = ($l);
	}
	while (defined($i = shift(@items))) {
		if ($code == -1) {
			push(@r, $c, $i, get_bits($data, $p, $i * 8, FALSE));
		} elsif ($code == $c) {
			push(@r, $i, get_bits($data, $p, $i * 8, FALSE));
		} else {
			push(@r, $i, "Unexpected code $c instead of $code");
		}
		$p += $i * 8;
		$s += $i;
	}
	if ($s != $l) {
		$i = ($code == -1) ? 2 : 1;
		while ($i < scalar(@r)) {
			$r[$i] = "Unexpected length $s instead of $l";
			$i += ($code == -1) ? 3 : 2;
		}
	}
	$$pos += $l + 4;
	return @r;
}

sub get_log_sense_page_code($)
{
	my ($data) = @_;
	return get_bits($data, 2, 6, FALSE);
}

sub get_mode_sense_page_code($)
{
	my ($data) = @_;
	return get_bits($data, 34, 6, FALSE);
}

sub get_log_sense_length($)
{
	my ($data) = @_;
	my $l_data = get_bits($data, 16, 16, FALSE);
	if (defined($l_data)) {
		return 4 + $l_data;
	} else {
		return 0;
	}
}

sub get_mode_sense_length($)
{
	my ($data) = @_;
	my $l_data = get_bits($data, 0, 8, FALSE);
	if (defined($l_data)) {
		return 1 + $l_data;
	} else {
		return 0;
	}
}

sub print_log_sense_binary(@)
{
	my ($l_data, $n, $c, $b);
	printf "\nBinary dump (%02Xh):\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	$l_data = get_log_sense_length(\@_);
	$c = 0;
	for ($n = 0; $n < $l_data; $n++) {
		$b = get_bits(\@_, $n * 8, 8, FALSE);
		printf "%s%02x",
		    ($c == 0) ? "" : (($c % 8 == 0) ? "\n" : " "), $b;
		$c++;
	}
	if ($c > 0) {
		print "\n";
	}
}

sub print_mode_sense_binary(@)
{
	my ($l_data, $n, $c, $b);
	printf "\nBinary dump (%02Xh):\n",
	    get_mode_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	$l_data = get_mode_sense_length(\@_);
	$c = 0;
	for ($n = 0; $n < $l_data; $n++) {
		$b = get_bits(\@_, $n * 8, 8, FALSE);
		printf "%s%02x",
		    ($c == 0) ? "" : (($c % 8 == 0) ? "\n" : " "), $b;
		$c++;
	}
	if ($c > 0) {
		print "\n";
	}
}

sub get_pages(@)
{
	my ($l_data, $n, @result);
	$l_data = get_log_sense_length(\@_);
	for ($n = 4; $n < $l_data; $n++) {
		push(@result, get_bits(\@_, $n * 8, 8, FALSE));
	}
	return @result;
}

sub print_log_sense_pages(@)
{
	my ($c, $b);
	printf "\nSupported pages (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Supported pages (%d):\t\t\t", scalar(@_);
	$c = 0;
	foreach $b (@_) {
		printf "%s%02Xh",
		    ($c == 0) ? "" : (($c % 16 == 0) ? "\n" : " "), $b;
		$c++;
	}
	if ($c > 0) {
		print "\n";
	}
}

sub print_log_sense_write_errors(@)
{
	my $p = 4;
	printf "\nWrite Error Counters Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Total Rewrites (%d):\t\t\t%s blocks\n",
	    get_value(\@_, \$p, 2);
	printf "Total Errors Corrected (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 3);
	printf "Total Times Errors Processed (%d):\t%s times\n",
	    get_value(\@_, \$p, 4);
	printf "Total Bytes Processed (%d):\t\t%s bytes\n",
	    get_value(\@_, \$p, 5);
	printf "Total Unrecoverable Errors (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 6);
}

sub print_log_sense_read_errors(@)
{
	my $p = 4;
	printf "\nRead Error Counters Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Total Rereads (%d):\t\t\t%s blocks\n",
	    get_value(\@_, \$p, 2);
	printf "Total Errors Corrected (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 3);
	printf "Total Times Errors Processed (%d):\t%s times\n",
	    get_value(\@_, \$p, 4);
	printf "Total Bytes Processed (%d):\t\t%s bytes\n",
	    get_value(\@_, \$p, 5);
	printf "Total Unrecoverable Errors (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 6);
}

sub print_log_sense_alert(@)
{
	my $p = 4;
	my (@x, $i);
	printf "\nTape Alert Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Read - warning (%d):\t\t\t%s\n",
	    get_value(\@_, \$p, 1);
	printf "Write - warning (%d):\t\t\t%s\n",
	    get_value(\@_, \$p, 2);
	printf "Hard Error - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 3);
	printf "Media - critical (%d):\t\t\t%s\n",
	    get_value(\@_, \$p, 4);
	printf "Read Failure - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 5);
	printf "Write Failure - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 6);
	printf "Media Life - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 7);
	printf "Not Data Grada - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 8);
	printf "Write Protect - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 9);
	printf "No Removal - informational (%d):\t\t%s\n",
	    get_value(\@_, \$p, 10);
	printf "Cleaning Media - informational (%d):\t%s\n",
	    get_value(\@_, \$p, 11);
	printf "Unsupported Format - informational (%d):\t%s\n",
	    get_value(\@_, \$p, 12);
	printf "Snapped Tape - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 13);
	foreach $i (14 .. 19) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Unassigned Read/Write (%d):\t\t%s\n", @x;
		}
	}
	printf "Clean Now - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 20);
	printf "Clean Periodic - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 21);
	printf "Expired Cleaning Media - critical (%d):\t%s\n",
	    get_value(\@_, \$p, 22);
	foreach $i (23 .. 29) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Unassigned Cleaning (%d):\t\t%s\n", @x;
		}
	}
	printf "Hardware A - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 30);
	printf "Hardware B - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 31);
	printf "Interface - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 32);
	printf "Eject Media - critical (%d):\t\t%s\n",
	    get_value(\@_, \$p, 33);
	printf "Download Fail - warning (%d):\t\t%s\n",
	    get_value(\@_, \$p, 34);
	foreach $i (35 .. 39) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Unassigned Hardware (%d):\t\t%s\n", @x;
		}
	}
	foreach $i (40 .. 49) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Library Error (%d):\t\t\t%s\n", @x;
		}
	}
	foreach $i (50 .. 64) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Unassigned (%d):\t\t\t\t%s\n", @x;
		}
	}
}

sub print_log_sense_history(@)
{
	my $p = 4;
	printf "\nTape History Log Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Tape ID (%d):\t\t\t\t%s\n",
	    get_value(\@_, \$p, 1);
	printf "Current Blocks Written (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 2);
	printf "Current Blocks Rewritten (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 3);
	printf "Current Blocks Read (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 4);
	printf "Current Blocks ECC'd (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 5);
	printf "Current Write Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 6);
	printf "Current Read Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 7);
	printf "Current Tracking Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 8);
	printf "Current Data Underruns (%d):\t\t%s underruns\n",
	    get_value(\@_, \$p, 9);
	printf "Current Data Overruns (%d):\t\t%s overruns\n",
	    get_value(\@_, \$p, 10);
	printf "Current Rewinds (%d):\t\t\t%s rewinds\n",
	    get_value(\@_, \$p, 11);
	printf "Current Max Temperature (%d):\t\t%s *C\n",
	    get_value(\@_, \$p, 12);
	printf "Current Drive Serial Number (%d):\t%s\n",
	    get_value(\@_, \$p, 13);
	printf "Previous Blocks Written (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 14);
	printf "Previous Blocks Rewritten (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 15);
	printf "Previous Blocks Read (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 16);
	printf "Previous Blocks ECC'd (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 17);
	printf "Previous Write Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 18);
	printf "Previous Read Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 19);
	printf "Previous Tracking Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 20);
	printf "Previous Data Underruns (%d):\t\t%s underruns\n",
	    get_value(\@_, \$p, 21);
	printf "Previous Data Overruns (%d):\t\t%s overruns\n",
	    get_value(\@_, \$p, 22);
	printf "Previous Rewinds (%d):\t\t\t%s rewinds\n",
	    get_value(\@_, \$p, 23);
	printf "Previous Max Temperature (%d):\t\t%s *C\n",
	    get_value(\@_, \$p, 24);
	printf "Previous Drive Serial Number (%d):\t%s\n",
	    get_value(\@_, \$p, 25);
	printf "Lifetime Blocks Written (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 26);
	printf "Lifetime Blocks Rewritten (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 27);
	printf "Lifetime Blocks Read (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 28);
	printf "Lifetime Blocks ECC'd (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 29);
	printf "Lifetime Write Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 30);
	printf "Lifetime Read Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 31);
	printf "Lifetime Tracking Retries (%d):\t\t%s retries\n",
	    get_value(\@_, \$p, 32);
	printf "Lifetime Data Underruns (%d):\t\t%s underruns\n",
	    get_value(\@_, \$p, 33);
	printf "Lifetime Data Overruns (%d):\t\t%s overruns\n",
	    get_value(\@_, \$p, 34);
	printf "Lifetime Rewinds (%d):\t\t\t%s rewinds\n",
	    get_value(\@_, \$p, 35);
	printf "Lifetime Max Temperature (%d):\t\t%s *C\n",
	    get_value(\@_, \$p, 36);
	printf "Lifetime Load Count (%d):\t\t%s loads\n",
	    get_value(\@_, \$p, 37);
	printf "Lifetime Maximum Tape Pass Count (%d):\t%s passes\n",
	    get_value(\@_, \$p, 38);
	printf "Lifetime SmartClean Cycles (%d):\t\t%s cycles\n",
	    get_value(\@_, \$p, 39);
}

sub print_log_sense_compression(@)
{
	my $p = 4;
	my (@x, @y);
	printf "\nData Compression Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Data Transferred to Compressor (%d):\t%s KB\n",
	    @x = get_value(\@_, \$p, 5);
	printf "Data Transferred to Tape (%d):\t\t%s KB\n",
	    @y = get_value(\@_, \$p, 7);
	if ($x[1] != 0 && $y[1] != 0) {
		printf "Compression Ratio (-):\t\t\t%.2f\n",
		    $x[1] / $y[1];
	}
}

sub print_mode_sense_compression(@)
{
	my ($x, $y, $w, $n);
	printf "\nData Compression Page (%02Xh)\n",
	    get_mode_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	$w = 5; $n = 256 ** $w - 1;
	$x = get_bits(\@_, 7 * 8, $w * 8, FALSE); if ($x == $n) { $x = 0; }
	$y = get_bits(\@_, 12 * 8, $w * 8, FALSE); if ($y == $n) { $y = 0; }
	printf "Total Bytes Received (%d):\t\t%s bytes\n", $w, $x;
	printf "Total Bytes Written (%d):\t\t%s bytes\n", $w, $y;
	if ($y != 0) {
		printf "Compression Ratio (-):\t\t\t%.2f\n",
		    $x / $y;
	}
}

sub print_log_sense_drive_usage(@)
{
	my $p = 4;
	my (@x, $i);
	printf "\nDrive Usage Information Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Total Blocks Written (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 1);
	printf "Total Blocks Rewritten (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 2);
	printf "Total Blocks Read (%d):\t\t\t%s blocks\n",
	    get_value(\@_, \$p, 3);
	printf "Total ECC Corrections (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 4);
	printf "Total Blocks Reread (%d):\t\t%s blocks\n",
	    get_value(\@_, \$p, 5);
	printf "Total Load Count (%d):\t\t\t%s cycles\n",
	    get_value(\@_, \$p, 6);
	printf "Minutes Since Last Clean (%d):\t\t%s minutes\n",
	    get_value(\@_, \$p, 7);
	printf "Minutes of Powered Time (%d):\t\t%s minutes\n",
	    get_value(\@_, \$p, 8);
	printf "Minutes of Tensioned Time (%d):\t\t%s minutes\n",
	    get_value(\@_, \$p, 9);
	printf "Cleaning Count (%d):\t\t\t%s cycles\n",
	    get_value(\@_, \$p, 10);
	foreach $i (11 .. 16) {
		if ((@x = get_value(\@_, \$p, $i))[1] ne "0") {
			printf "Vendor Unique (%d):\t\t\t%s\n", @x;
		}
	}
	printf "Time to Clean (%d):\t\t\t%s\n",
	    get_value(\@_, \$p, 17);
	if ((@x = get_value(\@_, \$p, 18))[1] ne "0") {
		printf "Vendor Unique (%d):\t\t\t%s\n", @x;
	}
	if ((@x = get_value(\@_, \$p, 19))[1] ne "0") {
		printf "reserved (%d):\t\t\t\t%s\n", @x;
	}
	if ((@x = get_value(\@_, \$p, 20))[1] ne "0") {
		printf "reserved (%d):\t\t\t\t%s\n", @x;
	}
}

sub print_log_sense_temperature(@)
{
	my $p = 4;
	printf "\nDrive Temperature Page (%02Xh)\n",
	    get_log_sense_page_code(\@_);
	print "=" x 40 . "\n\n";
	printf "Drive Temperature (%d):\t\t\t%s *C\n",
	    get_value(\@_, \$p, 1);
}

sub is($$)
{
	my ($optlist, $opt) = @_;
	return !defined($optlist) || index($optlist, $opt) >= 0;
}

# main()

my (@pages, $dev, %o);

if (!getopts("?hd:p:rRx", \%o)) {
	usage();
	exit;
}

$dev = (defined($o{"d"})) ? $o{"d"} : DEFAULTDEV;

if (defined($o{"?"}) || defined($o{"h"})) {
	usage();
	exit;
} elsif (defined($o{"R"})) {
	parameter_reset($dev, TRUE);
	exit;
} elsif (defined($o{"r"})) {
	parameter_reset($dev, FALSE);
	exit;
}

@pages = get_pages(query($dev, LOG_SENSE_10, 0, 1));
if (is($o{"p"}, "p")) {
	print_log_sense_pages(@pages);
}
if (grep($_ == 2, @pages) > 0 && is($o{"p"}, "w")) {
	print_log_sense_write_errors(query($dev, LOG_SENSE_10, 2, 1));
}
if (grep($_ == 3, @pages) > 0 && is($o{"p"}, "r")) {
	print_log_sense_read_errors(query($dev, LOG_SENSE_10, 3, 1));
}
if (grep($_ == 46, @pages) > 0 && is($o{"p"}, "a")) {
	print_log_sense_alert(query($dev, LOG_SENSE_10, 46, 1));
}
if (grep($_ == 53, @pages) > 0 && is($o{"p"}, "h")) {
	print_log_sense_history(query($dev, LOG_SENSE_10, 53, 1));
}
if (grep($_ == 57, @pages) > 0 && is($o{"p"}, "c")) {
	print_log_sense_compression(query($dev, LOG_SENSE_10, 57, 1));
} elsif ($o{"x"} && is($o{"p"}, "c")) {
	print_mode_sense_compression(query($dev, MODE_SENSE_6, 34, 0));
}
if (grep($_ == 60, @pages) > 0 && is($o{"p"}, "u")) {
	print_log_sense_drive_usage(query($dev, LOG_SENSE_10, 60, 1));
}
if (grep($_ == 62, @pages) > 0 && is($o{"p"}, "t")) {
	print_log_sense_temperature(query($dev, LOG_SENSE_10, 62, 1));
}
print "\n";