#!/usr/bin/perl -w
#
# $Id: //websites/unixwiz/unixwiz.net/webroot/tools/hpsutil-1.04.txt#1 $
# 
# written by :  Stephen J. Friedl
#               Software Consultant
#               Tustin, California USA
#               steve@unixwiz.net / www.unixwiz.net
#
#	This is free software in the public domain. Enjoy.
#
#	============================= NOTE =============================
#	This program was part of a customer research project, and partway
#	through it was determined that this printserver was not suitable
#	for our project. This program's development stopped on a dime to
#	focus on other things. We've gone back and cleaned it up a bit for
#	the web, but this is far below our usual standards of quality and
#	documention. Sorry.
#	============================= NOTE =============================
#
#	This program queries and sets up a Hawking Technology H-PS1U
#	Ether-to-USB print server, and it's meant to be used in place of
#	the Windows-only GUI provided by the manufacturer.
#
#	Documentation on this device and this tool can be found at:
#
#	tool:	http://www.unixwiz.net/tools/hpsutil.html
#	info:   http://www.unixwiz.net/techtips/hawking-printservers.html
#
#	This tool was developed and tested using perl 5.6.1 on a Red Hat
#	6.2 Linux system. It's been reported to run on other systems
#	as well, including MacOS.
#
# OVERVIEW
# --------
#
#	This unit has NO switches or jumpers - everything is set in software
#	over the network. The unit listens for broadcasts on 20560/udp,
#	and it responds to specially-formatted packets with information about
#	the unit's configuration. We make several queries attempting to
#	discover multiple units on the network, and this is the default
#	mode. Then, if the user has provided updated data such as IP
#	address or gateway, and if the unit being programmed has been
#	unambiguously identified, we'll send another datagram with those
#	new parameters.
#
# COMMAND LINE PARAMS
# -------------------
#
# --help        Show a brief help listing to the standard error stream
#               and exit with failure status.
#
# --nosend      This suppresses actually sending the update packets
#               to the unit, and it's only really useful when testing
#               the code itself (say, when adding a new field). It is
#               not very useful unless --verbose or --dumpbinary are
#               also provided.
#
# --dumpbinary  Show the full binary dump of the data (but not reset)
#               packets sent, and the responses received. This is only
#               useful if you're developing the code itself.
#
# --ip=IP       Set the unit's IP address to IP. This only accept an IP
#               address, not a DNS hostname, on very limited validation
#               is done on the IP address given.
#
# --mask=IP     Set the unit's subnet mask to IP. This has very little
#               validation.
#
# --gw=IP       Set the unit's default gateway to IP. 
#
# --unit=N      Select unit N on a multi-device network. This is typically
#               used after the base query is done, showing all the devices
#               found on the network (each with a program-generated unit
#               number starting at 1). If more than one unit is found,
#               its number is given with --unit
#
# --pass=PW     To change the password of the unit
#
# --multi       TRUE if we might find more than one unit [default]
#
# --nomulti     Presume there is only one unit on the network
#
# --verbose     Show a bit more debugging
#
# --ntries      Number of times to query network with each available query
#               string.
#
# --dhcp=BF     Set or unset the EnableDHCP option, and the Boolean flag
#               can be on/off yes/no true/false 1/0
#
# --dumppacket	Dump the received packet in binary for debugging
#
# ISSUES
# ------
#
# * We don't have a way to programmatically turn DHCP off on the print
#   server. We've tried a few things, but it wasn't worth it: just set
#   an IP address with hpsutil and telnet to the unit to do the rest.
#
# * We've found that the H-PS1U sometimes won't respond to our magic
#   packets. We don't know if this is a big in their firmware or a
#   a result of our having taken the thing apart so many times.
#
# * We've not actually tested this with multiple printservers on a
#   network.
#
# HISTORY
# -------
# v1.00 (2003/03/03) - Initial Release
#
# v1.01 (2003/04/21) - Added --pass=PW (changes from Chad Vogelsong)
#
# v1.02 (2003/07/13) - rotate through several query strings because
#	the various Hawking units use different ones (prompted by a
#	report from Dave Rugh).
#
# v1.03 (2004/03/06) - added the --dhcp param (suggested by Kevin Weeks)
#
# v1.04 (2004/03/11) - actually *tested* the --dhcp param (sorry Kevin)
#                   and added --dumpbinary and --nosend parameters.
#

