#!/usr/bin/perl -w
# $Id: mmlink.pl,v 1.16 2003/04/26 15:52:10 dick Exp $
#======================================================================#
# mmlink - Communicate with a Nokia Mediamaster running DVB2000
#
# Note: DVB2000 version 1.77.0 or higher is required.
#
# (c) 1999-2003, Dick Streefland
#======================================================================#

use strict;
use Fcntl;
use POSIX qw(:termios_h);
require "getopts.pl";

$::device = "/dev/mediamaster";
$::baudrate = 38400;

my $name = $0;
$name =~ s/.*\///;
my $usage =
"Usage: $name [options] [file]
Communicate with a Nokia Mediamaster running DVB2000
Options:
  -V                show DVB2000 version number
  -d                specify serial port device (default $::device)
  -b                specify baudrate for serial port (default $::baudrate)
  -c                download channel settings
  -C                upload channel settings
  -s                download general settings
  -S                upload general settings
  -U                upgrade DVB2000 (max. 700kb)
  -B                load new firmware via the B2.00UnS bootloader
  -t                download Teletext font
  -T                upload Teletext font
  -y                download system font
  -Y                upload system font
  -I                upload MP2 intro sound (requires more than 1Mb FlashROM!)
  -1                upload picture 1 (default startup picture)
  -2                upload picture 2 (other picture)
  -m<begin>-<end>   download memory
  -M<begin>         upload into RAM memory
  -F<begin>         upload into Flash memory (units of 64k)
  -p                show parental lock code
  -P<xxxx>          change parental lock code
  -z                get current channel number
  -Z<chan>          zap to another channel
  -o<file>          specify output file
  -R                reboot
  -G                run subroutine
  -D<string>        show <string> on front panel display
  -X<cmd>           issue CBEG command <cmd>
  -v                verbose operation";

# --- process commandline:
$::opt_V = 0;
$::opt_d = "";
$::opt_b = "";
$::opt_c = 0;
$::opt_C = 0;
$::opt_s = 0;
$::opt_S = 0;
$::opt_U = 0;
$::opt_B = 0;
$::opt_t = 0;
$::opt_T = 0;
$::opt_y = 0;
$::opt_Y = 0;
$::opt_I = 0;
$::opt_1 = 0;
$::opt_2 = 0;
$::opt_m = "";
$::opt_M = "";
$::opt_F = "";
$::opt_p = 0;
$::opt_P = "";
$::opt_z = 0;
$::opt_Z = "";
$::opt_o = "";
$::opt_R = 0;
$::opt_G = 0;
$::opt_D = "";
$::opt_X = "";
$::opt_v = 0;
if	(  @ARGV == 0
	|| ! &Getopts( "Vd:b:cCsSUBtTyYI12m:M:F:pP:zZ:o:RGD:vX:" )
	|| @ARGV > 1
	)
{
	&error( $usage );
}
$::device   = $::opt_d if $::opt_d ne "";
$::baudrate = $::opt_b if $::opt_b ne "";
$::baudrate = 19200 if $::opt_B;	# baudrate of B2.00UnS is fixed
if	( @ARGV == 1 )
{
	open( STDIN, $ARGV[0] ) || &error( "cannot open \"$ARGV[0]\"" );
}
if	( $::opt_o ne "" )
{
	open( STDOUT, ">$::opt_o" ) || &error( "cannot create \"$::opt_o\"" );
}

# --- open and initialize the serial port:
sysopen( RS232, $::device, O_RDWR|O_NONBLOCK ) || &error( "cannot open \"$::device\"" );
fcntl( RS232, F_SETFL, fcntl( RS232, F_GETFL, 0 ) & ~ O_NONBLOCK );
my $termios = POSIX::Termios->new();
$termios->getattr(fileno(RS232)) || &error( "getattr: $!" );
my $iflag = $termios->getiflag();	# default: 0x0500
my $oflag = $termios->getoflag();	# default: 0x0005
my $cflag = $termios->getcflag();	# default: 0x0cbd
my $lflag = $termios->getlflag();	# default: 0x8a3b
$iflag = 0;
$oflag = 0;
$cflag &= ~(CSIZE|CSTOPB|PARENB|PARODD|HUPCL);
$cflag |= (CS8|CREAD|CLOCAL);
$lflag = 0;
$termios->setiflag($iflag);
$termios->setoflag($oflag);
$termios->setcflag($cflag);
$termios->setlflag($lflag);
my $baud = eval("B".$::baudrate) || &error( "invalid baudrate: $::baudrate" );
$termios->setispeed($baud)       || &error( "setispeed: $!" );
$termios->setospeed($baud)       || &error( "setospeed: $!" );
$termios->setcc(VMIN, 1);
$termios->setcc(VTIME, 0);
$termios->setattr(fileno(RS232), TCIOFLUSH) || &error( "setattr: $!" );
$termios->setattr(fileno(RS232), TCSANOW)   || &error( "setattr: $!" );

