#!/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.38 2006/01/29 17:29:21 jon Exp $
#
# Jon Chambers, 2005-05-19
use strict;
use IO::Socket;
use IO::Select;
use POSIX;
use Sys::Hostname;

#=========================================================================

# VERSION
$main::version = "1.4";
$main::cvsId = '$Id: dell1600n-net-scan.pl,v 1.38 2006/01/29 17:29:21 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 somewhere interesting 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), 2005-06-14
";

#=========================================================================

# fill the nice globals with defaults

# get hostname (minus any domain part)
$main::clientName = hostname();
$main::clientName =~ s/\..*$//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
$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;

$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;&timestamp;.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;

# 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;&timestamp;.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"
    };

# 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;

# 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 network 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() );
    AppendMessageToPacket( \%packet, 0x25, "std-scan-discovery-all",
			   0x02, 0 );
    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";
    }
    print "Registering with Dell 1600n $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
#   &timestamp; => 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/&timestamp;/$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 inomplete 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";
    }

    # process as much of the data as we can
    while ( length ${$data} ){

	# 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 %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-session-open-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );

		} elsif ( $cmdName eq "std-scan-getclientpref" ){
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-getclientpref-x1",
					   0x05,
					   0 );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-getclientpref-x2",
					   0x05,
					   0 );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-getclientpref-y1",
					   0x05,
					   0 );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-getclientpref-y2",
					   0x05,
					   0 );
		    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,
					   0 );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-getclientpref-paper-scanner-type",
					   0x06,
					   0 );
		    $sock->send( PackMessage( \%packet ) );
		    
		} elsif ( $cmdName eq "std-scan-document-start" ){
		
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-document-start-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );

		    # 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" ){
		    
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-page-start-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );


		    # 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" ){
		    
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-page-end-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );

		} elsif ( $cmdName eq "std-scan-document-end" ){
		    
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-document-end-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );

		    # write out data
		    OutputScanData();

		    # reset the data buffer
		    $main::dataBuf = "";

		} elsif ( $cmdName eq "std-scan-session-end" ){
      
		    my %packet = InitPacket( GetReplyPacketHeader() );
		    AppendMessageToPacket( \%packet, 
					   0x22,
					   "std-scan-session-end-response",
					   0x05,
					   0 );
		    $sock->send( PackMessage( \%packet ) );

		    # 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

		    # 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

		    # do any extra requested option processing
		    if ( defined( $main::selectedOption ) ){
			PostProcessFile( \%{ $main::options{ $main::selectedOption } } );
		    }

		    # initialise a clean socket shutdown
		    $sock->shutdown( 2 );

		} 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";

		} # if
		
	    } # while

	} # if

	if ( $main::debug ){ print "\n"; }

    } # while

} # ProcessReceivedPacket

#=========================================================================

sub GetNormalPacketHeader()
# returns a "normal" packet header (02 00 01 02 00 00)
{
    return pack( "C*", 0x02 ,0x00, 0x01, 0x02 ,0x00 ,0x00 );

} # GetNormalPacketHeader

#=========================================================================

sub GetReplyPacketHeader()
# returns a "reply" packet header (02 00 02 02 00 00)
{
    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{ "items" }} = ();

    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;

    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 ( defined( $main::clientPin ) ){
	AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-pin",
			       0x06, $main::clientPin );
    }
    AppendMessageToPacket( \%packet, 0x22, "std-scan-subscribe-ip-address",
			   0x0a, $main::ipAddr );

    $sock->send( PackMessage( \%packet ) );

} # RegisterWithScanner

#=========================================================================

# 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 "--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 "--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 using network broadcast
--listen <p>      : register and listen for requests from Dell 1600n <p>

Sub Options:
--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.
--format <f>      : preferred scan format (tiff, pdf or jpeg)
--resolution <dpi>: preferred resolution (100/200/300 for tiff/pdf, 200 for jpeg) 
--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