package NGCP::Rtpengine::AutoTest;

use strict;
use warnings;
use NGCP::Rtpengine::Test;
use NGCP::Rtpclient::SRTP;
use Test::More;
use File::Temp;
use IPC::Open3;
use Time::HiRes;
use POSIX ":sys_wait_h";
use IO::Socket;
use Exporter;


our @ISA;
our @EXPORT;

BEGIN {
	require Exporter;
	@ISA = qw(Exporter);
	our @EXPORT = qw(autotest_start new_call offer answer ft tt snd srtp_snd rtp rcv srtp_rcv
		srtp_dec escape rtpm rtpmre reverse_tags new_tt crlf sdp_split rtpe_req offer_answer
		autotest_init subscribe_request subscribe_answer publish);
};


my $rtpe_stdout;
my $rtpe_stderr;
my $rtpe_pid;
my $c;
my ($cid, $ft, $tt, @sockets, $tag_iter, $tag_suffix);


sub autotest_start {
	my (@cmdline) = @_;

	like $ENV{LD_PRELOAD}, qr/tests-preload/, 'LD_PRELOAD present';
	is $ENV{RTPE_PRELOAD_TEST_ACTIVE}, '1', 'preload library is active';
	SKIP: {
		skip 'daemon is running externally', 1 if $ENV{RTPE_TEST_NO_LAUNCH};
		ok -x $ENV{RTPE_BIN}, 'RTPE_BIN points to executable';
	}

	$rtpe_stdout = File::Temp->new(
		TEMPLATE => 'rtpe-out.XXXXXXXXXX',
		TMPDIR => 1,
	) or die;
	$rtpe_stderr = File::Temp->new(
		TEMPLATE => 'rtpe-err.XXXXXXXXXX',
		TMPDIR => 1,
	) or die;
	SKIP: {
		skip 'daemon is running externally', 1 if $ENV{RTPE_TEST_NO_LAUNCH};
		local $ENV{GLIB_SLICE} = 'debug-blocks';
		$rtpe_pid = open3(undef, '>&'.fileno($rtpe_stdout), '>&'.fileno($rtpe_stderr),
			$ENV{RTPE_BIN}, @cmdline);
		ok $rtpe_pid, 'daemon launched in background';
	}

	return autotest_init();
}