# --- init:
my $oldfile = select RS232;
$| = 1;
select $oldfile;
$| = 1;
&crc_init;
my $inbuf = "";

# --- main:
&command( "E", 0 )			if $::opt_V;
&command( "R", 0 )			if $::opt_R;
&get_channels				if $::opt_c;
&put_channels				if $::opt_C;
&get_settings				if $::opt_s;
&put_settings				if $::opt_S;
&get_memory( "D", $::opt_m )		if $::opt_m;
&put_memory( "U", $::opt_M, &stdin )	if $::opt_M;
&put_memory( "F", $::opt_F, &stdin )	if $::opt_F;
&put_memory( "F", 0x00020000, &stdin )	if $::opt_U;
&get_memory( "T", "0x0000-0x3200" )	if $::opt_t;
&command( "V", 1 )			if $::opt_T;
&get_memory( "Y", "0x0000-0x1000" )	if $::opt_y;
&command( "F", 1 )			if $::opt_Y;
&show_channel				if $::opt_z;
&zap_channel( $::opt_Z )		if $::opt_Z;
&parental_lock()			if $::opt_p;
&parental_lock( $::opt_P )		if $::opt_P;
&go					if $::opt_G;
&put_sound				if $::opt_I;
&command( "4\0\0\0\0", 1 )		if $::opt_1;
&command( "5\0\0\0\0", 1 )		if $::opt_2;
&command( "Y$::opt_D        ", 0 )	if $::opt_D;
&command( $::opt_X, (@ARGV == 1) )	if $::opt_X;
&download_firmware			if $::opt_B;

close( RS232 );

# ----------------------------------------------------------------------
# Commands
# ----------------------------------------------------------------------

sub	command ()
{
	my( $cmd, $send_file ) = @_;
	my( $data, $reply );

	print STDERR "Command: $cmd\n" if $::opt_v;
	if	( $send_file )
	{
		sysread( STDIN, $data, 1024 * 1024 );
		$data = &add_checksum( $data );
	}
	cbeg();
	print RS232 "$cmd";
	if	( $send_file )
	{
		&send_string( $data );
	}
	$reply = &get_reply;
	print $reply if defined $reply;
}

sub	get_channels ()
{
	my( $reply, $len, $channels, $sum );

	cbeg();
	print RS232 "B";
	$reply = &get_reply;
	$len = length( $reply ) - 1;
	$channels = int( $len / 64 );
	printf STDERR "Downloaded %d channels\n", $channels if $::opt_v;
	if	( 64 * $channels != $len )
	{
		print STDERR "Wrong size for channel settings\n";
	}
	$reply = &remove_checksum( $reply );
	print $reply;
}

sub	put_channels ()
{
	my( $settings, $n );

	$n = sysread( STDIN, $settings, 1000000 );
	if	(  ($n % 64) != 0
		|| $n < 10 * 64
		|| $n > 0x30000
		|| $settings !~ /^DVSO/
		)
	{
		&error( "Bad channel settings file" );
	}
	$settings = &add_checksum( $settings );
	printf STDERR "Uploading %d channels\n", $n / 64 if $::opt_v;
	cbeg();
	printf RS232 "C%08X", $n;
	&ok;
	&send_string( $settings );
}

sub	get_settings ()
{
	print &read_settings;
}

sub	put_settings ()
{
	my( $settings );

	sysread( STDIN, $settings, 9999 );
	&write_settings( $settings );
}

