TT#12800 add test script to simulate RTP packet loss

Change-Id: I931d2b0ee16167bf48900aee806d99a12e4c601e

perl/NGCP/Rtpclient/RTCP.pm

@@ -78,8 +78,11 @@ sub _sr {
 		$lost_frac > 255 and $lost_frac = 255;
 		$lost = $lost | ($lost_frac << 24);
 
-		$rrs .= pack('NNNNNN', $ss->{ssrc}, $ss->{packets_lost}, $ss->{seq}, $ss->{jitter}, $lsr, $dlsr);
+		$rrs .= pack('NNNNNN', $ss->{ssrc}, $lost, $ss->{seq}, $ss->{jitter}, $lsr, $dlsr);
 		$num_rrs++;
+
+		$ss->{received_last} = 0;
+		$ss->{lost_last} = 0;
 	}
 
 	# actual sr

perl/NGCP/Rtpclient/RTP.pm

@@ -7,7 +7,7 @@ use Math::BigInt;
 use Math::BigFloat;
 
 sub new {
-	my ($class, $cb_obj) = @_;
+	my ($class, $cb_obj, %args) = @_;
 
 	my $self = {};
 	bless $self, $class;
@@ -24,6 +24,7 @@ sub new {
 	$self->{packet_count} = 0;
 	$self->{octet_count} = 0;
 	$self->{other_ssrcs} = {};
+	$self->{args} = \%args;
 
 	return $self;
 }
@@ -36,7 +37,13 @@ sub timer {
 	my $hdr = pack("CCnNN", 0x80, 0x00, $self->{seq}, $self->{timestamp}->bstr(), $self->{ssrc});
 	my $payload = chr(rand(256)) x $self->{payload}; # XXX adapt to codec
 
-	$self->{cb_obj}->rtp_send($hdr . $payload);
+	my $lost = 0;
+	if (($self->{args}->{packetloss} // 0) > 0) {
+		my $r = rand(100);
+		($r < $self->{args}->{packetloss}) and $lost = 1;
+	}
+
+	$lost or $self->{cb_obj}->rtp_send($hdr . $payload);
 
 	$self->{seq}++;
 	$self->{seq} > 0xffff and $self->{seq} -= 0x10000;
@@ -121,7 +128,7 @@ sub input {
 				# seek up to the lowest seq in buffer and count each missing
 				# seq as a lost packet
 				my $min = $seqs[0];
-				$remote->{lost_since} += $min - $remote->{queue_seq};
+				$remote->{lost_last} += $min - $remote->{queue_seq};
 				$remote->{packets_lost} += $min - $remote->{queue_seq};
 				# now unqueue what we have as much as we can
 				$remote->{queue_seq} = $min;

perl/NGCP/Rtpengine/Test.pm

@@ -200,6 +200,15 @@ sub _new {
 	$self->{media_packets_received} = [0,0];
 	$self->{client_components} = [undef,undef];
 
+	$self->{args} = \%args;
+
+	# copy args for the RTP client
+	$self->{rtp_args} = {};
+	for my $k (qw(packetloss)) {
+		exists($args{$k}) or next;
+		$self->{rtp_args}->{$k} = $args{$k};
+	}
+
 	return $self;
 }
 
@@ -375,7 +384,7 @@ sub _peer_addr_check {
 sub start_rtp {
 	my ($self) = @_;
 	$self->{rtp} and die;
-	$self->{rtp} = NGCP::Rtpclient::RTP->new($self) or die;
+	$self->{rtp} = NGCP::Rtpclient::RTP->new($self, %{$self->{rtp_args}}) or die;
 	$self->{client_components}->[0] = $self->{rtp};
 }
 

t/test-packetloss.pl

@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use NGCP::Rtpengine::Test;
+use IO::Socket;
+
+my $r = NGCP::Rtpengine::Test->new();
+my ($a, $b) = $r->client_pair(
+	{
+		sockdomain => &Socket::AF_INET,
+		packetloss => 5,
+	},
+	{
+		sockdomain => &Socket::AF_INET,
+		packetloss => 10,
+	}
+);
+
+$r->timer_once(1, sub {
+		$b->answer($a, ICE => 'remove');
+		$a->start_rtp();
+		$a->start_rtcp();
+	});
+$r->timer_once(60, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove');
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();