sub autotest_init {
	# keep trying to connect to the control socket while daemon is starting up
	for (1 .. 300) {
		$c = NGCP::Rtpengine->new($ENV{RTPENGINE_HOST} // '127.0.0.1', $ENV{RTPENGINE_PORT} // 2223);
		last if $c->{socket};
		Time::HiRes::usleep(100000); # 100 ms x 300 = 30 sec
	}

	1;
	$c->{socket} or die;

	$tag_iter = 0;
	$tag_suffix = '-' . rand();

	my $r = $c->req({command => 'ping'});
	ok $r->{result} eq 'pong', 'ping works, daemon operational';

	return 1;
}

sub new_call {
	my @ports = @_;
	for my $s (@sockets) {
		$s->close();
	}
	@sockets = ();
	$cid = $tag_iter++ . "-test-callID" . $tag_suffix;
	$ft = $tag_iter++ . "-test-fromtag" . $tag_suffix;
	$tt = $tag_iter++ . "-test-totag" . $tag_suffix;
	print("new call $cid\n");
	for my $p (@ports) {
		my ($addr, $port) = @{$p};
		my $s = IO::Socket::IP->new(Type => &SOCK_DGRAM, Proto => 'udp',
				LocalHost => $addr, LocalPort => $port)
				or die;
		push(@sockets, $s);
	}
	return @sockets;
}
sub crlf {
	my ($s) = @_;
	$s =~ s/\r\n/\n/gs;
	return $s;
}
sub sdp_split {
	my ($s) = @_;
	return split(/--------*\n/, $s);
}
sub rtpe_req {
	my ($cmd, $name, $req) = @_;
	$req->{command} = $cmd;
	$req->{'call-id'} = $cid;
	my $resp = $c->req($req);
	is $resp->{result}, 'ok', "$name - '$cmd' status";
	return $resp;
}
sub sdp_match {
	my ($cmd, $name, $sdp, $exp) = @_;
	my $regexp = "^\Q$exp\E\$";
	$regexp =~ s/\\\?/./gs;
	$regexp =~ s/PORT/(\\d{1,5})/gs;
	$regexp =~ s/ICEBASE/([0-9a-zA-Z]{16})/gs;
	$regexp =~ s/ICEUFRAG/([0-9a-zA-Z]{8})/gs;
	$regexp =~ s/ICEPWD/([0-9a-zA-Z]{26})/gs;
	$regexp =~ s/CRYPTO128S/([0-9a-zA-Z\/+]{38})/gs;
	$regexp =~ s/CRYPTO128/([0-9a-zA-Z\/+]{40})/gs;
	$regexp =~ s/CRYPTO192/([0-9a-zA-Z\/+]{51})/gs;
	$regexp =~ s/CRYPTO256S/([0-9a-zA-Z\/+]{59})/gs;
	$regexp =~ s/CRYPTO256/([0-9a-zA-Z\/+]{62})/gs;
	$regexp =~ s/LOOPER/([0-9a-f]{12})/gs;
	$regexp =~ s/FINGERPRINT256/([0-9a-fA-F:]{95})/gs;
	$regexp =~ s/FINGERPRINT/([0-9a-fA-F:]{59})/gs;
	$regexp =~ s/SDP_VERSION/\\d+ \\d+/gs;
	$regexp =~ s/RTPE_VERSION/rtpengine-\\S+/gs;
	my $crlf = crlf($sdp);
	like $crlf, qr/$regexp/s, "$name - output '$cmd' SDP";
	my @matches = $crlf =~ qr/$regexp/s;
	return @matches;
}
sub offer_answer {
	my ($cmd, $name, $req, $sdps) = @_;
	my ($sdp_in, $exp_sdp_out) = sdp_split($sdps);
	$req->{'from-tag'} = $ft;
	$req->{sdp} = $sdp_in;
	my $resp = rtpe_req($cmd, $name, $req);
	return sdp_match($cmd, $name, $resp->{sdp}, $exp_sdp_out);
}
sub offer {
	return offer_answer('offer', @_);
}
sub answer {
	my ($name, $req, $sdps) = @_;
	$req->{'to-tag'} = $tt;
	return offer_answer('answer', $name, $req, $sdps);
}
sub subscribe_request {
	my ($name, $req, $sdp_exp) = @_;
	my $resp = rtpe_req('subscribe request', $name, $req);
	my @matches = sdp_match('subscribe request', $name, $resp->{sdp}, $sdp_exp);
	return ($resp->{'from-tag'}, $resp->{'to-tag'}, @matches);
}
sub subscribe_answer {
	my ($name, $req, $sdp) = @_;
	$req->{sdp} = $sdp;
	my $resp = rtpe_req('subscribe answer', $name, $req);
}
sub publish {
	return offer_answer('publish', @_);
}
sub snd {
	my ($sock, $dest, $packet, $addr) = @_;
	$sock->send($packet, 0, pack_sockaddr_in($dest, inet_aton($addr // '203.0.113.1'))) or die;
}
sub srtp_snd {
	my ($sock, $dest, $packet, $srtp_ctx, $addr) = @_;
	if (!$srtp_ctx->{skey}) {
		my ($key, $salt) = NGCP::Rtpclient::SRTP::decode_inline_base64($srtp_ctx->{key}, $srtp_ctx->{cs});
		@$srtp_ctx{qw(skey sauth ssalt)} = NGCP::Rtpclient::SRTP::gen_rtp_session_keys($key, $salt);
	}
	my ($enc, $out_roc) = NGCP::Rtpclient::SRTP::encrypt_rtp(@$srtp_ctx{qw(cs skey ssalt sauth roc)},
		'', 0, 0, 0, $packet);
	$srtp_ctx->{roc} = $out_roc;
	$sock->send($enc, 0, pack_sockaddr_in($dest, inet_aton($addr // '203.0.113.1'))) or die;
}
sub rtp {
	my ($pt, $seq, $ts, $ssrc, $payload) = @_;
	print("rtp in $pt $seq $ts $ssrc\n");
	return pack('CCnNN a*', 0x80, $pt, $seq, $ts, $ssrc, $payload);
}
sub rcv {
	my ($sock, $port, $match, $cb, $cb_arg) = @_;
	my $p = '';
	local $SIG{ALRM} = sub { exit(-10) };
	alarm(1);
	my $addr = $sock->recv($p, 65535, 0) or die;
	alarm(0);
	my ($hdr_mark, $pt, $seq, $ts, $ssrc, $payload) = unpack('CCnNN a*', $p);
	if ($payload) {
		print("rtp recv $pt $seq $ts $ssrc " . unpack('H*', $payload) . "\n");
	}
	if ($cb) {
		$p = $cb->($hdr_mark, $pt, $seq, $ts, $ssrc, $payload, $p, $cb_arg);
	}
	if ($p !~ $match) {
		print(unpack('H*', $p) . "\n");
	}
	like $p, $match, 'received packet matches';
	my @matches = $p =~ $match;
	for my $m (@matches) {
		if (length($m) == 2) {
			($m) = unpack('n', $m);
		}
		elsif (length($m) == 4) {
			($m) = unpack('N', $m);
		}
	}
	if ($port == -1 && @matches) {
		# this is actually wrong and uses the fake Unix domain socket address.
		# translation should really be handled by the preloaded .so back to
		# fake v4/v6 address.
		$addr =~ /\]:(\d+)/s or die;
		unshift(@matches, $1);
	}
	return @matches;
}
sub srtp_rcv {
	my ($sock, $port, $match, $srtp_ctx) = @_;
	return rcv($sock, $port, $match, \&srtp_dec, $srtp_ctx);
}
sub srtp_dec {
	my ($hdr_mark, $pt, $seq, $ts, $ssrc, $payload, $pack, $srtp_ctx) = @_;
	if (!$srtp_ctx->{skey}) {
		my ($key, $salt) = NGCP::Rtpclient::SRTP::decode_inline_base64($srtp_ctx->{key}, $srtp_ctx->{cs});
		@$srtp_ctx{qw(skey sauth ssalt)} = NGCP::Rtpclient::SRTP::gen_rtp_session_keys($key, $salt);
	}
	my ($dec, $out_roc, $tag, $hmac) = NGCP::Rtpclient::SRTP::decrypt_rtp(@$srtp_ctx{qw(cs skey ssalt sauth roc)}, $pack);
	$srtp_ctx->{roc} = $out_roc;
	is $tag, substr($hmac, 0, length($tag)), 'SRTP auth tag matches';
	return $dec;
}
sub escape {
	return "\Q$_[0]\E";
}
sub rtpmre {
	my ($pt, $seq, $ts, $ssrc, $xre) = @_;
	#print("rtp matcher $pt $seq $ts $ssrc $xre\n");
	my $re = '';
	$re .= escape(pack('C', 0x80));
	$re .= escape(pack('C', $pt));
	$re .= $seq >= 0 ? escape(pack('n', $seq)) : '(..)';
	$re .= $ts >= 0 ? escape(pack('N', $ts)) : '(....)';
	$re .= $ssrc >= 0 ? escape(pack('N', $ssrc)) : '(....)';
	$re .= $xre;
	return qr/^$re$/s;
}
sub rtpm {
	my ($pt, $seq, $ts, $ssrc, $payload, $alt_payload) = @_;
	if (!$alt_payload) {
		return rtpmre($pt, $seq, $ts, $ssrc, escape($payload));
	}
	return rtpmre($pt, $seq, $ts, $ssrc, '(' . escape($payload) . '|' . escape($alt_payload) . ')');
}

sub ft { return $ft; }
sub tt { return $tt; }

sub reverse_tags {
	($tt, $ft) = ($ft, $tt);
}
sub new_tt {
	$tt = $tag_iter++ . "-test-totag" . $tag_suffix;
}

sub terminate {
	my $msg = shift;

	$rtpe_stdout->unlink_on_destroy(0);
	$rtpe_stderr->unlink_on_destroy(0);

	print "hint: rtpe stdout output is at $rtpe_stdout\n";
	print "hint: rtpe stderr output is at $rtpe_stderr\n";

	die "error: $msg\n";
}


END {
	if ($rtpe_pid) {
		kill('INT', $rtpe_pid) or terminate("cannot interrupt rtpe");
		# wait for daemon to terminate
		my $status = -1;
		for (1 .. 50) {
			$status = waitpid($rtpe_pid, WNOHANG);
			last if $status != 0;
			Time::HiRes::usleep(100000); # 100 ms x 50 = 5 sec
		}
		kill('KILL', $rtpe_pid) if $status == 0;
		$status == $rtpe_pid or terminate("cannot wait for process $rtpe_pid: $status: $!");
		$? == 0 or terminate("process exited with $?");
	}
}



1;