sub	get_memory ()
{
	my( $cmd, $range ) = @_;
	my( $begin, $end ) = split( /-/, $range );
	my( $data, $n, $todo, $len );

	# --- start remote code and send command:
	$begin = eval( $begin );
	$end   = eval( $end  );
	&start_remote( $cmd, $begin, $end );
	&ack if $cmd ne "D";

	# --- read data in 1k blocks:
	$::crc = 0xffff;
	$len = $end - $begin;
	for	( $todo = $len; $todo > 0; $todo -= $n )
	{
		print RS232 "d";
		printf STDERR "\r%6x ", $len - $todo if $::opt_v;
		$n = ($todo > 1024 ? 1024 : $todo);
		$data = &mmread( $n, 0.2 );
		print $data;
		&crc( $data );
		$n = length $data;
		&error( "timeout" ) if $n == 0;
	}

	# --- read and check CRC16:
	print RS232 "d";
	printf STDERR "\r%6x\n", $len if $::opt_v;
	$data = &mmread( 2, 0.2 );
	print RS232 "d";
	&crc( $data );
	&error( "CRC error" ) unless $::crc == 0;
}

sub	put_memory ()
{
	my( $cmd, $begin, $data ) = @_;
	my( $end, $len, $k, $offset );

	# --- perform some sanity checks, start remote code and send command:
	$len   = length( $data );
	$begin = eval( $begin );
	$end   = $begin + $len;
	if	(  $begin == 0x00020000	# firmware download ?
		&& (  $data =~ /^DVSO/	# settings file ?
		   || $data =~ /^PK/	# .ZIP file ?
		   || $len < 300000	# minimum size for firmware
		   )
		)
	{
		&error( "What are you doing?" );
	}
	if	( $cmd eq 'F' && $len > 700 * 1024 )
	{
		if	( $begin == 0x00020000 )
		{
			&error( "firmware too large - use the -B option" );
		}
		else
		{
			&error( "cannot flash more than 700kb at a time" );
		}
	}
	&start_remote( $cmd, $begin, $end );

	# --- send data in 1k blocks:
	$::crc = 0xffff;
	$offset = 0;
	while	( $offset < length $data )
	{
		&ack;
		printf STDERR "\r%6x ", $offset if $::opt_v;
		$k = substr( $data, $offset, 1024 );
		$offset += 1024;
		print RS232 $k;
		&crc( $k );
	}

	# --- send CRC16 and wait for ACK:
	&ack;
	printf STDERR "\r%6x\n", $len if $::opt_v;
	&crc( "\0\0" );
	print RS232 pack( "n", $::crc );
	&ack;

	# --- wait for additional acks for flash programming
	if	( $cmd eq "F" )
	{
		&ack;		# 2nd CRC check
		&ack;		# write
		&ack;		# verify
	}
}

sub	show_channel ()
{
	my( $chan );

	cbeg();
	printf RS232 "L";
	$chan = &get_reply;
	$chan =~ s/[\r\n]//g;
	printf "%d\n", hex $chan;
}

sub	zap_channel ()
{
	my( $chan ) = @_;

	cbeg();
	printf RS232 "Z%04d", $chan;
	&get_reply;
}

sub	parental_lock ()
{
	my( $newpin ) = @_;
	my( $settings, $oldpin );

	$settings = &read_settings;
	$oldpin = unpack "n", substr( $settings, 0x440, 2 );
	if	( defined $newpin )
	{
		$newpin = hex $newpin;
		printf STDERR "Changing code from %04x to %04x\n",
			$oldpin, $newpin if $::opt_v;
		substr( $settings, 0x440, 2 ) = pack "n", $newpin;
		&write_settings( $settings );
	}
	else
	{
		printf STDERR "%04x\n", $oldpin;
	}
}

sub	put_sound ()
{
	my( $mp2, $header );

	$mp2 = &stdin;
	$header = pack( "NNN", 0x12345678, 0x0010000c, length( $mp2 ) );
	&put_memory( "F", 0x00100000, $header . $mp2 );
}

sub	go ()
{
	my( $sbr, $output );

	sysread( STDIN, $sbr, 1000000 );
	&run( $sbr );
	while	( $output = &mmread( 1, 1.0 ), length $output > 0 )
	{
		print $output;
	}
	print "\n";
}

# ----------------------------------------------------------------------
# Firmware download via B2.00UnS bootloader
# ----------------------------------------------------------------------

