diff options
| -rwxr-xr-x | dell1600n-net-scan.pl | 1551 |
1 files changed, 1551 insertions, 0 deletions
diff --git a/dell1600n-net-scan.pl b/dell1600n-net-scan.pl new file mode 100755 index 0000000..2d0fec1 --- /dev/null +++ b/dell1600n-net-scan.pl @@ -0,0 +1,1551 @@ +#!/usr/bin/perl -w + +# Perl hack to do network scanning using Dell 1600n printer/scanner/fax/copier. +# Read LICENCE section below for terms and conditions. +# Run with no args for usage. +# $Id: dell1600n-net-scan.pl,v 1.64 2010-09-19 16:19:33 jon Exp $ +# +# Jon Chambers, 2005-05-19 +# +# Contains excellent and gratefully received patches from: +# Dani Gutiérrez (Ricoh FX200) +# Philip Roche (Xerox Phaser 6110) +# Laurent Ernes (Samsung CLX-2160N) +# Christophe Danker (Samsung SCX-4720FN) +# +use strict; +use IO::Socket; +use IO::Select; +use POSIX; +use Sys::Hostname; +use Time::HiRes qw( usleep ); + +#========================================================================= + +# VERSION +$main::version = "1.14"; +$main::cvsId = '$Id: dell1600n-net-scan.pl,v 1.64 2010-09-19 16:19:33 jon Exp $'; + +#========================================================================= + +# LICENCE + +$main::licence = " +This software is open source. Feel free to copy and distribute as +you like. If you use it as the basis of other software then it would +be polite to credit me. If this software is useful to you then feel +free to send a nice postcard from wherever you are to +Jon Chambers, 30 Stephenson Rd, London W7 1NW, UK. + +This program is provided in the hope that it will be useful. It comes +with no warranty. USE AT YOUR OWN RISK. + +Jon Chambers (jon\@jon.demon.co.uk), 2007-11-17 +"; + +#========================================================================= + +# fill the nice globals with defaults + +# uncomment the appropriate default for your model +$main::model = "1600n"; +#$main::model = "1815dn"; +#$main::model = "fx200"; +#$main::model = "6110mfp"; +#$main::model = "clx2160n"; +#$main::model = "scx4720fn"; + +# get hostname (minus any domain part and non-alphanumerics) +$main::clientName = hostname(); +$main::clientName =~ s/\..*$//g; +$main::clientName =~ s/[^\w]//g; + +# If defined then should be a 4-digit PIN number +#$main::clientPin = 1234; +$main::clientPin = undef; + +$main::printerAddr = ""; +$main::printerPort = 1124; + +$main::scanFileDir = "."; +$main::scanFilePrefix = "scan-"; + +$main::softwareName = "dell1600n-net-scan"; + +# if set then specifies a particular network interface +$main::bindAddr = undef; + +# broadcast address too find scanners +$main::broadcastAddr = "255.255.255.255"; + +# time to wait between re-registrations (seconds) +$main::scanWaitLoopTimeoutSec = 60; + +# set non-0 to print lots of debug nonsense +$main::debug = 0; + +# kernel-specific network stuff for now-defunct UPNP multicast +$main::IP_ADD_MEMBERSHIP_linux = 35; # Linux +#$main::IP_ADD_MEMBERSHIP_windows = 5; # Windows + +# choose linux by default +$main::IP_ADD_MEMBERSHIP = $main::IP_ADD_MEMBERSHIP_linux; + +# Command to send file as email attachment. +# (See PostProcessFile comments for substitutions.) +%main::emailCmd = ( "cmd" => "echo new scan | mutt &infiles; -s \"new scan\" &email;", + "inFilePrefix" => "-a ", + "delInFiles" => 1 ); + +# The following options must match or things will go wrong. +$main::preferredFileType = 2; # ( 2=>TIFF, 4=>PDF, 8=>JPEG ) +$main::preferredFileCompression = 0x08; # ( 0x08 => CCIT Group 4, 0x20 => JPEG ) +$main::preferredFileComposition = 0x01; # ( 0x01 => TIFF/PDF, 0x40 => JPEG ) + +$main::preferredResolution = 200; + +# Profiles for Dell 1815dn and Xerox Phaser 6110mfp +# See comments above for legal values for type, compression and composition +%main::profiles = ( + "TIFF 100" => { "type" => 2, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 100 }, + "TIFF 200" => { "type" => 2, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 200 }, + "TIFF 300" => { "type" => 2, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 300 }, + "PDF 100" => { "type" => 4, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 100 }, + "PDF 200" => { "type" => 4, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 200 }, + "PDF 300" => { "type" => 4, "cprss" => 0x08, "cmpsn" => 0x01, "res" => 300 }, + "JPEG 200" => { "type" => 8, "cprss" => 0x20, "cmpsn" => 0x40, "res" => 200 }, + "JPEG 300" => { "type" => 8, "cprss" => 0x20, "cmpsn" => 0x40, "res" => 300 }, + "COLOUR PDF 200" => { "type" => 8, "cprss" => 0x20, "cmpsn" => 0x40, "res" => 200, "profileOption" => "pdf" }, + "COLOUR PDF 300" => { "type" => 8, "cprss" => 0x20, "cmpsn" => 0x40, "res" => 300, "profileOption" => "pdf" }, +); + +$main::emailAddr = undef; + +# command to convert to PDF +#$main::pdfConvertCmd = undef; +# NOTE: convert is part of the imagemagick package +# NOTE2: zip compressed pdf files are not supported by Adobe Acrobat before +# version 3. +%main::pdfConvertCmd = ( "cmd" => "convert -compress zip &infiles; &outFile;", + "outFile" => "&scanFileDir;/&scanFilePrefix;×tamp;.pdf", + "delInFiles" => 1 ); + +# if set then all scans will be converted to PDF +$main::forceToPdf = 0; + +# if true then exit after single session +$main::singleSession = 1; + +# instance number (concatenated with IP address to create uid for 1815dn and 6110mfp) +$main::instanceId = 0; + +# Define optional commands here. +# These take the form of a hash (keyed by option name) of command hashes (in the +# same format as %main::pdfConvertCmd above) +# If the option is selected the command hash will be passed to +# PostProcessFile() (see comments in function for available substitutions) +%main::options = (); + +# tgz option writes scanned files to a tgz archive. +# Not enormously useful but a fair usage example... +$main::options{ "tgz" } = { + "cmd" => "tar zcvf &outFile; &infiles;", + "outFile" => "&scanFileDir;/&scanFilePrefix;×tamp;.tgz", + "delInFiles" => 1, + "description" => "Write scanned files to a tgz archive" + }; + +# gimp option opens files with the GIMP. +$main::options{ "gimp" } = { + "cmd" => "gimp &infiles;&", + "description" => "Open scanned files with the GIMP" + }; + +# Not enormously useful but a fair usage example... +$main::options{ "multipage-tiff" } = { + "cmd" => "convert &infiles; &outFile; ", + "outFile" => "&scanFileDir;/&scanFilePrefix;×tamp;.tiff", + "delInFiles" => 1, + "description" => "Create multipage tiff document" + }; + +# As %main::pdfConvertCmd but usable via options (and profile options) +$main::options{ "pdf" } = { + "cmd" => "convert -compress zip &infiles; &outFile;", + "outFile" => "&scanFileDir;/&scanFilePrefix;×tamp;.pdf", + "delInFiles" => 1, + "description" => "Convert all scans to PDF format" + }; + +# to_web option moves scanned files to web tree +#$main::options{ "to_web" } = { +# "cmd" => "mv -v &infiles; /home/www/images/", +# "description" => "Move scanned files to web tree" +# }; + +#========================================================================= + +# Global state variables + +# scan data storage +$main::dataBuf = ""; + +# filenames scanned this session +@main::sessionFiles = (); + +# PDF convert flag +$main::pdfConvert = 0; + +# received scan metadata +$main::fileType = 0; # ( 2=>TIFF, 4=>PDF, 8=>JPEG ) +$main::widthPixels = 0; +$main::heightPixels = 0; +$main::xResolution = 0; +$main::yResolution = 0; + +# our IP address (raw format) +$main::ipAddr = undef; + +# which of the options (if any) is selected +$main::selectedOption = undef; + +#========================================================================= + +sub GetTimestamp() +# Return local timestamp string as YYYYMMDD-hhmmsss +{ + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(); + return sprintf( "%04d%02d%02d-%02d%02d%02d", + $year + 1900, + $mon + 1, + $mday, + $hour, + $min, + $sec ); +} # GetTimestamp + +#========================================================================= + +sub ListenForPrinters() +# listens for printers on multicast 239.255.255.250:1900 +# Now this code is just included as a curiosity - BroadcastDiscover +# is quicker and easier +{ + my $group = '239.255.255.250'; + my $port = 1900; + + print "Listening on multicast group $group:$port\n"; + + my $sock = IO::Socket::INET-> + new( Proto => 'udp', LocalPort => $port ) + || die "Error opening socket"; + $sock->setsockopt( 0, + $main::IP_ADD_MEMBERSHIP, + pack("C8", split(/\./, "$group.0.0.0.0"))) + || die "Couldn't set group: $!\n"; + + while (1) { + my $data; + next unless $sock->recv( $data, 512 ); + print $data."\n"; + } + +} # ListenForPrinters + +#========================================================================= + +sub BroadcastDiscover() +# Use UDP broadcast to discover devices +{ + + print "Broadcasting to $main::broadcastAddr for $main::model-compatible scanners\n\n"; + + my $sock = new IO::Socket::INET->new( Proto => 'udp', + LocalAddr => $main::bindAddr, + Broadcast => 1 + ) + or die "Error opening UDP socket"; + + my %packet = InitPacket( GetNormalPacketHeader() ); + if ( $main::model eq "1600n" ){ + AppendMessageToPacket( \%packet, 0x25, "std-scan-discovery-all", + 0x02, 0 ); + } else { + # 1815dn-compatible (maybe works for fx200 too?) + AppendMessageToPacket( \%packet, 0x25, "std-scan-discovery-all", + 0x02, 0 ); + AppendMessageToPacket( \%packet, 0x25, "std-scan-discovery-type", + 0x06, 1 ); + } + my $sin = sockaddr_in( $main::printerPort, + inet_aton( $main::broadcastAddr ) ); + $sock->send( PackMessage( \%packet ), 0, $sin ) or + die "Nothing sent"; + + # init a select object on our socket + my $sel = new IO::Select( $sock ); + + my $numFound = 0; + + while (1) { + + my @ready = $sel->can_read( 5 ); + + if ( ! @ready ){ + # no input yet (we hit the timeout) so exit + print "Finished querying for network scanners, found $numFound\n"; + exit( 0 ); + } + + my $data; + if ( ! $sock->recv( $data, 1024 ) ){ + usleep( 100 ); + next; + } + + ProcessReceivedPacket( \$data, $sock, "udp" ); + print "\n"; + + $numFound++; + + } # while + +} # BroadcastDiscover + +#========================================================================= + +sub OpenUdpPort( $ ) +# Open udp socket to printer +{ + + my ( $addr ) = @_; + + my $sock = new IO::Socket::INET->new(PeerPort => $main::printerPort, + PeerAddr => $addr, + LocalAddr => $main::bindAddr, + Proto => 'udp' + ) + or die "Can't connect to: $addr:$main::printerPort\n"; + + + # note our ip addr + $main::ipAddr = $sock->sockaddr(); + print "My IP address is ". join( ".", unpack( "C4", $main::ipAddr ))."\n"; + # sanity check (Windows will fail this) + if ( ! unpack( "V", $main::ipAddr ) ){ + print "Oh dear, WIN32 UDP sockets are bad... trying to determine local IP address...\n"; + my $tmpsock = new IO::Socket::INET->new(PeerPort => 5200, + PeerAddr => $addr, + LocalAddr => $main::bindAddr, + Proto => 'tcp' ) || + die "Error making TCP connection to $addr:5200"; + $main::ipAddr = $tmpsock->sockaddr(); + print "My IP address is ". join( ".", unpack( "C4", $main::ipAddr )). + "\n"; + } + + # Work out the manufacturer from the model number supplied; + my $make; + if ( $main::model eq "fx200" ) { + $make = "Ricoh"; + } elsif ( $main::model eq "6110mfp" ) { + $make = "Xerox Phaser"; + } elsif ( $main::model eq "clx2160n" || $main::model eq "scx4720fn" ) { + $make = "Samsung"; + } else { + $make = "Dell"; + } + print "Registering with $make $main::model $addr:$main::printerPort as $main::clientName\n"; + + return $sock; + +} # OpenUdpPort + +#========================================================================= + +sub PostProcessFile( $ ) +# Performs post-processing on the current file list +# param 1 : reference to hash with members: +# cmd: post-process command (required) +# outFile : output file (optional) +# inFilePrefix : prefix to infile(s) (optional) +# delInFiles : if set and true then input files will be deleted +# +# The following substitutions will be made on cmd: +# &infiles; => list of input files (optionally prefixed by inFilePrefix) +# &outFile; => outFile +# +# The following substitutions will be made on outFile: +# &scanFileDir; => $main::scanFileDir +# &scanFilePrefix => $main::scanFilePrefix +# ×tamp; => the current timestamp +# +{ + my ( $in ) = @_; + + # sanity check + if ( ! scalar @main::sessionFiles ){ + print "PostProcessFile: No files left to process\n"; + return; + } + + my $cmd = $$in{ "cmd" }; + if ( ! defined( $cmd ) ){ return } + + my $prefix = $$in{ "inFilePrefix" }; + if ( ! defined( $prefix ) ){ $prefix = "" } + + my $outFile = $$in{ "outFile" }; + + my $timestamp = GetTimestamp(); + + # perform substitutions on outFile + if ( defined $outFile ){ + $outFile =~ s/&scanFileDir;/$main::scanFileDir/sg; + $outFile =~ s/&scanFilePrefix;/$main::scanFilePrefix/sg; + $outFile =~ s/×tamp;/$timestamp/sg; + } + + # build post-process command + my $infiles = ""; + foreach my $file ( @main::sessionFiles ){ + $infiles .= $prefix . $file . " "; + } + $cmd =~ s/&infiles;/$infiles/sg; + + if ( defined ( $outFile ) ){ + $cmd =~ s/&outFile;/$outFile/sg; + } + + if ( defined ( $main::emailAddr ) ){ + $cmd =~ s/&email;/$main::emailAddr/sg; + } + print "Running: $cmd\n"; + + my $ret = system( $cmd ); + if ( $ret != 0 ){ + print "WARNING: Got non-zero return code - this is generally bad...\n"; + } + + if ( $$in{ "delInFiles" } ){ + foreach my $xxx ( @main::sessionFiles ){ + print "Deleting $xxx\n"; + unlink $xxx; + } + @main::sessionFiles = (); + } + + if ( defined( $outFile ) ){ + push @main::sessionFiles, $outFile; + } + +} # PostProcessFile() + +#========================================================================= + +sub ProcessReceivedPacket( $$$ ) +# Displays the contents of a packet received from the printer to screen +# and processes it as appropriate +# Processed data is removed from the packet. +# In "udp" mode the packet must be whole (ie: the data size must +# match that read from the header. In "tcp" mode, in case of a +# an incomplete packet the the function returns to allow more data +# to be read from the socket +# param 1 : reference to binary data +# param 2 : socket object (in case a reply is required) +# param 3 : mode, either "tcp" or "udp" +{ + + my ( $data, $sock, $mode ) = @_; + + if ( $main::debug ){ + print "** Processing packet of " . ( length ${$data} ) . " bytes\n"; + } + + # init a reply packet ready for use + my %packet = InitPacket( GetReplyPacketHeader() ); + + my $bLastPacket = 0; + my $bPrefsRequested = 0; + + # process as much of the data as we can + while ( length ${$data} >= 8 ){ + + # copy data into an array + my @datArray = unpack( "C*", ${$data} ); + + # extract the header + my @header = splice( @datArray, 0, 8 ); + + my $now = ctime( time() ); + chop $now; + + if ( $main::debug ){ + print "$now: header: ".join( " ", @header )."\n"; + } + + my $ok = 1; + if ( @header != 8 ){ + print "*** header less than 8 bytes\n"; + $ok = 0; + } + + my $expectedSize = ($header[7]+($header[6]<<8) ); + my $actualSize = @datArray; + + # if tcp mode then check whether we need more data + if ( ( $mode eq "tcp" ) && ( $actualSize < $expectedSize ) ){ + if ( $main::debug ){ + print "*** Incomplete packet (expect $expectedSize, ". + "got $actualSize)\n"; + } + return; + } + + # if udp mode then we expect an exact match + if ( ( $mode eq "udp" ) && ( $expectedSize != $actualSize ) ) { + print "*** data size mismatch: (expect $expectedSize, got $actualSize)\n"; + $ok = 0; + } # if + + my ( $cmdName, $cmdValue ); + if ( ! $ok ){ + + # unrecognised data block : just HexDump it + print "Unexpected block format:\n"; + + print HexDump ${$data}; + + } else { + + # remove the data that we will process from the start of the data buffer + ${$data} = substr ${$data}, ( 8 + $expectedSize ); + + # trim the excess elements from the end of @datArray + @datArray = @datArray[ 0..($expectedSize - 1) ]; + + # loop until all the data has been processes + while ( @datArray ){ + + # extract the command + my @cmdSub = splice( @datArray, 0, 3 ); + $cmdName = pack( "C*", + splice( @datArray, 0, + ( ( $cmdSub[ 1 ] << 8 ) + + $cmdSub[ 2 ] )) ); + + if ( $main::debug ){ + print " $cmdName ($cmdSub[0]): "; + } + + # extract the payload + my @plSub = splice( @datArray, 0, 3 ); + + + my $plType = $plSub[ 0 ]; + my $plSize = ( $plSub[ 1 ] << 8 ) + $plSub[ 2 ]; + + if ( $main::debug ){ + print "[$plType] "; + } + + my @plArray = splice( @datArray, 0, $plSize ); + + # extract payload in a manner appropriate to type + if ( $plType == 0x0b ){ + + # treat as a string + $cmdValue = pack( "C*", @plArray ); + if ( $main::debug ){ print $cmdValue; } + + } elsif ( ( ( $plType == 0x06 ) || ( $plType == 0x05 ) ) && + ( @plArray == 4 ) ){ + + # treat as an int + $cmdValue = ( ( $plArray[0] << 24 ) + + ( $plArray[1] << 16 ) + + ( $plArray[2] << 8 ) + + $plArray[3] ); + + if ( $main::debug ){ print $cmdValue; } + + } elsif ( ( $plType == 0x04 ) && ( @plArray == 2 ) ){ + + # treat as a short + $cmdValue = ( ( $plArray[0] << 8 ) + + $plArray[1] ); + if ( $main::debug ){ print $cmdValue; } + + } elsif ( ( $plType == 0x0a ) && ( @plArray == 4 ) ){ + + # IP address + $cmdValue = $cmdValue = join( ".", @plArray ); + if ( $main::debug ){ print $cmdValue; } + + } else { + # unknown type + $cmdValue = join( " ", @plArray ); + if ( $main::debug ){ print $cmdValue; } + } + + if ( $main::debug ){ print "\n"; } + + # respond appropriately (if we know how) + + if ( $cmdName eq "std-scan-request-tcp-connection" ){ + ProcessTcpRequest(); + + } elsif ( $cmdName eq "std-scan-session-open" ){ + + my $respVal = + ( $main::model eq "1815dn" + || $main::model eq "6110mfp" + || $main::model eq "fx200" + || $main::model eq "clx2160n" + || $main::model eq "scx4720fn" ) ? 1 : 0; + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-session-open-response", + 0x05, + $respVal ); + + } elsif ( $cmdName eq "std-scan-getclientpref" ){ + + # make a note that client prefs have been requested but don't fill them in yet + $bPrefsRequested = 1; + + } elsif ( $cmdName eq "std-scan-document-start" ){ + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-document-start-response", + 0x05, + 0 ); + + # reset session file list + @main::sessionFiles = (); + + } elsif ( $cmdName eq "std-scan-document-file-type" ){ + + $main::fileType = $cmdValue; + + } elsif ( $cmdName eq "std-scan-document-xresolution" ){ + + $main::xResolution = $cmdValue; + + } elsif ( $cmdName eq "std-scan-document-yresolution" ){ + + $main::yResolution = $cmdValue; + + } elsif ( $cmdName eq "std-scan-page-widthpixel" ){ + + $main::widthPixels = $cmdValue; + + } elsif ( $cmdName eq "std-scan-page-heightpixel" ){ + + $main::heightPixels = $cmdValue; + + + } elsif ( $cmdName eq "std-scan-page-start" ){ + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-page-start-response", + 0x05, + 0 ); + + # write out any pre-existing page data + if ( length $main::dataBuf ){ + OutputScanData(); + } + + # reset the data buffer ready to store a page + $main::dataBuf = ""; + + } elsif ( $cmdName eq "std-scan-page-end" ){ + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-page-end-response", + 0x05, + 0 ); + + } elsif ( $cmdName eq "std-scan-document-end" ){ + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-document-end-response", + 0x05, + 0 ); + + # write out data + OutputScanData(); + + # reset the data buffer + $main::dataBuf = ""; + + } elsif ( $cmdName eq "std-scan-session-end" ){ + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-session-end-response", + 0x05, + 0 ); + # shut down after the next send + $bLastPacket = 1; + + # do PDF conversion + if ( $main::pdfConvert ){ + if ( defined( $main::pdfConvertCmd{"cmd"} ) ){ + PostProcessFile( \%main::pdfConvertCmd ); + } else { + print "*** \%main::pdfConvertCmd not set - ". + "skipping PDF conversion\n"; + } + } # if pdf + + # do any extra requested option processing + if ( defined( $main::selectedOption ) ){ + PostProcessFile( \%{ $main::options{ $main::selectedOption } } ); + } + + # email the result to somewhere if required + if ( defined( $main::emailAddr ) ){ + + # just in case + if ( ! defined( $main::emailCmd{ "cmd" } ) ){ + print "WARNING: you must define \%main::emailCmd in the script for the email facility to work\n"; + } else { + PostProcessFile( \%main::emailCmd ); + } + } # if emailAddr + + + } elsif ( $cmdName eq "std-scan-scandata-error" ){ + + # start of a chunk of binary scan data + my @binHead = splice( @datArray, 0, 8 ); + + my $chunkSize = ( $binHead[ 6 ] << 8 ) + $binHead[ 7 ]; + + if ( $main::debug ){ + print "Reading $chunkSize bytes of scan data\n"; + } + + $main::dataBuf .= pack( "C*", + splice( @datArray, 0, + $chunkSize ) ); + + if ( $main::debug ){ + print "(accumulated " . + ( length $main::dataBuf ) . " bytes of data...)\n"; + } + + } elsif ( $cmdName eq "std-scan-discovery-ip" ){ + + print "IP Address: $cmdValue\n"; + + } elsif ( $cmdName eq "std-scan-discovery-firmware-version" ){ + + print "Firmware version: $cmdValue\n"; + + } elsif ( $cmdName eq "std-scan-discovery-model-name" ){ + + print "Model: $cmdValue\n"; + + } elsif ( $cmdName eq "std-scan-getclientpref-application-name" ){ + + # chop off leading '0' and trailing "\0"s + $cmdValue =~ s/^0([^\0]*)\0*$/$1/g; + + if ( defined( $main::profiles{ $cmdValue } ) ){ + print "Selected profile ".$main::profiles{ $cmdValue }."\n"; + + $main::preferredFileType = $main::profiles{ $cmdValue }{ "type" }; + $main::preferredFileCompression = $main::profiles{ $cmdValue }{ "cprss" }; + $main::preferredFileComposition = $main::profiles{ $cmdValue }{ "cmpsn" }; + $main::preferredResolution = $main::profiles{ $cmdValue }{ "res" }; + + if ( defined( $main::profiles{ $cmdValue }{ "profileOption" } ) ) + { + # override selected option + $main::selectedOption = $main::profiles{ $cmdValue }{ "profileOption" } + } + + } elsif ( $cmdValue ne "" ) { + print "Ignoring unknown profile ".$cmdValue."\n"; + } + + } # if + + } # while + + } # if + + if ( $main::debug ){ print "\n"; } + + } # while + + + # if prefs have been requested then fill them in + if ( $bPrefsRequested ){ + + my ( $x1, $x2, $y1, $y2, $paperSizeDetect ); + if ( $main::model eq "1815dn" + || $main::model eq "6110mfp" + || $main::model eq "clx2160n" + || $main::model eq "scx4720fn" ){ + if ( $main::preferredFileType == 8 ){ + # JPEG: currently set equal to TIFF value but may need to be different, Jon 2007-01-02 + ( $x1, $x2, $y1, $y2, $paperSizeDetect ) = ( 0x40533333, 0x434eb333, 0x40533333, 0x4392d99a, 4 ); + } else { + # TIFF/PDF + ( $x1, $x2, $y1, $y2, $paperSizeDetect ) = ( 0x40533333, 0x434eb333, 0x40533333, 0x4392d99a, 4 ); + } + } else { + ( $x1, $x2, $y1, $y2, $paperSizeDetect ) = ( 0, 0, 0, 0, 0 ); + } + + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-x1", + 0x07, + $x1 ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-x2", + 0x07, + $x2 ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-y1", + 0x07, + $y1 ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-y2", + 0x07, + $y2 ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-xresolution", + 0x04, + $main::preferredResolution ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-yresolution", + 0x04, + $main::preferredResolution ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-image-composition", + 0x06, + $main::preferredFileComposition ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-brightness", + 0x02, + 0x80 ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-image-compression", + 0x06, + $main::preferredFileCompression ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-file-type", + 0x06, + $main::preferredFileType ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-paper-size-detect", + 0x06, + $paperSizeDetect ); + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-scanner-type", + 0x06, + 0 ); + + if ( $main::model eq "1815dn" + || $main::model eq "6110mfp" + || $main::model eq "clx2160n" + || $main::model eq "scx4720fn" ) + { + AppendMessageToPacket( \%packet, + 0x22, + "std-scan-getclientpref-application-list", + 0x0b, + GetProfileNameData() + ); + } # if + + } # if prefs requested + + # send packet if some messages have been appended to it + if ( @{$packet{ "messages" }} > 0 ){ + + if ( $main::debug ){ + print "Sending message with " . ( scalar( @{$packet{ "messages" }} ) ) . " items\n"; + } + + $sock->send( PackMessage( \%packet ) ); + } + + if ( $bLastPacket ){ + # initialise a clean socket shutdown + if ( $main::debug ){ + print "Shutting down TCP connection\n"; + } + $sock->shutdown( 2 ); + } + +} # ProcessReceivedPacket + +#========================================================================= + +sub GetNormalPacketHeader() +# returns a "normal" packet header (eg: 02 00 01 02 00 00) +{ + if ( $main::model eq "1815dn" ){ + return pack( "C*", 0x02 ,0x01, 0x01, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "fx200" ){ + return pack( "C*", 0x03 ,0x00, 0x01, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "6110mfp" ){ + return pack( "C*", 0x04 ,0x00, 0x01, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "clx2160n" || $main::model eq "scx4720fn" ){ + return pack( "C*", 0x01 ,0x00, 0x01, 0x02 ,0x00 ,0x00 ); + } else { + return pack( "C*", 0x02 ,0x00, 0x01, 0x02 ,0x00 ,0x00 ); + } + +} # GetNormalPacketHeader + +#========================================================================= + +sub GetReplyPacketHeader() +# returns a "reply" packet header (eg: 02 00 02 02 00 00) +{ + if ( $main::model eq "1815dn" ){ + return pack( "C*", 0x02 ,0x01, 0x02, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "fx200" ){ + return pack( "C*", 0x03 ,0x00, 0x02, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "6110mfp" ){ + return pack( "C*", 0x04 ,0x00, 0x02, 0x02 ,0x00 ,0x00 ); + } elsif ( $main::model eq "clx2160n" || $main::model eq "scx4720fn" ){ + return pack( "C*", 0x01 ,0x00, 0x02, 0x02 ,0x00 ,0x00 ); + } else { + return pack( "C*", 0x02 ,0x00, 0x02, 0x02 ,0x00 ,0x00 ); + } + +} # GetReplyPacketHeader + +#========================================================================= + +sub InitPacket( $ ) +# initialise a packet to send to printer +# param 1 : 6 byte header (eg: as from GetNormalPacketHeader() ) +# returns a hash containing an initialised packet +{ + + my ( $header ) = @_; + + die "Bad packet header" if ( length $header != 6 ); + + my %packet = ( "header" => $header ); + + @{$packet{ "messages" }} = (); + + return %packet; + +} # InitPacket + +#========================================================================= + +sub AppendMessageToPacket( $$$$$ ) +# appends a message to a packet +# param 1 : reference to packet (hash) +# param 2 : message name type +# param 3 : message name +# param 4 : message value type +# param 5 : message value +# dies in case of trouble +{ + + my ( $nameType, $name, $valueType, $value ) = @_[1..4]; + + my $message = pack ( "Cn", $nameType, length $name ) . $name; + + if ( $valueType == 0x02 ){ + # unsigned char + + $message .= pack( "CnC", $valueType, 1, $value ); + + } elsif ( $valueType == 0x04 ){ + # unsigned short + + $message .= pack( "Cnn", $valueType, 2, $value ); + + } elsif ( $valueType == 0x07 || $valueType == 0x06 || $valueType == 0x05 ){ + # unsigned int + + $message .= pack( "CnN", $valueType, 4, $value ); + + } elsif ( $valueType == 0x0a ){ + # ip address type + + $message .= pack( "Cn", $valueType, length $value ) . $value; + + } elsif ( $valueType == 0x0b ){ + # char[] type + + $message .= pack( "Cn", $valueType, length $value ) . $value; + + } else { + die "Unknown value type: $valueType"; + + } # if + + push @{ $_[0] { "messages" }}, $message; + +} # AppendMessageToPacket + +#========================================================================= + +sub HexDump( $ ) +# A poor man's hex dump +{ + my $ret = ""; + my $numBytes = 0; + + foreach my $byte ( unpack( "C*", $_[0] ) ){ + + $ret .= sprintf( "%02X ", $byte ); + if ( ! ( ( ++$numBytes ) % 16 ) ) { $ret .= "\n" } + } # foreach + + if ( ( ++$numBytes ) % 16 ) { $ret .= "\n" } + + return $ret; + +} # HexDump + +#========================================================================= + +sub PackMessage( $ ) +# packs a printer message into binary format (ready to send) +# param 1 : reference to packet hash +# returns binary value +{ + my $payload; + + # build the payload + foreach my $message ( @{ $_[0] { "messages" }} ){ + $payload .= $message; + } + + my $packet = $_[0] { "header" } . + pack( "n", length $payload ) . + $payload; + + + if ( $main::debug ){ + print "Sending packet:\n" . HexDump( $packet ); + } + + # return the full message + return $packet; + +} # PackMessage + +#========================================================================= + +sub ProcessTcpRequest() +# opens a TCP/IP socket to $main::printerAddr and processes scan requests received +{ + + my $sock = new IO::Socket::INET->new(PeerPort => $main::printerPort, + PeerAddr => $main::printerAddr, + LocalAddr => $main::bindAddr, + Proto => 'tcp' + ) + or die "Can't connect to: $main::printerAddr:$main::printerPort (tcp/ip)\n"; + + print "** Opened TCP/IP connection to $main::printerAddr:$main::printerPort\n"; + + my $data = ""; + my $mesg; + + # If this is 1815dn or 6110mfp mode then we must zero scan prefs in order to + # prompt the scanner to specify the profile name + if ( $main::model eq "1815dn" || $main::model eq "6110mfp"){ + $main::preferredFileType = 0; + $main::preferredFileCompression = 0; + $main::preferredFileComposition = 0; + $main::preferredResolution = 0; + } # if + + my $isOpen = 1; + while ( $isOpen && defined( $sock->recv( $mesg, 2048, 0 ) ) ) { + + # an empty mesg means a shutdown has occurred + if ( $mesg eq "" ){ + $sock->close(); + $isOpen = 0; + next; + } + + # append to data buffer and process the result + $data .= $mesg; + ProcessReceivedPacket( \$data, $sock, "tcp" ); + + } # while + + print "** Closed TCP/IP connection to $main::printerAddr:$main::printerPort\n"; + + # quit after single session if required + if ( $main::singleSession != 0 ){ exit 0 } + +} # ProcessTcpRequest + +#========================================================================= + +sub OutputScanData() +# writes out contents of $main::dataBuf to file +{ + + my $suffix = "dat"; + + # format-specific stuff + if ( $main::fileType == 2 ){ + # TIFF + $suffix = "tif"; + $main::pdfConvert = $main::forceToPdf; + AddTiffHeaders(); + + } elsif ( $main::fileType == 4 ){ + # PDF + $suffix = "tif"; + $main::pdfConvert = 1; + AddTiffHeaders(); + + } elsif ( $main::fileType == 8 ){ + # JPEG + $main::pdfConvert = $main::forceToPdf; + $suffix = "jpg"; + + } else { + print "*** WARNING: Unexpected file format ($main::fileType)\n"; + + } # if + + my $fileName = "$main::scanFileDir/$main::scanFilePrefix" . + GetTimestamp() . ".$suffix"; + + print "Writing data to $fileName\n"; + + open SCANOUT, ">$fileName" or die "opening $fileName"; + + # set output handle to raw binary mode + binmode( SCANOUT ); + + print SCANOUT $main::dataBuf; + + close SCANOUT; + + # add this filename to the list + push @main::sessionFiles, $fileName; + +} # OutputScanData + +#========================================================================= + +sub AddTiffHeaders() +# adds TIFF headers to data stored in $main::dataBuf; +{ + + # build timestamp + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(); + my $stamp = sprintf( "%04d-%02d-%02d %02d:%02d:%02d", + $year + 1900, + $mon + 1, + $mday, + $hour, + $min, + $sec ); + + # note our data size (before we modify it!) + my $dataSize = length $main::dataBuf; + + # calculate offsets to Image File Directory and other bits + my $dataOffset = 8; + + my $stampOffset = $dataOffset + length $main::dataBuf; + + # align to word boundary + if ( $stampOffset % 2 ){ $stampOffset++ } + + my $softwareNameOffset = $stampOffset + length( $stamp ) + + 1; # don't forget NULL + if ( $softwareNameOffset % 2 ){ $softwareNameOffset++ } + + my $xresOffset = $softwareNameOffset + length( $main::softwareName ) + 1; + if ( $xresOffset % 2 ){ $xresOffset++ } + + my $yresOffset = $xresOffset + 8; + my $ifdOffset = $yresOffset + 8; + + # we now have enough information to insert the file header + $main::dataBuf = pack( "CCCCV", 0x49, 0x49, 0x2A, 0x00, $ifdOffset ) . + $main::dataBuf; + + # pad + if ( length ( $main::dataBuf ) % 2 ){ $main::dataBuf .= pack( "C", 0 ) } + + # add timestamp string ( + NULL terminator ) + $main::dataBuf .= $stamp . pack( "C", 0 ); + + # pad + if ( length ( $main::dataBuf ) % 2 ){ $main::dataBuf .= pack( "C", 0 ) } + + # add software string name ( + NULL ) + $main::dataBuf .= $main::softwareName . pack( "C", 0 ); + + # pad + if ( length ( $main::dataBuf ) % 2 ){ $main::dataBuf .= pack( "C", 0 ) } + + # add x and y resolutions + $main::dataBuf .= pack( "VV", $main::xResolution, 1 ); + $main::dataBuf .= pack( "VV", $main::yResolution, 1 ); + + # append field count + $main::dataBuf .= pack( "v", 14 ); + + # NewSubFileType + $main::dataBuf .= pack( "vvVV", 0xfe, 4, 1, 2 ); + + # ImageWidth + $main::dataBuf .= pack( "vvVV", 0x100, 4, 1, $main::widthPixels ); + + # ImageLength + $main::dataBuf .= pack( "vvVV", 0x101, 4, 1, $main::heightPixels ); + + # Compression ( 4 == CCIT Group 4) + $main::dataBuf .= pack( "vvVvv", 0x103, 3, 1, 4, 0 ); + + # PhotometricInterpretation ( 0 = White Is Zero ) + $main::dataBuf .= pack( "vvVvv", 0x106, 3, 1, 0, 0 ); + + # StripOffsets + $main::dataBuf .= pack( "vvVV", 0x111, 4, 1, 8 ); + + # RowsPerStrip + $main::dataBuf .= pack( "vvVV", 0x116, 4, 1, $main::heightPixels ); + + # StripByteCounts + $main::dataBuf .= pack( "vvVV", 0x117, 4, 1, $dataSize ); + + # XResolution + $main::dataBuf .= pack( "vvVV", 0x11a, 5, 1, $xresOffset ); + + # YResolution + $main::dataBuf .= pack( "vvVV", 0x11b, 5, 1, $yresOffset ); + + # TbOptions + $main::dataBuf .= pack( "vvVV", 0x125, 4, 1, 0 ); + + # ResolutionUnit + $main::dataBuf .= pack( "vvVvv", 0x128, 3, 1, 2, 0 ); + + # Software + $main::dataBuf .= pack( "vvVV", 0x131, 2, length( $main::softwareName ), + $softwareNameOffset ); + + # DateTime + $main::dataBuf .= pack( "vvVV", 0x132, 2, 20, $stampOffset ); + + # end marker + $main::dataBuf .= pack( "V", 0 ); + +} # AddTiffHeaders + +#========================================================================= + +sub RegisterWithScanner( $ ) +# registers with scanner +# param 1 : a UDP socket to the printer +{ + my ( $sock ) = @_; + + my %packet = InitPacket( GetNormalPacketHeader() ); + + AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-user-name", + 0x0b, $main::clientName ); + if ( $main::model eq "1815dn" || $main::model eq "6110mfp" || $main::model eq "clx2160n"){ + # this is the MD5 digest of 0000 + AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-pin", + 0x0b, "4a7d1ed414474e4033ac29ccb8653d9b" ); + } elsif ( defined( $main::clientPin ) ){ + AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-pin", + 0x06, $main::clientPin ); + } + AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-ip-address", + 0x0a, $main::ipAddr ); + if ( $main::model eq "1815dn" || $main::model eq "6110mfp"){ + my $uid = $main::ipAddr . pack( "U", $main::instanceId ); + AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-uid", + 0x0b, $uid ); + } + + $sock->send( PackMessage( \%packet ) ); + +} # RegisterWithScanner + +#========================================================================= + +sub GetProfileNameData +# returns packed array of 930 bytes containing names of profiles for Dell +# 1815dn and Xerox 6110mfp +{ + my @profdat = (); + + my @names = sort keys %main::profiles; + + for ( my $iProf = 0; $iProf < 30; $iProf++ ){ + + my $profName; + if ( defined( $names[ $iProf ] ) ){ + $profName = $names[ $iProf ]; + push @profdat, 0x30; + } else { + $profName = ""; + push @profdat, 0; + } + + my @elems = unpack( "C*", $profName ); + for ( my $iEl = 0; $iEl < 30; $iEl++ ){ + push @profdat, defined( $elems[ $iEl ] ) ? $elems[ $iEl ] : 0; + } + } + + return pack( "C*", @profdat ); + +} # GetProfileNameData + +#========================================================================= + +# parse args +my %options; +my $bHelp = 0; + +for ( my $iArg = 0; $iArg < @ARGV; ++$iArg ){ + + my $thisArg = $ARGV[ $iArg ]; + + if ( $thisArg eq "--help" or $thisArg eq "-h" ){ + $bHelp = 1; + + } elsif ( $thisArg eq "--find" ){ + $options{ "find" } = 1; + + } elsif ( $thisArg eq "--debug" ){ + $main::debug = 1; + + } elsif ( $thisArg eq "--1600n" ){ + $main::model = "1600n"; + + } elsif ( $thisArg eq "--fx200" ){ + $main::model = "fx200"; + + } elsif ( $thisArg eq "--1815dn" ){ + $main::model = "1815dn"; + + } elsif ( $thisArg eq "--6110mfp" ){ + $main::model = "6110mfp"; + + } elsif ( $thisArg eq "--clx2160n" ){ + $main::model = "clx2160n"; + + } elsif ( $thisArg eq "--scx4720fn" ){ + $main::model = "scx4720fn"; + + } elsif ( $thisArg eq "--single-session" or $thisArg eq "--single-doc" ){ + $main::singleSession = 1; + + } elsif ( $thisArg eq "--multi-session" or $thisArg eq "--multi-doc" ){ + $main::singleSession = 0; + + } elsif ( $thisArg eq "--force-pdf" ){ + $main::forceToPdf = 1; + + } elsif ( $thisArg eq "--listen" ){ + die "--listen requires a parameter" unless + $options{ "listen" } = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--scan-dir" ){ + die "--scan-dir requires a parameter" unless + $main::scanFileDir = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--email" ){ + die "--email requires a parameter" unless + $main::emailAddr = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--scan-prefix" ){ + die "--scan-prefix requires a parameter" unless + $main::scanFilePrefix = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--name" ){ + die "--name requires a parameter" unless + $main::clientName = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--format" ){ + die "--format requires a parameter" unless + my $fmt = lc $ARGV[ ++$iArg ]; + if ( $fmt eq "tiff" ){ + $main::preferredFileType = 0x02; + $main::preferredFileCompression = 0x08; + $main::preferredFileComposition = 0x01; + } elsif ( $fmt eq "pdf" ){ + $main::preferredFileType = 0x04; + $main::preferredFileCompression = 0x08; + $main::preferredFileComposition = 0x01; + } elsif ( $fmt eq "jpeg" ){ + $main::preferredFileType = 0x08; + $main::preferredFileCompression = 0x20; + $main::preferredFileComposition = 0x40; + } else { + print "Ignoring unexpected format $fmt\n" + } + } elsif ( $thisArg eq "--resolution" ){ + die "--resolution requires a parameter" unless + $main::preferredResolution = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--bind" ){ + die "--bind requires a parameter" unless + $main::bindAddr = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--broadcast" ){ + die "--broadcast requires a parameter" unless + $main::broadcastAddr = $ARGV[ ++$iArg ]; + + } elsif ( $thisArg eq "--instance-id" ){ + die "--instance-id requires a parameter" unless + $main::instanceId = $ARGV[ ++$iArg ]; + $main::instanceId += 0; + + } elsif ( $thisArg eq "--option" ){ + die "--option requires a parameter" unless + $main::selectedOption = $ARGV[ ++$iArg ]; + + if ( ! defined( $main::options{ $main::selectedOption } ) ){ + die "Unknown option: $main::selectedOption" + } + + } else { + die "Unknown argument: $thisArg"; + + } # if + +} # for + +# check usage + +if ( $bHelp or ( ! %options ) ){ + + print <<EOF +Usage: $0 <options> + +Main Options: +--help : Show this help +--find : Discover Dell 1600n/1815dn using network broadcast +--listen <p> : Register and listen for requests from Dell 1600n/1815dn <p> + +Sub Options: +--1600n : Use Dell 1600n-compatible protocol +--1815dn : Use Dell 1815dn-compatible protocol +--fx200 : Use Ricoh FX200-compatible protocol +--6110mfp : Use Xerox Phaser 6110MFP-compatible protocol +--clx2160n : Use Samsung CLX-2160N-compatible protocol +--scx4720fn : Use Samsung SCX-4720FN-compatible protocol +--scan-dir <d> : Scanned images will be scanned to this directory +--scan-prefix <p> : Scan filenames will be prefixed with <p> +--debug : Print lots of debug output +--email <a> : Email files to address <a> (requires \$main::emailCmd to be set) +--name <n> : Override client name (appears in scanner display) +--single-session : Exit after first scan session +--multi-session : Listen for scan documents until killed +--force-pdf : Convert all scans to PDF (requires \$main::pdfConvertCmd to be set) +--bind <i> : Bind to local IP address <i> +--broadcast <i> : Broadcast address (default: 255.255.255.255) used by --find. + +Dell 1600n-specific Options: +--format <f> : Preferred scan format (tiff, pdf or jpeg) +--resolution <dpi>: Preferred resolution (100/200/300 for tiff/pdf, 200 for jpeg) + +Dell 1815dn-specific Options: +--instance-id <id>: Unique instance id (in case of uid clash) + +Other Options: +--option <o> : Select option <o>. The following are available: + +EOF +; +foreach my $opt ( sort keys %main::options ){ + print " $opt = ".$main::options{ $opt }{ "description" }."\n"; +} + +print <<EOF + +$main::softwareName version $main::version ($main::cvsId) +$main::licence + +EOF +; + exit 1; +} + +# scan for printers +if ( defined( $options{ "find" } ) ){ + BroadcastDiscover(); +} + +# register with scanner +if ( defined( $options{ "listen" } ) ){ + + $main::printerAddr = $options{"listen" }; + + my $sock = OpenUdpPort( $main::printerAddr ); + + RegisterWithScanner( $sock ); + + my $sel = new IO::Select( $sock ); + + while (1) { + + my @ready = $sel->can_read( $main::scanWaitLoopTimeoutSec ); + + if ( ! @ready ){ + # no input yet (we hit the timeout) so re-register + if ( $main::debug ){ + my $now = ctime( time() ); + chop $now; + print "$now Re-registering with scanner\n"; + } + RegisterWithScanner( $sock ); + next; + } + + my $data; + if ( ! $sock->recv( $data, 1024 ) ){ + usleep( 100 ); + next; + } + ProcessReceivedPacket( \$data, $sock, "udp" ); + + } # while + +} # if + |