Imported scanning tools

scan/scan

+#!/usr/bin/perl
+# Dump capabilities of a PJL/PS printer
+# (c) 2012-2015 Martin Mares <mj@ucw.cz>
+
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use Getopt::Long;
+use Digest::SHA;
+
+### Options ###
+
+my $verbose = 0;
+my $close = 0;
+my $s_all = 0;
+my $s_encodings = 0;
+my $s_iodev = 0;
+my $s_outdev = 0;
+my $s_pagedev = 0;
+my $s_pjl = 0;
+my $s_psfontnames = 0;
+my $s_psfonts = 0;
+my $s_psversion = 0;
+
+GetOptions(
+	"all" => sub {
+		$s_all =
+		$s_encodings =
+		$s_iodev =
+		$s_outdev =
+		$s_pagedev =
+		$s_pjl =
+		$s_psfonts =
+		$s_psversion = 1;
+	},
+	"encodings!" => \$s_encodings,
+	"iodev!" => \$s_iodev,
+	"outdev!" => \$s_outdev,
+	"pagedev!" => \$s_pagedev,
+	"pjl!" => \$s_pjl,
+	"psfontnames!" => \$s_psfontnames,
+	"psfonts!" => \$s_psfonts,
+	"psversion!" => \$s_psversion,
+	"verbose!" => \$verbose,
+	"close!" => \$close,
+) and @ARGV == 1 or die <<AMEN ;
+Usage: $0 [<options>] <hostname>
+
+Options:
+--all			Scan everything
+--encodings		Scan PS font encodings
+--iodev			Scan PS I/O device resources (disks)
+--outdev		Scan PS output device resources
+--pagedev		Scan PS page device attributes
+--pjl			Scan PJL capabilities
+--psfontnames		Scan PS font list, but report only names (to work around bugs)
+--psfonts		Scan PS font list
+--psversion		Scan PS interpreter version
+--verbose		Be verbose and dump all communication with the printer
+--close			Close connection after each scan to flush buffers
+AMEN
+
+my ($host) = @ARGV;
+my $port = 9100;
+
+### Low-level communication ###
+
+my $sk;
+my $ps_mode;
+
+sub sk_open() {
+	$sk = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp') or die "Cannot connect to $host:$port\n";
+	$sk->autoflush(1);
+}
+
+sub uel() {
+	print ">>> [UEL]\n" if $verbose;
+	$sk->print("\e%-12345X");	# Universal Exit Language
+	$ps_mode = 0;
+}
+
+sub tx($) {
+	my ($x) = @_;
+	print ">>> $x" if $verbose;
+	$sk->print($x);
+}
+
+sub need_connection() {
+	if (!$sk) {
+		sk_open();
+		uel();
+	}
+}
+
+sub raw_rx_until($) {
+	my ($until) = @_;
+	my @out = ();
+	while (<$sk>) {
+		chomp;
+		s/\r//g;
+		s/\f//g;
+		if (!@out) {
+			# Some printers (e.g., Xerox Phaser 3300) send binary garbage at the first line of output
+			s/^[\x80-\xff]*//;
+		}
+		print "<<< $_\n" if $verbose;
+		return \@out if /$until/;
+		push @out, $_;
+	}
+	die "Unexpected EOF\n";
+}
+
+sub rx_until($) {
+	my ($until) = @_;
+	if ($close) {
+		print ">>> [shutdown]\n";
+		$sk->shutdown(1);
+		my $out = raw_rx_until($until);
+		$sk->close;
+		undef $sk;
+		return $out;
+	} else {
+		return raw_rx_until($until);
+	}
+}
+
+sub out_raw($) {
+	my ($out) = @_;
+	print join("\n", @$out), "\n";
+}
+
+sub out_pjl($) {
+	my ($out) = @_;
+	print join("\n", grep { !/^\@PJL / } @$out), "\n";
+}
+
+# Passing dictionaries from the PS interpreter to us is a little bit tricky,
+# because values can span multiple lines. On the other hand, we would like
+# to avoid implementing a full PS lexer. So we let the PS code write "%K%"
+# before every dictionary key, and "%<<%" / "%>>%" at the beginning / end
+# of a subdictionary. Let us keep our finger crossed that these never appear
+# inside an actual value.
+sub parse_dict($);
+sub parse_dict($) {
+	my ($out) = @_;
+	if (!@$out) {
+		print STDERR "!!! Parse error: missing value !!!\n";
+		return;
+	}
+	if ($out->[0] eq '%<<%') {
+		shift @$out;
+		my %dict = ();
+		while (@$out && $out->[0] ne '%>>%') {
+			my $key = shift @$out;
+			$key =~ s/^%K% // or print STDERR "!!! Parse error: missing key marker !!!\n";
+			my $val = parse_dict($out);
+			$dict{$key} = $val;
+		}
+		shift @$out or print STDERR "!!! Parse error: truncated dictionary !!!\n";
+		return \%dict;
+	} else {
+		my $val = shift @$out;
+		while (@$out && $out->[0] !~ /^%/) { $val .= " " . shift @$out; }
+		return $val;
+	}
+}
+
+sub show_dict($;$);
+sub show_dict($;$) {
+	my ($dict, $indent) = @_;
+	$indent //= 0;
+	print "\t" x $indent, "<<\n";
+	for my $k (keys %$dict) {
+		print "\t" x $indent, $k;
+		my $v = $dict->{$k};
+		if (ref $v) {
+			print "\n";
+			show_dict($v, $indent + 1);
+		} else {
+			print " $v\n";
+		}
+	}
+	print "\t" x $indent, ">>\n";
+}
+
+sub out_dict($) {
+	my ($out) = @_;
+	show_dict(parse_dict($out));
+}
+
+### Scanners ###
+
+sub heading($) {
+	my ($h) = @_;
+	our $sections;
+	if ($s_all && $sections) { print "\n"; }
+	$sections++;
+	if ($s_all) { print "### $h ###\n\n"; }
+	print STDERR "Scanning $h\n";
+}
+
+sub scan_pjl() {
+	for my $pi ('ID', 'CONFIG', 'FILESYS', 'MEMORY', 'STATUS', 'VARIABLES', 'USTATUS') {
+		heading("PJL $pi");
+		tx("\@PJL INFO $pi\n");
+		tx("\@PJL ECHO BRUMBRUM\n");
+		my $out = raw_rx_until("BRUMBRUM");
+		out_pjl($out);
+	}
+}
+
+sub enter_ps() {
+	return if $ps_mode;
+	tx("\@PJL ENTER LANGUAGE = POSTSCRIPT\n");
+	tx( <<AMEN );
+/showdict {
+	(%<<%) =
+	{
+		exch
+		(%K% ) print ==
+		dup type /dicttype eq {
+			showdict
+		} {
+			==
+		} ifelse
+	} forall
+	(%>>%) =
+} def
+AMEN
+	$ps_mode = 1;
+}
+
+sub need_ps() {
+	need_connection();
+	enter_ps();
+}
+
+sub scan_psversion() {
+	heading("PS interpreter version");
+	need_ps();
+	tx("version == revision == (%END%) = flush\n");
+	my $ver = rx_until("%END%");
+	print join(" ", @$ver), "\n";
+}
+
+sub scan_pagedev() {
+	heading("PS page device parameters");
+	need_ps();
+	tx("currentpagedevice showdict (%END%) = flush\n");
+	my $dict = rx_until("%END");
+	out_dict($dict);
+}
+
+sub scan_iodev() {
+	heading("PS IODevice resources");
+	need_ps();
+	tx( <<AMEN );
+(%<<%) =
+(*) {
+	(%K% ) print dup ==
+	currentdevparams showdict
+} 100 string /IODevice resourceforall
+(%>>%) =
+(%END%) = flush
+AMEN
+	out_dict(rx_until("%END"));
+}
+
+sub scan_outdev() {
+	heading("PS OutputDevice resources");
+	need_ps();
+	tx( <<AMEN );
+(%<<%) =
+(*) {
+	dup (%K% ) print ==
+	cvn /OutputDevice findresource showdict
+} 100 string /OutputDevice resourceforall
+(%>>%) =
+(%END%) = flush
+AMEN
+	my $odev = rx_until("%END%");
+	out_dict($odev);
+}
+
+sub enc_hash($) {
+	my ($enc) = @_;
+	$enc =~ s/\s+/ /g;
+	$enc =~ s/^\s+//;
+	$enc =~ s/\s+$//;
+	$enc =~ s/\s+]/]/g;
+	return Digest::SHA::sha1_hex($enc);
+}
+
+my %standard_encodings = (
+	"8c632b694bb2e83c602d9ba52b493547e4bc3942" => "Standard",
+	"cb31968b0a33bf362c50ffb2e852a9eabdadb7c7" => "ISOLatin1",
+	# All other encodings are reported as Special
+	# We do not know hashes for Expert encoding mentioned in PPD standard
+);
+
+sub scan_psfonts() {
+	heading("PS Font resources");
+	need_ps();
+	tx( <<AMEN );
+(%<<%) =
+(*) {
+	(%K% ) print dup ==
+	(%<<%) =
+	save exch
+	findfont
+	% Parse FontInfo and find version
+	dup /FontInfo get
+		(%K% /Version) =
+		dup /Version known { dup /Version get == } {
+			dup /version known { dup /version get == } {
+				(???) ==
+			} ifelse
+		} ifelse
+		pop
+	% Print Encoding
+	(%K% /Encoding) =
+	dup /Encoding known { dup /Encoding get == } { (???) == } ifelse
+	% We are done with the font
+	pop restore
+	(%>>%) = flush	% Flush to avoid buffer management bugs on Xerox Phaser 3300
+} 100 string /Font resourceforall
+(%>>%) =
+(%END%) = flush
+AMEN
+	my $fonts = parse_dict(rx_until("%END%"));
+	if ($verbose) {
+		show_dict($fonts);
+		print "\n";
+	}
+
+	for my $f (sort keys %$fonts) {
+		my $g = $fonts->{$f};
+		my $ehash = enc_hash($g->{'/Encoding'});
+		my $fname = $f;
+		$fname =~ s/[()]//g;
+		my $ename = $standard_encodings{$ehash} // "Special";
+		print "# encoding hash: $ehash\n" if $verbose;
+		print "*Font $fname: ", $ename, " \"", $g->{'/Version'}, "\" ", $ename, " ROM\n";
+	}
+}
+
+sub scan_psfontnames() {
+	heading("PS Font resource list");
+	need_ps();
+	tx( <<AMEN );
+(*) { == } 100 string /Font resourceforall
+(%END%) = flush
+AMEN
+	out_raw(rx_until("%END"));
+}
+
+sub scan_encodings() {
+	heading("PS Encoding resources");
+	need_ps();
+	tx( <<AMEN );
+(%<<%) =
+(*) {
+	(%K% ) print dup ==
+	/Encoding findresource ==
+} 100 string /Encoding resourceforall
+(%>>%) =
+(%END%) = flush
+AMEN
+	my $encs = parse_dict(rx_until("%END%"));
+	for my $e (keys %$encs) {
+		my $array = $encs->{$e};
+		print "$e ", enc_hash($array), " ", $array, "\n";
+	}
+}
+
+### Main ###
+
+print STDERR "Connecting\n";
+sk_open();
+
+uel();
+print STDERR "Testing communication\n";
+tx("\@PJL ECHO BRUMBRUM\n");
+raw_rx_until("BRUMBRUM");
+
+scan_pjl() if $s_pjl;
+
+scan_psversion() if $s_psversion;
+scan_pagedev() if $s_pagedev;
+scan_outdev() if $s_outdev;
+scan_iodev() if $s_iodev;
+scan_psfonts() if $s_psfonts;
+scan_psfontnames() if $s_psfontnames;
+scan_encodings() if $s_encodings;
+
+print STDERR "Done\n";
+uel() if $sk;