sub	download_firmware ()
{
	my( $file )   = &stdin;
	my( $len )    = length $file;
	my( $blocks ) = ($len + 0xffff) >> 16 ;
	my( $code, $block, $chunk, $chlen );

	# --- sanity checks
	if	( $file =~ /^DVSO/ || $file =~ /^PK/ || $len < 300000 )
	{
		&error( "What do you think you are doing?" );
	}

	# --- wait for the reboot of the Mediamaster
	print STDERR
	"Disconnect the power for a moment to start the firmware download.\n";
	while	( &zmmread( 1, 3.0 ) ne "F" )
	{
	}

	# --- send the firmware in chunks of 64k
	&recv_file;	# 09 03
	&send_file( 0, pack( "NC6V", 0x11000000, 1, 1, 1,
				$blocks, 1, 0x66, 0 ) );
	while	( 1 )
	{
		($code, $block) = unpack "C2", &recv_file;	# 07 <block>
		last if $code != 7;				# 09 01
		$chunk = substr( $file, $block * 0x10000, 0x10000 );
		$chlen = length $chunk;
		&send_file( 0, pack( "C2NCN3", 0x22, $block, $chlen, $block+2,
					0, $chlen & 0xffff, 0x10000 ) );
		&recv_file;	# 09 01
		printf STDERR "block %2d/%d: 00000 ", $block+1, $blocks
			if $::opt_v;
		&send_file( 1, $chunk );
	}
	while	( &zmmread( 1, 0.2 ) ne "" )
	{
	}
}

sub	recv_file ()
{
	my( $data, $frameend );

	&zhex(  1, 0x2b010000 );	# ZRINIT
		&zexpect_header( 4 );
		&zgetdata;		# 128 bytes
	&zhex(  9, 0x00000000 );	# ZRPOS
		&zexpect_header( 10 );
		($data, $frameend) = &zgetdata;
	&zhex(  3, length $data );	# ZACK
		&zexpect_header( 10 );
		&zgetdata;
		&zexpect_header( 11 );
	&zhex(  1, 0x2b010000 );	# ZRINIT
		&zexpect_header( 8 );
	&zhex(  8, 0x00000000 );	# ZFIN
	return $data;
}

sub	send_file ()
{
	my( $large, $file ) = @_;
	my( $len ) = length $file;
	my( $buf, $frames, $pos, $i, $end, $type );

		&zexpect_header( 1 );
	&zbin(  4, 0 );			# ZFILE
	$buf = sprintf "%d", $len;
	$buf .= "\0" x (128 - length $buf);
	&zdata( $buf, 'k' );
		&zexpect_header( 9 );
	$frames = ($large ? 4 : 1);
	for	( $pos = 0; $pos < $len; )
	{
		&zbin( 10, $pos );	# ZDATA
		printf STDERR "\b\b\b\b\b\b%5x ", $pos if $::opt_v && $large;
		for	( $i = 0; $i < $frames && $pos <= $len; $i++ )
		{
			$end = 'i';
			$end = 'k' if $i == $frames - 1;
			$end = 'h' if $pos + 128 > $len && $large;
			&zdata( substr( $file, $pos, 128 ), $end );
			$pos += 128;
		}
		last if $end eq 'h';
		($type, $pos) = &zgetheader;
		if	( $type == 3 )	# ZACK
		{
			$frames = 4;
		}
		elsif	( $type == 9 )	# ZRPOS
		{
			$frames = 1;
		}
		else
		{
			&error( "unexpected frame type 0x%02x", $type );
		}
	}
	printf STDERR "\b\b\b\b\b\b%5x\n", $len if $::opt_v && $large;
	if	( $end eq 'k' )
	{
		&zbin( 10, $len );	# ZDATA
		&zdata( "", 'h' );
	}
	&zbin( 11, $len );		# ZEOF
		&zexpect_header( 1 );
	&zhex(  8, 0 );			# ZFIN
		&zexpect_header( 8 );
	&zsend( "OO" );
}

sub	zsend ()		# send string to Mediamaster
{
	print RS232 $_[0];
}

sub	zsendesc ()		# ZDLE escape and send data
{
	my( $buf ) = @_;

	$buf =~ s/\x18/\x18\x58/g;
	$buf =~ s/\x11/\x18\x51/g;
	$buf =~ s/\x91/\x18\xd1/g;
	$buf =~ s/\x13/\x18\x53/g;
	$buf =~ s/\x93/\x18\xd3/g;
	&zsend( $buf );
}

sub	zbin ()			# send Z-MODEM binary header
{
	my( $type, $pos ) = @_;

	$::crc = 0;
	&crc( pack( "CVn", $type, $pos, 0 ) );
	&zsend( "*\x18A" );
	&zsendesc( pack( "CVn", $type, $pos, $::crc ) );
}

