#!/usr/bin/perl

# Panasonic KX-TA624 Data Dumper
# Copyright 2006 Russ Price
#
# This program will dump a KX-TA624's configuration
# data into a text file that may be loaded back into
# it via the kxbatch utility.
#
# $Id: kxdump,v 1.3 2006/08/08 00:02:50 root Exp $
# $Log: kxdump,v $
# Revision 1.3  2006/08/08 00:02:50  root
# don't accept NUL characters from PBX
#
# Revision 1.2  2006/08/07 19:32:48  root
# Improved capture facility, added command line parameters,
# terse status messages.
#
# Revision 1.1  2006/08/07 18:54:41  root
# Initial revision
#


use Device::SerialPort 0.12;

sub usage {
	print STDOUT "\nUsage: $0 pass type outfile\n\npass is the Panasonic system password\n\ntype is the type of data dump:\n  ALL\tdump all data\n  SYS\tdump system parameters\n  COT\tdump CO trunk parameters\n  EXT\tdump extension parameters\n  DSS\tdump DSS console parameters\n  DOR\tdump doorphone parameters\n\n";
	exit(1);
}

if(scalar @ARGV != 3) { usage(); }

($pwd, $cmd, $dumpfile) = @ARGV;
$cmd = uc($cmd);
if(!($cmd =~ m/ALL|SYS|COT|EXT|DSS|DOR/o)) { usage(); }

$SIG{'INT'} = \&death;
$SIG{'TERM'} = \&death;

$|++;
$PORT      = "/dev/ttyS0";          # port to use
$BAUD = 9600;
$PARITY = "none";
$BITS = 8;
$FLOW = "xoff";

sub death {
undef $ob;
print STDOUT "Shut down.\n";
close;
exit(0);
}

# Open serial port.

$ob = Device::SerialPort->new ($PORT) || die "Can't Open $PORT: $!";
$ob->baudrate($BAUD)   || die "failed setting baudrate";
$ob->parity($PARITY)   || die "failed setting parity";
$ob->databits($BITS)   || die "failed setting databits";
$ob->handshake($FLOW)  || die "failed setting handshake";
$ob->write_settings    || die "no settings";

# Send a CR to wake the system up, and be sure to soak up
# any character that might be waiting.

$pass=$ob->write("\r");
sleep 1;

# We're going to use regular file I/O here on out.
open(DEV, "+<$PORT") 
    || die "Cannot open $PORT: $_";

$foo = getc(DEV);
print "Beginning data dump\n";

# kxsend: Sends a string to the PBX. Waits for each character
# to be echoed to prevent overrunning the PBX's limited or
# non-existent input buffer.

sub kxsend($) {
	my ($cmd) = @_;
	my $i;
	my $len = length $cmd;
	my $out, $in;

	$cmd .= "\r";

	for($i=0; $i<$len; $i++) {
		$out = substr($cmd, $i, 1);
		print DEV $out;
		$in = getc(DEV);
		if($in ne $out) {
			print STDOUT "Command [$cmd] failed.\n";
			exit(1);
		}
		if($in eq '\r') { $in = getc(DEV); }
	}
}

# waitfor: Wait for a command prompt string;
# it will optionally capture data if a file name is
# supplied.  Only complete lines will be captured.
sub waitfor {
	my ($match, $outfile) = @_;
	my $mcount = 0, $c;
	my $max = length $match;
	my $line = "";
	my $linecount = 0;

	if($outfile) { open(OUT, ">$outfile"); }

	do {
		$c = getc(DEV);
		if(ord($c)) {		# no NULs please!
			$line .= $c;
			if($c eq "\n") {
				# This logic prevents the recording of
				# incomplete lines (and thus won't record the prompt)
				if($outfile) {
					print OUT $line;
					printf(STDOUT "Lines received: %d\r", ++$linecount);
				}
				$line = "";
				$mcount = 0;
			}
			elsif($c eq substr($match, $mcount, 1)) { $mcount++; }
		}
	} while($mcount < $max);
	if($outfile) {
		close OUT;
		print STDOUT "\n";
	};
}

print STDOUT "Establishing contact with PBX on $PORT\n";
kxsend("TA624\r");		# magic sequence to activate PBX command interface
waitfor(";>");
kxsend("DMP\r");		# enter Dump mode
waitfor("Password : \026");
kxsend("$pwd\r");		# send password
waitfor(";P>");
print STDOUT "Sending $cmd command to PBX\n";
kxsend("$cmd\r");		# send appropriate dump command
waitfor(";P>", $dumpfile);	# grab the data
kxsend("BYE\r");		# tell PBX to resume normal operation
print STDOUT "Dump completed.\n";

undef $ob;