From 0b63050c4682416698cf8c931e362a1133aebb1c Mon Sep 17 00:00:00 2001 From: Richard Fuchs Date: Tue, 11 Apr 2017 10:00:06 -0400 Subject: [PATCH] TT#12800 add test script to simulate RTP packet loss Change-Id: I931d2b0ee16167bf48900aee806d99a12e4c601e --- perl/NGCP/Rtpclient/RTCP.pm | 5 ++++- perl/NGCP/Rtpclient/RTP.pm | 13 ++++++++++--- perl/NGCP/Rtpengine/Test.pm | 11 ++++++++++- t/test-packetloss.pl | 33 +++++++++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 5 deletions(-) create mode 100755 t/test-packetloss.pl diff --git a/perl/NGCP/Rtpclient/RTCP.pm b/perl/NGCP/Rtpclient/RTCP.pm index 9e74acd27..86d9135d7 100644 --- a/perl/NGCP/Rtpclient/RTCP.pm +++ b/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 diff --git a/perl/NGCP/Rtpclient/RTP.pm b/perl/NGCP/Rtpclient/RTP.pm index 9980b7aac..7d667724b 100644 --- a/perl/NGCP/Rtpclient/RTP.pm +++ b/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; diff --git a/perl/NGCP/Rtpengine/Test.pm b/perl/NGCP/Rtpengine/Test.pm index 699a1faa4..0bab62505 100644 --- a/perl/NGCP/Rtpengine/Test.pm +++ b/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}; } diff --git a/t/test-packetloss.pl b/t/test-packetloss.pl new file mode 100755 index 000000000..35c697c31 --- /dev/null +++ b/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();