sub	zhex ()			# send Z-MODEM hex header
{
	my( $type, $pos ) = @_;

	$::crc = 0;
	&crc( pack( "CVn", $type, $pos, 0 ) );
	$pos = unpack( "V", pack( "N", $pos ) );
	&zsend( sprintf( "**\x18B%02x%08x%04x\r\x8a", $type, $pos, $::crc ) );
	&zsend( "\x11" ) if $type == 1;
	&zsend( "\x11\x11" ) if $type == 9;
}

sub	zdata ()		# send binary data frame
{
	my( $buf, $frameend ) = @_;

	$::crc = 0;
	&crc( "$buf$frameend\0\0" );
	&zsendesc( $buf );
	&zsend( "\x18$frameend" );
	&zsendesc( pack( "n", $::crc ) );
	&zsend( "\x11" ) if $frameend eq 'k';
}

sub	zmmread # ( count, timeout )
{
	my( $len, $timeout ) = @_;

	return &mmread( $len, $timeout );
}

sub	zrecv ()		# receive one or more character
{
	my( $len ) = @_;
	my( $missing, $s );

	if	( $len > length $inbuf )
	{	# try to read multiple bytes at once to reduce syscall overhead
		$inbuf .= &zmmread( 64, 0.001 );
	}
	$missing = $len - length $inbuf;
	if	( $missing > 0 )
	{
		$inbuf .= &zmmread( $missing, 5.0 );
		&error( "timeout" ) if length $inbuf < $len;
	}
	$s = substr( $inbuf, 0, $len );
	$inbuf = substr( $inbuf, $len );
	return $s;
}

sub	zrecvesc ()		# receive string and remove ZDLE escapes
{
	my( $len ) = @_;
	my( $buf, $c );

	$buf = "";
	while	( $len > 0 )
	{
		$c = &zrecv( 1 );
		if	( $c eq "\x18" )
		{
			$c = &zrecv( 1 ) ^ 0x40;
		}
		$buf .= $c;
		$len--;
	}
	return $buf;
}

sub	zgetdata ()		# get data frame
{
	my( $c, $buf, $crc );

	$buf = "";
	while	( 1 )
	{
		$c = &zrecv( 1 );
		if	( $c eq "\x18" )
		{
			$c = &zrecv( 1 );
			last if (ord( $c ) & 0x60) != 0x40;
			$c = chr( ord( $c ) ^ 0x40 );
		}
		$buf .= $c;
	}
	$crc = &zrecvesc( 2 );
	$::crc = 0;
	&crc( "$buf$c$crc" );
	&error( "bad CRC in binary data frame" ) unless $::crc == 0;
	return ($buf, $c);
}

sub	zgetheader ()		# get Z-MODEM header
{
	my( $c, $type, $pos, $crc, $header );

	do
	{
		$c = &zrecv( 1 );
	} while	( $c =~ /[\x11*O]/ );
	&error( "start of frame expected" ) unless $c eq "\x18";
	$c = &zrecv( 1 );
	if	( $c eq 'A' )	# binary header
	{
		$header = &zrecvesc( 7 );
		$::crc = 0;
		&crc( $header );
		&error( "bad CRC in binary header" ) unless $::crc == 0;
		($type, $pos) = unpack( "CV", $header );
	}
	elsif	( $c eq 'B' )	# ASCII header
	{
		$header = &zrecv( 16 );
		if	( ! ($header =~ /^(\w{2})(\w{8})(\w{4})\r\x8a$/) )
		{
			&error( "bad binary header" );
		}
		$type = hex $1;
		$pos  = unpack( "V", pack( "N", hex $2 ) );
		$crc  = hex $3;
		$::crc = 0;
		&crc( pack( "CVn", $type, $pos, $crc ) );
		&error( "bad CRC in hex header" ) unless $::crc == 0;
	}
	elsif	( $c eq "\x18" )
	{
		&error( "transfer aborted by Mediamaster" );
	}
	else
	{
		&error( "bad header type 0x%02x", ord $c );
	}
	return ($type, $pos);
}

sub	zexpect_header ()	# get header and check the type
{
	my( $expected ) = @_;
	my( $type, $pos );

	do			# crude hack to drop retransmissions
	{
		($type, $pos) = &zgetheader;
		if      ( $type != $expected && ($type == 4 || $type == 10) )
		{
			&zgetdata;
		}
	} while	( $type != $expected && $type == $::prev_header );
	$::prev_header = $type;
	&error( "expected header 0x%02x, got 0x%02x", $expected, $type )
		if $type ne $expected;
	return $pos;
}

# ----------------------------------------------------------------------
# Subroutines
# ----------------------------------------------------------------------