use strict;
use English;
use IO::Socket;
use IO::Select;
use IO::File;

my $version = "hpsutil 1.04 - 2004-03-11 - http://www.unixwiz.net/tools/";

# ------------------------------------------------------------------------
# QUERY STRINGS
#
# We have observed several different formats of query packets sent from
# PSAdmin, and it may be that different products use different strings.
# So we have a list of them here that we rotate through in the main loop.
#

my @QUERIES = (
	"NET\0\4",
	"NET\0\4\1",
	"ZO\0\1",
);

my $queryaddr     = "255.255.255.255";  # local broadcast
my $port          = 20560;              # UDP

my $param_newip   = undef;              # cmd line params
my $param_newgw   = undef;
my $param_newmask = undef;
my $param_newpw   = undef;

my $newip         = undef;              # internal, converted params
my $newgw         = undef;
my $newmask       = undef;
my $newdhcp       = undef;

my $wantunit      = 0;
my $multi         = 1;
my $verbose       = 0;
my $ntries        = 3;
my $timeout       = 1.5;	# seconds
my $dumpbinary    = 0;
my $nosend        = 0;

foreach ( @ARGV )
{
	if ( m/^--help/i )
	{
		print STDERR <<EOF;
$version

usage: $0 [options]

  --help        Show this brief help listing
  --version     Show the program's version number and exit
  --dumpbinary  Dump the received packet in binary for debugging
  --nosend      Show the update packets we'd send, but don't do it

  --ip=IP       Set the unit's IP address to IP
  --mask=IP     Set the unit's subnet mask to IP
  --gw=IP       Set the unit's default gateway to IP
  --unit=N      Select unit N on a multi-device network
  --pass=PW     Set the unit's password to PW

  --multi       TRUE if we might find more than one unit
  --nomulti     We don't expect more than one unit on the network
  --verbose     Show a bit more debugging
  --ntries      Number of times to try each query string (default = $ntries)
  --dhcp=FL     Turn DHCP on or off (FL==true/on/yes/1 or false/off/no/0)

        This queries the local network for Hawking H-PS1U print servers,
        and it reports all that are found. If ip/mask/gw/dhcp values are
        set, then it attempts to *set* the parameters given. It's an error
        to provide --dhcp with the IP-specific params.

        If more than one unit is found on the network, parameters can only
        be set if the --unit parameter is given to set unit 1,2,...

EOF
		exit 1;
	}
	elsif ( m/^--verbose$/i )               # --verbose
	{
		$verbose++;
	}
	elsif ( m/^--version$/ )                # --version
	{
		print "$version\n";
		exit 0;
	}
	elsif ( m/^--ip=(.+)$/ )                # --ip=IP
	{
		$param_newip = $1;
	}
	elsif ( m/^--dumpbinary$/ )             # --dumpbinary
	{
		$dumpbinary = 1;
	}
	elsif ( m/^--gw=(.+)$/ )                # --gw=IP
	{
		$param_newgw = $1;
	}
	elsif ( m/^--nosend$/ )                 # --nosend
	{
		$nosend = 1;
	}
	elsif ( m/^--mask=(.+)$/ )              # --mask=MASK
	{
		$param_newmask = $1;
	}
	elsif ( m/^--pass=(.+)$/ )              # --pass=PW
	{
		$param_newpw = $1;
	}
	elsif ( m/^--unit=(\d+)$/ )             # --unit=N
	{
		$wantunit = $1;

		die "ERROR: can't set --unit=0\n" if $wantunit == 0;
	}
	elsif ( m/^--ntries=(\d+)$/ )           # --ntries=N
	{
		$ntries = $1;
	}
	elsif ( m/^--(no)?multi$/ )             # --multi
	{
		$multi = defined $1 ? 0 : 1;
	}
	elsif ( m/^--dhcp=(true|yes|on|1)$/i )
	{
		$newdhcp = chr(0x1);
	}
	elsif ( m/^--dhcp=(false|no|off|0)$/i )
	{
		$newdhcp = chr(0x0);
	}
	else
	{
		die "ERROR: {$_} is invalid cmdline param (try --help)\n";
	}
}