scan/show-snmp

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::SNMP;
+
+my $host = $ARGV[0] or die "Usage: $0 <host>\n";
+
+print "Scanning $host...\n";
+
+my $sess = Net::SNMP->session(
+	-hostname => $host . '.kam.hide.ms.mff.cuni.cz',
+	-version => 1,
+	-community => 'public',
+) or die;
+
+my $prmib = '1.3.6.1.2.1.43';
+
+sub parse_table($) {
+	my $raw = $sess->get_table(-baseoid => $_[0]) or return {};
+
+	my %tab = ();
+	for my $bb (keys %$raw) {
+		my $bk = substr($bb, length($_[0]) + 1);
+		$bk =~ /(.*)\.1\.(\d+)/ or die "OID parse error at $bk";
+		$tab{$2}{$1} = $raw->{$bb};
+	}
+
+	return \%tab;
+}
+
+sub media_unit($) {
+	my ($unit) = @_;
+	return unless defined $unit;
+	return 25.4 / 10000 if $unit == 3;
+	return 0.001 if $unit == 4;
+	return 1 if $unit == 0;		# Some printers (Xerox 3300MFP) send unit 0 -- what does it mean?
+	die "Unknown media unit $unit\n";
+}
+
+sub subunit_status($) {
+	my ($s) = @_;
+	my @bases = ('Idle', 'OnReq', 'Standby', 'Broken', 'Active', 'Unknown', 'Busy', '??7??');
+	my $base = $bases[$s & 7];
+	if ($s & 8) { $base .= '/Alert'; }
+	if ($s & 16) { $base .= '/CritAlert'; }
+	if ($s & 32) { $base .= '/Offline'; }
+	if ($s & 64) { $base .= '/Transition'; }
+	return $base;
+}
+
+sub current($) {
+	my ($c) = @_;
+	return "other" if $c == -2;
+	return "unknown" if $c == -2;
+	return "OK" if $c == -3;
+	return "???" if $c < 0;
+	return $c;
+}
+
+print "\n### Inputs ###\n";
+my $ins = parse_table("$prmib.8.2.1");
+for my $i (sort keys %$ins) {
+	my $b = $ins->{$i};
+	printf "%-10s ", ($b->{13} // "Input #$i");
+	my $unit = media_unit($b->{3});
+	print join("x", map { (!defined($_) || $_ < 0) ? '?' : sprintf("%.0f", $_*$unit) } ($b->{4}, $b->{5}));
+	print " capa=", $b->{9};
+	print " cur=", current($b->{10});
+	print " stat=", subunit_status($b->{11});
+	print " media=", $b->{12};
+	print "\n";
+}
+
+print "\n### Outputs ###\n";
+my $outs = parse_table("$prmib.9.2.1");
+for my $i (sort keys %$outs) {
+	my $b = $outs->{$i};
+	printf "%-10s ", ($b->{7} // "Output #$i");
+	my $unit = media_unit($b->{14});
+	print join("x", map { (!defined($_) || $_ < 0) ? '?' : sprintf("%.0f", $_*$unit) } ($b->{15}, $b->{16}));
+	print " capa=", $b->{4};
+	print " remains=", current($b->{5});
+	print " stat=", subunit_status($b->{6});
+	print "\n";
+}
+
+print "\n### Marker ###\n";
+my $mkrs = parse_table("$prmib.10.2.1");
+my $mkr = $mkrs->{1};	# Multiple markers not supported by this simple-minded script
+$mkr->{3} == 7 or die "Unknown marker counter unit " . $mkr->{3};
+print "Life counter: ", $mkr->{4}, "\n";
+my $mmu = media_unit($mkr->{8});
+print "Resolution: ", join("x", map {
+	sprintf("%.0f", $_ / (10000*$mmu) * 25.4);
+} ($mkr->{9}, $mkr->{10})), " DPI\n";
+print "Margins: ", join("/", map { sprintf("%.2f", $_*$mmu) } ($mkr->{11}, $mkr->{12}, $mkr->{13}, $mkr->{14})), " mm\n";
+print "Status: ", subunit_status($mkr->{15}), "\n";
+
+print "\n### Colorants ###\n";
+my $colors = parse_table("$prmib.12.1.1");
+my %clrants = ();
+for my $i (sort keys %$colors) {
+	my $c = $colors->{$i};
+	print "Color $i: ", $c->{4}, "\n";
+	$clrants{$i} = $c->{4};
+}
+
+my %supply_types = (
+	1 => 'other',
+	2 => 'unknown',
+	3 => 'toner',
+	4 => 'wasteToner',
+	5 => 'ink',
+	6 => 'inkCartridge',
+	7 => 'inkRibbon',
+	8 => 'wasteInk',
+	9 => 'opc',
+	10 => 'developer',
+	11 => 'fuserOil',
+	12 => 'solidWax',
+	13 => 'ribbonWax',
+	14 => 'wasteWax',
+	15 => 'fuser',
+	16 => 'coronaWire',
+	17 => 'fuserOilWick',
+	18 => 'cleanerUnit',
+	19 => 'fuserCleaningPad',
+	20 => 'transferUnit',
+	21 => 'tonerCartridge',
+	22 => 'fuserOiler',
+	23 => 'water',
+	24 => 'wasteWater',
+	25 => 'glueWaterAdditive',
+	26 => 'wastePaper',
+	27 => 'bindingSupply',
+	28 => 'bandingSupply',
+	29 => 'stitchingWire',
+	30 => 'shrinkWrap',
+	31 => 'paperWrap',
+	32 => 'staples',
+	33 => 'inserts',
+	34 => 'covers'
+);
+
+print "\n### Supplies ###\n";
+my $supp = parse_table("$prmib.11.1.1");
+for my $i (sort { $a <=> $b } keys %$supp) {
+	my $s = $supp->{$i};
+	printf "%2d: ", $i;
+	printf "%-16s", ($supply_types{$s->{5}} // "??" . $s->{4} . "??");
+	printf "%-8s", $s->{3} ? ($clrants{$s->{3}} // "Color" . $s->{3}) : "---";
+	printf "%-16s", (current($s->{9}) . "/" . $s->{8});
+	if ($s->{8} && $s->{9} >= 0) {
+		printf " %3.0f%%", $s->{9} * 100 / $s->{8};
+	} else {
+		print " ----";
+	}
+	print "  ", $s->{6};
+	print "\n";
+}
+
+print "\n### Console ###\n";
+my $con = parse_table("$prmib.16.5.1");
+for my $i (sort keys %$con) {
+	print "$i:", $con->{$i}->{2}, "\n" if $con->{$i}->{2} =~ /\S/;
+}
+
+print "\n### Lights ###\n";
+my $lights = parse_table("$prmib.17.6.1");
+for my $i (sort keys %$lights) {
+	my $l = $lights->{$i};
+	my %color = ( 1=>'other', 2=>'unkn', 3=>'white', 4=>'red', 5=>'green', 6=>'blue', 7=>'cyan', 8=>'mgnta', 9=>'yellw', 10=>'ornge' );
+	if ($l->{2} && !$l->{3}) { print "[*]"; }
+	elsif (!$l->{2} && $l->{3}) { print "[ ]"; }
+	elsif ($l->{2} && $l->{3}) { print "[.]"; }
+	else { print "[?]"; }
+	printf " %5s", $color{$l->{4}} // "?????";
+	print "  ", $l->{5};
+	print "\n";
+}
+
+print "\n### Alerts ###\n";
+my $alerts = parse_table("$prmib.18.1.1");
+for my $i (sort keys %$alerts) {
+	my $a = $alerts->{$i};
+	print "$i:";
+	my %severity = ( 1=>'other', 2=>'CRIT', 3=>'WARN', 4=>'WARN' );
+	print " sev=", $severity{$a->{2}} // "???";
+	my %training = ( 6=>'management', 5=>'service', 4=>'trained', 3=>'untrained', 2=>'unknown', 1=>'other' );
+	print " who=", $training{$a->{3}} // "???";
+	print " group=", $a->{4};
+	print " index=", $a->{5};
+	print " loc=", $a->{6};
+	print " code=", $a->{7};
+	print " desc=", $a->{8};
+	print " time=", $a->{9};
+	print "\n";
+}
+
+print "\n### Finisher ###\n";
+my $finisher = parse_table("$prmib.30.1.1");
+for my $i (sort keys %$finisher) {
+	my $f = $finisher->{$i};
+	print "$i:";
+	print " type=", $f->{2};
+	print " present=", $f->{3};
+	print " capa=", $f->{5};
+	print " current=", current($f->{6});
+	print " status=", subunit_status($f->{9});
+	print " desc=", $f->{10};
+	print "\n";
+}
+
+print "\n### Finisher supplies ###\n";
+my $fsu = parse_table("$prmib.31.1.1");
+for my $i (sort keys %$fsu) {
+	my $f = $fsu->{$i};
+	print "$i:";
+	print " dev=", $f->{2};
+	print " class=", $f->{3};
+	print " type=", $f->{4};
+	print " desc=", $f->{5};
+	print " capa=", $f->{7};
+	print " current=", current($f->{8});
+	print "\n";
+}