sub	cbeg ()
{
	my( $i );

	for	( $i = 1; $i < 5; $i++ )
	{
		print RS232 "CBEG";
		return if mmread( 5, 0.2 ) eq "\rOK\r\n";
		printf STDERR "Retry #%d\n", $i if $::opt_v;
	}
	&error( "MediaMaster doesn't respond" );
}

sub	get_reply ()
{
	my( $c, $reply, $bytes );

	$bytes = 0;
	while	( $c = &mmread( 64, 0.2 ), length $c > 0 )
	{
		$bytes += length $c;
		printf STDERR "\r%6x ", $bytes if $::opt_v;
		$reply .= $c;
	}
	print STDERR "\n" if $::opt_v;
	return $reply;
}

sub	send_string ()
{
	my( $string ) = @_;
	my( $offset, $sub );

	$offset = 0;
	while	( $offset < length $string )
	{
		printf STDERR "\r%6x ", $offset if $::opt_v;
		$sub = substr( $string, $offset, 64 );
		$offset += 64;
		print RS232 $sub;
	}
	printf STDERR "\r%6x\n", length $string if $::opt_v;
}

sub	mmread # ( count, timeout )
{
	my( $count, $timeout ) = @_;
	my( $string, $n );
	my( $rin );

	$rin = '';
	vec($rin,fileno(RS232),1) = 1;
	$string = "";
	while	( $count > 0 )
	{
		last if select( $rin, undef, undef, $timeout ) == 0;
		$n = sysread( RS232, $string, $count, length $string );
		if	( ! defined $n )
		{
			&error( "read error" );
		}
		$count -= $n;
	}
	return $string;
}

sub	run ()
{
	my( $sbr ) = @_;
	my( $len );

	$len = length $sbr;
	$sbr = &add_checksum( $sbr );
	printf STDERR "Uploading %d code bytes\n", $len if $::opt_v;
	cbeg();
	printf RS232 "D%08X", $len;
	&ok;
	&send_string( $sbr );
	&ok;
}

sub	ok ()
{
	my( $s );

	$s = mmread( 5, 1.0 );
	if	( $s ne "\rOK\r\n" )
	{
		&error( "Unexpected reply: \"%s\"", $s );
	}
}

sub	start_remote ()
{
	my( $cmd, $begin, $end ) = @_;
	my( $sbr ) = "";

	# --- download & start remote subroutine:
	$sbr .= unpack( "u", $_ ) while <DATA>;
	&error( "__END__ part missing -- use \"mmlink\", not \"mmlink.pl\"" )
		if $sbr eq "";
	&run( $sbr );
	&ack;

	# --- send command with checksum and wait for ack:
	$cmd .= pack( "NN", $begin, $end );
	$::crc = 0xffff;
	&crc( "$cmd\0\0" );
	$cmd .= pack( "n", $::crc );
	print RS232 $cmd;
	&ack;
}

sub	ack ()
{
	my( $reply );

	do
	{
		$reply = &mmread( 1, 5.0 );
	} while	( $reply eq "." );
	if	( $reply ne "+" )
	{
		$reply = &mmread( 40, 0.2 ) if $reply eq "-";
		chomp $reply;
		$reply = "no reply" unless $reply;
		&error( "Error: %s", $reply );
	}
}

sub	read_settings ()
{
	my( $reply, $len, $sum );

	cbeg();
	print RS232 "G";
	$reply = &get_reply;
	$len = length( $reply ) - 1;
	if	( $len != 1264 )
	{
		print STDERR "Wrong size for general settings\n";
	}
	$reply = &remove_checksum( $reply );
	return $reply;
}

sub	write_settings ()
{
	my( $settings ) = @_;

	if	( length $settings != 1264 )
	{
		&error( "Bad general settings file" );
	}
	$settings = &add_checksum( $settings );
	cbeg();
	print RS232 "H";
	&send_string( $settings );
	&ok;
}

sub	stdin ()
{
	my( $data );

	sysread( STDIN, $data, 3 * 1024 * 1024 );
	return $data;
}

# ----------------------------------------------------------------------
# XOR checksum
# ----------------------------------------------------------------------

sub	xorsum # ( string )
{
	my( $string ) = @_;
	my( $sum );
	local( $_ );

	$sum = 0;
	map { $sum ^= $_; } unpack( "N*", "$string\0\0\0" );
	$sum ^= $sum >> 16;
	$sum ^= $sum >> 8;
	return $sum & 0xff;
}