# ------------------------------------------------------------------------
# SANITY CHECK ON PARAMETERS
#
#	There are a few parameters that the user can specify, and we need
#	to turn them into the internal binary form suitable for plugging
#	back into the datagram sent back to the caller.
#

die "ERROR: invalid --ip param {$param_newip}\n"
	if defined $param_newip 
	   and  not defined ( $newip = ascii_to_ipaddr($param_newip) );

die "ERROR: invalid --gw param {$param_newgw}\n"
	if defined $param_newgw
	   and not defined ( $newgw = ascii_to_ipaddr($param_newgw) );

die "ERROR: invalid --mask param {$param_newmask}\n"
	if defined $param_newmask
	   and not defined ( $newmask = ascii_to_ipaddr($param_newmask) );

# ------------------------------------------------------------------------
# STUFF TO REPORT
#
# We have decoded many of the parameters in the big packet, and some of
# them are worth reporting to the user upon a query. But they're not ALL
# worth querying, so we comment out many that we don't care about.
#
# NOTE: a few fields MUST not be commented out because they are referred
# to by the program specifically.
#
#	MACAddress / IPAddress / Netmask / Gateway / EnableDHCP
#
# You'd probably never want to comment these out anyway.
#

my %FIELDS = (
	MACAddress	=> { Offset=> 0x006, Len=>  6, Conv => \&cvt_mac },
	PrinterName	=> { Offset=> 0x00E, Len=> 18                    },
	IPAddress	=> { Offset=> 0x022, Len=>  4, Conv => \&cvt_IP  },
	Password	=> { Offset=> 0x02A, Len=>  7                    },
	Firmware	=> { Offset=> 0x033, Len=> 16                    },
  #	NetwareName	=> { Offset=> 0x153, Len=> 15                    },
	Netmask		=> { Offset=> 0x184, Len=>  4, Conv => \&cvt_IP  },
	Gateway		=> { Offset=> 0x188, Len=>  4, Conv => \&cvt_IP  },
	EnableDHCP	=> { Offset=> 0x18C, Len=>  1, Conv => \&cvt_bool },
	SNMPContact 	=> { Offset=> 0x18E, Len=> 15                    },
	SNMPLocation    => { Offset=> 0x19E, Len=> 24                    },
	SNMPCommunity1	=> { Offset=> 0x1B7, Len=> 12                    },
	SNMPCommunity2	=> { Offset=> 0x1C4, Len=> 12                    },
	SNMPConfig      => { Offset=> 0x1D1, Len=>  1, Conv => \&cvt_snmp },
	SNMPTrapLoc1    => { Offset=> 0x1D2, Len=>  4, Conv => \&cvt_IP  },
	SNMPTrapLoc2    => { Offset=> 0x1D6, Len=>  4, Conv => \&cvt_IP  },
  #	AppletalkZone   => { Offset=> 0x1FF, Len=> 32                    },
  #	AppletalkPort   => { Offset=> 0x220, Len=> 12                    },
  #	AppletalkPType  => { Offset=> 0x22D, Len=> 20                    },
);

my $them  = pack_sockaddr_in($port, inet_aton($queryaddr));
my $proto = getprotobyname('udp');

my $UDPSOCK = IO::Socket::INET->new(Proto => 'udp')
        or die "ERROR: cannot create socket ($EVAL_ERROR)\n";

if ( not $UDPSOCK->sockopt(SO_BROADCAST, 1) )
{
	die "ERROR: cannot set broadcast on socket [$EVAL_ERROR]\n";
}

my %REPLIES = ();

my $rselect = IO::Select->new( $UDPSOCK );

$ntries *= scalar @QUERIES;

