#!/usr/bin/perl
#
# talk to a SAP gateway server
#
# 2006-03-04
#
# jwa@jammed.com
#

use IO::Socket;

use strict;

my $str = 

#24290:    \0\0\0 n

	chr(0) . chr(0) . chr(0) . "n" .

#24290:     * * M E S S A G E * *\004\0 -\0\0\0 -\0\0\0 M s I A t t a c h\0

	"**MESSAGE**" . chr(0) . chr(4) . chr(0) . "-" . chr(0) x 3 . "-" . chr(0) x3 . "MsIAttach" . chr(0) .

#24290:    \0\0 m s x x i _ m t . c\0\0 m s x x i _ m t\0\0\0\0\0\0\0\0\0\0

	chr(0) x 2 . "msxxi_mt.c" . chr(0) x 2 . "msxxi_mt" . chr(0) x 10 .

#24290:    \0\0\0\b -\0\0\0 -\0\0\0 l g x x _ m t . c\0\0\0 L g G r o u p\0

	chr(0) x 3 . "b-" . chr(0) x 3 . "-" . chr(0) x 3 . "lgx_mt.c" . chr(0) x 3 . "LgGroup" . chr(0) . 

#24290:     L g G r o u p S n c\0\0\0\0

	"LgGroupsSnc" . chr(0) x 4;

#24290:  recv(9, 0xF9AC3E05, 4, 0)                       Err#11 EAGAIN




# 00 00 00 6e 
# pkt length, big endian

my @msg = qw/
                              0000 006e 2a2a 4d45
          5353 4147 452a 2a00 0400 2d00 0000 2d00
          0000 4d73 4941 7474 6163 6800 0000 6d73
          7878 695f 6d74 2e63 0000 6d73 7878 695f
          6d74 0000 0000 0000 0000 0000 0000 0008
          2d00 0000 2d00 0000 6c67 7878 5f6d 742e 
          6300 0000 4c67 4772 6f75 7000 4c67 4772  
          6f75 7053 6e63 0000 0000
	/;

my @msg2 = qw
	/
                            0000 00fa 2a2a 4d45  
        5353 4147 452a 2a00 0400 2d00 0000 2d00
        0000 3f00 0000 3f00 0000 3f00 0000 3f00
        0000 4d73 4275 6643 6f6e 7665 7274 4672
        6f6d 0000 0000 0000 0000 0000 0000 0405 
        2d20 2020 2020 2020 2020 2020 2020 2020  
        2020 2020 2020 2020 2020 2020 2020 2020  
        2020 2020 2020 2020 0000 4144 2d45 5945  
        4341 5443 4800 0101 2020 2020 2020 2020
        3130 3420 2020 2020 2020 2020 2031 1500
        0000 0c14 0028 0000 0000 0000 0000 0000
        0000 0000 0000 0000 0000 0000 0000 0000
        0000 0000 0000 0000 0000 0000 0000 0000
        0000 0000 0000 0000 0000 0000 0000 0000
        0000 0000 0000 0000 0000 0000 0000 0000 
        0000 0000 0000 0000 0000 0000 0000 0000 
        0000 0000 0000                           
	/;



my $host = shift @ARGV || die "usage: $0 host [port]";
my $port = shift @ARGV || 3600;

print "trying $host:$port ...\n";

my $sock = IO::Socket::INET->new( 
	PeerAddr => $host,
	PeerPort => $port,
	Proto => 'tcp', 
	Type => SOCK_STREAM, 
	Timeout => 30) || die "connect: $!";

my $bytes;
my $buf;

$str = hexify(@msg);

select(STDOUT);$|=1;

print "writing msg1 [" . length($str) . " bytes]\n";

syswrite($sock, $str, length($str)) || die "write: $!";

# extract length bytes
sysread($sock, $buf, 4);
my $len = unpack("N", $buf);
print "response length: $len\n";

$bytes = sysread($sock, $buf, $len);
{
	print "$buf\n";
}
print "got $bytes bytes\n";


$str = hexify(@msg2);
print "writing msg2 [" . length($str) . " bytes]\n";

syswrite($sock, $str, length($str)) || die "write: $!";

# extract length bytes
sysread($sock, $buf, 4);
#print "buf: [$buf]\n";
my $len = unpack("N", $buf);
print "response length: $len\n";

my $bytes;
my $out;

while ($bytes != $len)
{
	$bytes += sysread($sock, $buf, $len);
	$out .= $buf;
}
#open(RAW, ">raw.$host");
#print RAW $out;
#close (RAW);
parse ($out);


sub parse
{
	print "\nparse\n";
	my $buf = shift @_;
#	print "$buf\n";
	# '**MESSAGE**'	 NUL
	# skip (16 * 6) + 2

	# each entry is 126 bytes long?
	# read (16 * 6)


	# count of entries is in ascii "AD-EYECATCH .. 104 .. 11" == 11?
	#
	# preamble ^L^T^@( .. 0c 14 00 28
	# end with ^A (01) then 4 bytes of IPaddr 
	# then null

	my @bites = split(/\(/, $buf);
	foreach my $bite (@bites)
	{
		my $name = substr($bite, 0, 30);
		print "Name:  [$name]\n";
		my $type = substr($bite, 29, 1);
		printf "Type:  0x%x (%d)\n", ord($type), ord($type);
		if (ord ($type) == 1)
		{
			#? 
			my $ip = substr($bite, 30, 4);
			my $ipP = join(".", unpack("C4", $ip));
			printf "IP: $ipP\n";
		}
		#print "\n";
	}
}

sub hexify
{
	my @in = @_;
	my $out;
	foreach my $x (@in)
	{
		if (length($x) == 2)
		{
			$out .= chr (hex($x));
		}
		elsif (length($x) == 4)
		{
			if ($x =~ /(..)(..)/)
			{
				my $x1 = $1;
				my $x2 = $2;
				$out .= chr(hex($x1));
				$out .= chr(hex($x2));
			}
			else
			{
				die "ooger";
			}
		}
		else
		{
			die "ugg";
		}
	}
	return $out;
}