sub	add_checksum # ( data )
{
	my( $data ) = @_;
	my( $sum );

	$sum = &xorsum( $data ) ^ 0x55;
	$data .= chr $sum;
	return $data;
}

sub	remove_checksum # ( data )
{
	my( $data ) = @_;
	my( $len, $chk, $sum );

	$len = length( $data ) - 1;
	$chk = ord substr( $data, $len, 1 );
	chop $data;		# drop checksum byte
	$sum = &xorsum( $data ) ^ 0x55;
	if	( $sum != $chk )
	{
		print STDERR "Incorrect checksum\n";
	}
	return $data;
}

# ----------------------------------------------------------------------
# CRC calculation
# ----------------------------------------------------------------------

sub	crc_slow ()
{
	my( $crc, $byte ) = @_;

	$byte |= 0x100;
	until	( $byte & 0x10000 )
	{
		$crc <<= 1;
		$crc++ if $byte & 0x80;
		$crc ^= 0x11021 if $crc & 0x10000;
		$byte <<= 1;
	}
	return $crc;
}

sub	crc_init ()
{
	my( $i );

	for	( $i = 0; $i < 256; $i++ )
	{
		$::crc_tab[$i] = &crc_slow( $i << 8, 0 );
	}
}

sub	crc ()
{
	my( $byte );

	foreach $byte ( unpack "C*", $_[0] )
	{
		$::crc = (($::crc & 0xff) << 8 | $byte) ^ $::crc_tab[$::crc >> 8];
	}
}

# ----------------------------------------------------------------------
# Error message
# ----------------------------------------------------------------------

sub	error ()
{
	printf STDERR @_;
	printf STDERR "\n";
	exit 1;
}

# ----------------------------------------------------------------------
# Subroutine for up/download
# ----------------------------------------------------------------------