for ( my $tryno = 0; $tryno < $ntries; $tryno++ )
{
	# ----------------------------------------------------------------
	# FIGURE OUT MAGIC PACKET
	#
	# As we cycle through the # of tries, rotate through the next
	# query string in turn. Each is padded to 64 bytes, and we make
	# a printable version of the packet to report to the user.
	#

	my $try_index = $tryno % scalar(@QUERIES);

	my $querypkt = $QUERIES[$try_index];

	my $printable_packet = $querypkt;

	$querypkt = substr($querypkt . ( "\0" x 64) , 0, 64);

	# convert \# escape into printable \ + #
	$printable_packet =~ s/([\x00-\x1f])/sprintf("\\%o", ord($1))/eg;

	# ----------------------------------------------------------------
	# send the query to the local network: it's a failure if we cannot
	# do this.
	#
	print STDERR "Sending magic packet $printable_packet to $queryaddr:$port/udp\n";

	$UDPSOCK->send($querypkt, 0, $them);

	# ----------------------------------------------------------------
	# Prepare to receive responses from the network. If we're in
	# --multi mode we may get more than one, 
	#

	print STDERR "Waiting for read...\n"	if $verbose;

	while ( my @A = IO::Select->select( $rselect, undef, undef, $timeout) )
	{
		my $queryresponse = "";

		$UDPSOCK->recv( $queryresponse, 1500, 0);

		if ( $verbose )
		{
			printf "  Read %d bytes from sender\n",
				length $queryresponse;
		}

		dump_binary_packet( $queryresponse )	if $dumpbinary;

		# pick out the MAC address and file it under "replies"

		my $macaddr = cvt_mac( getField($queryresponse, "MACAddress") );

		if ( not defined $REPLIES{$macaddr} )
		{
			print "--> got new reply from $macaddr\n";

			$REPLIES{$macaddr} = $queryresponse;
		}

		last if not $multi;
	}

	last if ( not $multi  and %REPLIES );

	print "(timeout)\n" if $verbose;
}

my $unitcount = scalar keys %REPLIES;

die "No print servers found\n" if $unitcount == 0;

print "\n";


my $unitno = 1;

my %XREF = ();

foreach my $mac ( sort keys %REPLIES )
{
	my $querybuf = $REPLIES{$mac};

	printf "[UNIT %d]\n", $unitno;

	$XREF{$unitno++} = $mac;

	show_packet( $querybuf );

}

# ------------------------------------------------------------------------
# If we are only querying - not setting - then we're done. Otherwise we
# have to figure out which of the replies is interesting. Of course, if
# there is only *one* reply, that makes it a bit easier.
#

exit 0     if not defined $newip
          and not defined $newgw
          and not defined $newmask
          and not defined $newdhcp
          and not defined $param_newpw;

if ( $unitcount > 1  and   $wantunit == 0 )
{
	die "ERROR: More than one unit found, must identify with --unit\n";
}

if ( defined $wantunit   and  $wantunit > $unitcount )
{
	die "ERROR: --unit=$wantunit given, but not that many units found\n";
}
$wantunit = 1	if not $wantunit;

my $wantmac = $XREF{$wantunit};

if ( not defined $wantmac )
{
	die "ERROR: --unit=$wantunit given, but not that many units found\n";
}

printf "Sending configuration packet to unit $wantunit ($wantmac)\n\n";

my $buf = $REPLIES{$wantmac};

substr($buf, 0, 5) = "NETP\1";	# required for programming

setField(\$buf, "IPAddress",  $newip)		if $newip;
setField(\$buf, "Netmask",    $newmask)		if $newmask;
setField(\$buf, "Gateway",    $newgw)		if $newgw;
setField(\$buf, "Password",   $param_newpw)	if $param_newpw;
setField(\$buf, "EnableDHCP", $newdhcp)		if defined $newdhcp;

dump_binary_packet($buf)	if $dumpbinary;

show_packet( $buf )		if $verbose;

$UDPSOCK->send($buf, 0, $them)		unless $nosend;

# ------------------------------------------------------------------------
# We found out very late that sending this packet seems to be required in
# order to save & reset the unit. But: it's really only supposed to be sent
# to the one unit in question, but we're sending to broadcast. Feel free
# to fix this if you care to.
#
my $resetpkt = substr( "NET\0\10" . ( "\0" x 64),  # packet contents
                       0,                          # start offset
                       64 );                       # length

print "Sending save-and-reset packet\n";

$UDPSOCK->send($resetpkt, 0, $them)	unless $nosend;


