#!/usr/bin/perl -w

# adapted from perlipc(1)

use strict;
use Socket;
use POSIX 'strftime';
my ($remote,$port, $iaddr, $paddr, $proto, $line);
my $seq_nr = 0;

$remote  = shift || 'localhost';
$port    = shift || 2345;  # random port
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr   = inet_aton($remote)               || die "no host: $remote";
$paddr   = sockaddr_in($port, $iaddr);

$proto   = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
connect(SOCK, $paddr)    || die "connect: $!";

exit 1 if ping_pong_with_guard_bytes();

close (SOCK)            || die "close: $!";
exit;

sub logmsg { print strftime("%F %T", localtime), " $0 $$: @_\n" }

sub random_packet()
{
	# TODO: add checksum
	my $p_len = int(rand(33000));
	pack("Nnn", 0xb1b2b3b4, 0x3333, $p_len + 4) .
	("\x55" x $p_len) . pack("N", 0xe4e3e2e1);
}

sub receive_and_validate_packet {
	my ($hdr, $payload, $magic, $cmd, $len);
	$hdr = "\xff\xee\xdd\xcc" x 1024; # stupid; just to see where the corruption is from.
	if (!defined(recv SOCK, $hdr, 8, MSG_WAITALL)) {
		logmsg "recv hdr error [$seq_nr]: $!";
		return 1;
	}
	if (length($hdr) != 8) {
		logmsg "recv hdr [$seq_nr]: too short: ",
			join " ", map { sprintf "%02x", $_ } unpack "C*", $hdr;
		return 1;
	}
	($magic, $cmd, $len) = unpack "Nnn", $hdr;
	if ($magic != 0xb1b2b3b4) {
		logmsg "recv hdr [$seq_nr]: invalid magic: ",
			join " ", map { sprintf "%02x", $_ } unpack "C*", $hdr;
		return 1;
	}
	if (!defined(recv SOCK, $payload, $len, MSG_WAITALL)) {
		logmsg "recv payload error [$seq_nr]: $!";
		return 1;
	}
	my $plen = length($payload);
	my $p_last_4 = substr($payload, -4, 4);
	my $p_trail_magic = unpack "N", $p_last_4;
	if ($plen != $len) {
		logmsg "recv payload [$seq_nr]: expected $len, but received $plen byte; last bytes received: ",
			join " ", map { sprintf "%02x", $_ } unpack "C*", $p_last_4;
		return 1;
	}
	if ($p_trail_magic != 0xe4e3e2e1) {
		logmsg "recv payload [$seq_nr]: invalid trailing magic; last bytes received: ",
			join " ", map { sprintf "%02x", $_ } unpack "C*", $p_last_4;
		return 1;
	}
	++$seq_nr;
	return 0;
}

sub send_random_packet() {
	my $p = random_packet();
	my $p_len = length($p);
	# this is supposedly a blocking send,
	# so it should send the whole packet!
	my $s_len = send SOCK, $p, 0;
	if (!defined($s_len)) {
		logmsg "send error: $!";
		return 1;
	}
	if ($s_len != $p_len) {
		logmsg "send error: wanted to send $p_len, but could only send $s_len bytes";
		return 1;
	}
}

sub ping_pong_with_guard_bytes {
	my $ret;
	while (1) {
		$ret = send_random_packet();
		return $ret if $ret;
		$ret = receive_and_validate_packet();
		return $ret if $ret;
	}
}