__END__
M2.?_^$;\)P`H3V$``YIA``4&<"MA``.T<O]A``0F80`#*!@`80`$2&$``Q0F
M0&$`!#YA``,*)@"6BV$`!`9A``,(80`#_F$``P!!^@A'2D%F-G`K80`#='+_
M=``,!`!$9P``W`P$`%5G``%Z#`0`1F<``0@,!`!49P``2@P$`%EG``!40?H'
M\G`M80`#/F$``VAA``-V80`"6BY,<`%A``)@#`0`1F<*1OP@`$S?'_].=4'Z
M![MA``(Z3G!*.:JJJJI@_C`\+CPJ/```,@`F/```,@!@$#`\+CPJ/```#_\F
M/```$``B?``"```F?``-``"P66<*L\MF^$'Z![I@B+J19NX,:4GY__AFYB9I
M__IP*V$``K9@)B`"`D`#_V8080`!HF$``QP,``!D9@#_6A`S*`!2@F$``I)A
M``(,M(-EUF$``8!P`&$``?YA``'Z80`"\`P``&1F`/\N,`'A6&$``FCA6&$`
M`F)A``+6#```9&8`_Q1@`/\D0?H&PF$``7(,@P`*\`!!^@;W8@#^^D'Z!OA*
M2V8`_O!!^OYD(GP!"O``,#P(P!+84<C__"Y\`0L``"A/(DLF?`$```!.^0$*
M\>0@`@)``_]F"F$``/9P*V$``?9A``)J%X`H`&$``6A2@K:"9MQA``#:<"MA
M``':80`"3F$``5`:`.%-80`"0F$``40:`$'Z!HE*068`_GAP*V$``;0,!`!&
M9@#^?G#_8`87@"@`4H)*0F<(#((`"O``9>Y!^@8/80`#'F$``2)R_V$``3HP
M!6$``.I!^@9,2D%F`/XR<"MA``%N0?H%\&$``(Y!^@7O80``AB!+(@,&@0``
M__](029)8`YP+F$``4AA``("80`"4%')__!P*V$``39!^@7'80`"OG+_80``
MWC`%80``CD'Z!?E*068`_=9P*V$``1)!^@6J83)@`/W:2.>`@%&/0=<@`NJ`
MZH!A1!#\`"\@`^J`ZH!A.!"\`&M!UV$``G)0CTS?`0%.=2\`80`"9'`4800@
M'TYU2.?``"(\``&^;5.!9OQ3@&;R3-\``TYU2.?``')D@,$&```P$,#@@."`
M@OP`"F;N3-\``TYUX5AA#N%88`IA```"80```N&82.>@`'0'XP#C460$"D$0
M(5'*__1,WP`%3G5(Y^"`0?H%6'``=``R`F'6,,$&0@$`9O1,WP$'3G5(YZ#0
M0?H%.D/S.`!T`&`,X5D4`1(;,#`B`+%!M\EE\$S?"P5.=2\(('P`__``$7P`
MJ@<=$7P`DP<0$7P`!P<@$7P`!0<2(%].=4CG0(`@?`#_\``B/``I,N!3@6L2
M""@``@<19_010`<33-\!`DYU0?H$NV``_*!(YX"`8`)ARA`89OI,WP$!3G4O
M`'`-8;IP"F&V(!].=4CGX`!T!R(`Z9DP`0(```\,```*900&```G!@``,&&2
M4<K_YDS?``=.=2\(('P`__``(#P`*3+@4X!K$@@H```'$6?T<``0*`<3(%].
M=4'Z!$5@`/P<2.=@`'(`=`-ARN&9@@!1RO_X(`%,WP`&3G5(YP`81^D*JDGI
M!506O`"J&+P`51:\`(`6O`"J&+P`51*\`#`3?``P0``3?``P8``3O``P`7``
M`(``"!$`!6?Z%KP`JAB\`%46O`#P3-\8`$YU2.?`&$?I"JI)Z054,CQ__Q:\
M`*H8O`!5%KP`H#`8,H"P46;\5(E1R?_H%KP`JAB\`%46O`#P3-\8`TYU+P`>
M.0$````(QP`"$\<`__`1$#P`X6$$(!].=2\!"(<``A/'`/_P$7('XAA5^0,`
M!@!1R?_V",<``A/'`/_P$2(?3G5(Y^#`$CP`H&`F$`%ARE(!`D(`?P1"`"!K
M]L3\``=#^@`D0_$@`'0&$!EAK%'*__H4&&8$="!3B`P!`*AES$S?`P=.=0``
M```````$!`0$!``$"@H```````H*'PH?"@H$#Q0.!1X$&!D"!`@3`P@4%`@5
M$@P,#`0(`````@0$!`0$`@@$!`0$!`@`"@0?!`H```0$'P0$`````!@8"!``
M```?```````````,#``!`@0($``.$1$1$1$.!`P$!`0$#@X1`08($!\.$0$.
M`1$.`@8*$A\"`A\0'@$!`1X&"!`>$1$.'P$"!`@("`X1$0X1$0X.$1$/`0(,
M``P,``P,``P,``P,!`@!`@0(!`(!```?`!\``!`(!`($"!`.$0$"!``$#A$7
M%1<0#@X1$1\1$1$>$1$>$1$>#A$0$!`1#AX1$1$1$1X?$!`>$!`?'Q`0'A`0
M$`X1$!`3$0X1$1$?$1$1#@0$!`0$#@$!`0$!$0X1$A08%!(1$!`0$!`0'Q$;
M%141$1$1$1D5$Q$1#A$1$1$1#AX1$1X0$!`.$1$1%1(-'A$1'A02$0X1$`X!
M$0X?!`0$!`0$$1$1$1$1#A$1$0H*!`01$1$5%1L1$1$*!`H1$1$1"@0$!`0?
M`0($"!`?!P0$!`0$!P`0"`0"`0`<!`0$!`0<!`X1`````````````!\,#`@$
M```````.$A(2#1`0$!89$1X```X0$!$.`0$!#1,1#P``#A$>$`X$"@@<"`@(
M```/$0\!!A`0%AD1$1$`!``,!`0.`@`&`@(2#!`0$A08%!(,!`0$!`0.```*
M%1$1$0``%AD1$1$```X1$1$.```>$1D6$```#Q$3#0$```L,"`@(```.$`X!
M'@@('`@("@0```D)"0L%```1$1$*!```$1$5%0H``!$*!`H1```1"@0$"```
M'P($"!\"!`0(!`0"!`0$!`0$!`@$!`($!`@```@5`@``'Q$1$1$1'T9L87-H
M:6YG`$-H96-K:6YG`$-20R!/2P!7<FET:6YG`%9E<FEF>0!&;&%S:"!/2P!2
M96)O;W0N+@!"860@8VUD(0!4;V\@8FEG(0!.;R!A;&EG;@!"860@0U)#(0!2
C04T@17)R(0!&86EL960A`%1I;65O=70A`$YO=$9O=6YD````
`
