diff --git a/scan/scan b/scan/scan new file mode 100755 index 0000000000000000000000000000000000000000..c74599a785a466cea974cab4f9e765b939a9a8cd --- /dev/null +++ b/scan/scan @@ -0,0 +1,398 @@ +#!/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; diff --git a/scan/show-snmp b/scan/show-snmp new file mode 100755 index 0000000000000000000000000000000000000000..987032c00d523211c17e97ca27bf63afcaa52e95 --- /dev/null +++ b/scan/show-snmp @@ -0,0 +1,228 @@ +#!/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"; +}