#
# setField()
#
#	Given a ref to a query response buffer, *set* the contents of the
#	given field to the value provided. The value is already in direct
#	binary notation, so no conversion need be done. This does no I/O,
#	only changes the referenced buffer (and never changes the length).
#

sub setField {
	my $qref  = shift;
	my $field = shift;
	my $value = shift;


	my $ref = $FIELDS{$field};

	die "ERROR: setField($field) is bogus fieldname\n" if not $ref;

	printf "Setting $field to length %d [%d/%d] {$value}\n",
		length $value,
		$ref->{Offset},
		$ref->{Len}			if $verbose;

	substr($$qref, $ref->{Offset}, $ref->{Len} ) = $value;
}

sub getField {
	my $qbuf  = shift;
	my $field = shift;

	my $ref = $FIELDS{$field};

	die "ERROR: getField($field) is bogus fieldname\n" if not $ref;

	return substr($qbuf, $ref->{Offset}, $ref->{Len});
}

#
# ascii_to_ipaddr()
#
#	Given a printable version of an IP address, convert it to the
#	internal form. Return undef if it's a bogus address.
#

sub ascii_to_ipaddr {

	my $addr = shift;

	return undef	unless $addr =~ m/^\d+\.\d+\.\d+\.\d+$/;

	return inet_aton($addr);
}

# ------------------------------------------------------------------------
# CONVERSION UTILS
#
# The data we get from the parameters packet is mostly in binary, so we
# have utilities that convert to printable form. These are all included by
# reference in the %FIELDS table above.
#
# These are all internal->printable conversions.
#

sub cvt_mac {
	my $addr = shift;

	my @PARTS = split( m//, $addr );

	return join(":", map { sprintf("%02X", ord($_)) } @PARTS);
}

#
# cvt_IP()
#
#	Internal IP -> printable
#
sub cvt_IP {
	return inet_ntoa(shift);
}

#
# cvt_snmp()
#
#	There is a single bitmapped byte that describes the SNMP config
#	and we pick apart the bit values here into printable strings.
#

sub cvt_snmp {
	my $byte = ord(shift);

	my @INFO = ();

	if ( ($byte & 0x08) == 0 )
	{
		push @INFO, "Comm#1 disabled";
	}
	elsif ( $byte & 0x10 )
	{
		push @INFO, "Comm#1 R/W";
	}
	else
	{
		push @INFO, "Comm#1 R/O";
	}

	if ( ($byte & 0x20) == 0 )
	{
		push @INFO, "Comm#2 disabled";
	}
	elsif ( $byte & 0x40 )
	{
		push @INFO, "Comm#2 R/W";
	}
	else
	{
		push @INFO, "Comm#2 R/O";
	}

	push @INFO, "Enable traps"	if $byte & 0x01;
	push @INFO, "Auth Traps"	if $byte & 0x02;

	return join("; ", @INFO);
}

#
# cvt_bool()
#
#	Given binary 1/0, return printable yes/no
#

sub cvt_bool {

	my $value = ord(shift);

	return $value ? "Yes($value)" : "No";
}

#
# show_packet()
#
#	This is used to show the fields in a packet for easy display.
#
sub show_packet {
	my $buf = shift;

	foreach my $key ( sort keys %FIELDS )
	{
		my $ref = $FIELDS{$key};

		my $rawvalue = substr($buf, $ref->{Offset}, $ref->{Len});

		if ( $ref->{Conv} )
		{
			$rawvalue = &{ $ref->{Conv} }($rawvalue);
		}

		$rawvalue =~ s/\x00//g;		# dump NUL bytes

		printf STDOUT "    %-20s = {%s}\n", $key, $rawvalue;
	}
}

sub dump_binary_packet {
	my $packet = shift;
my $len = length $packet;
	my $ix  = 0;

	while ( $ix < $len )
	{
		my $wantlen = $len - $ix;

		$wantlen = 16	if $wantlen > 16;

		my $sub = substr($packet, $ix, $wantlen);

		$sub =~ s/(.)/sprintf(" %02X", ord($1))/esg;

		printf("%04x  $sub\n", $ix);

		$ix += $wantlen;
	}
}