transcoding test suite improvements

Change-Id: Id7c522afe3d5060d0eb79126763454ecd25fc411

perl/NGCP/Rtpclient/RTP.pm

@@ -20,12 +20,12 @@ sub new {
 	$self->{clockrate} = 8000;
 	$self->{timestamp} = Math::BigInt->new(int(rand(2**32)));
 	$self->{seq} = rand(2**16);
-	$self->{payload} = 100;
+	$self->{payload} = $args{send_codec}{frame_len} // 100;
 	$self->{packet_count} = 0;
 	$self->{octet_count} = 0;
 	$self->{other_ssrcs} = {};
 	$self->{args} = \%args;
-	$self->{payload_type} = $args{payload_type} // 0;
+	$self->{send_codec} = $args{send_codec} // { payload_type => 0 };
 
 	return $self;
 }
@@ -35,7 +35,7 @@ sub timer {
 
 	time() < $self->{next_send} and return;
 
-	my $hdr = pack("CCnNN", 0x80, $self->{payload_type}, $self->{seq}, $self->{timestamp}->bstr(),
+	my $hdr = pack("CCnNN", 0x80, $self->{send_codec}{payload_type}, $self->{seq}, $self->{timestamp}->bstr(),
 		$self->{ssrc});
 	my $payload = chr(rand(256)) x $self->{payload}; # XXX adapt to codec
 

perl/NGCP/Rtpclient/SDP.pm

@@ -55,6 +55,12 @@ sub decode {
 
 			push(@{$attr_store->{attributes_list}}, $full);
 			push(@{$attr_store->{attributes_hash}->{$name}}, $cont);
+
+			if ($cont && $cont =~ /^(\w+) (.*)$/) {
+				my $sub = $1;
+				$cont = $2;
+				push(@{$attr_store->{attributes_hash}->{"$name:$sub"}}, $cont);
+			}
 		}
 	}
 
@@ -116,6 +122,25 @@ sub decode_address {
 	die $s;
 }
 
+sub codec_negotiate {
+	my ($self, $remote) = @_;
+	my $idx = 0;
+	while (1) {
+		my $local = $self->{medias}->[$idx];
+		my $remote = $remote->{medias}->[$idx];
+		($local && $remote) or last;
+		my @codecs_send;
+		for my $c (@{$remote->{codec_list}}) {
+			if (!$local->{codec_hash}{$c->{name}}) {
+				next;
+			}
+			push(@codecs_send, $c);
+		}
+		$local->{codecs_send} = \@codecs_send;
+		$idx++;
+	}
+}
+
 
 package NGCP::Rtpclient::SDP::Media;
 
@@ -123,18 +148,16 @@ use Socket;
 use Socket6;
 use IO::Socket;
 
+# XXX move these to a separate module?
 my %codec_map = (
-	PCMA => { payload_type => 8 },
-	PCMU => { payload_type => 0 },
+	PCMA => { payload_type => 8, frame_len => 160 },
+	PCMU => { payload_type => 0, frame_len => 160 },
 	G729 => { payload_type => 18 },
+	G723 => { payload_type => 4 },
+	G722 => { payload_type => 9 },
 );
 my %payload_type_map = map {$codec_map{$_}{payload_type} => $_} keys(%codec_map);
 
-sub _codec_list_to_hash {
-	my ($list) = @_;
-	return { map { $_ => { %{$codec_map{$_}} } } @{$list} };
-}
-
 sub new {
 	my ($class, $rtp, $rtcp, %args) = @_;
 
@@ -145,8 +168,30 @@ sub new {
 	$self->{rtcp} = $rtcp; # optional
 	$self->{protocol} = $args{protocol} // 'RTP/AVP';
 	$self->{type} = $args{type} // 'audio';
-	$self->{codec_list} = $args{codecs};
-	$self->{codecs} = _codec_list_to_hash(@{$self->{codecs}});
+
+	my $codecs = $args{codecs} // [qw(PCMU)];
+	my (@codec_list, %dyn_pt);
+	for my $c (@$codecs) {
+		my ($codec, $clockrate, $channels) = $c =~ /^(\w+)(?:\/(\d+)(?:\/(\d+))?)?$/;
+		$clockrate //= 8000; # make codec-dependent
+		$channels //= 1;
+		my $pt = { name => $codec, clockrate => $clockrate, channels => $channels };
+		my $ptdef = $codec_map{$c};
+		my $ptnum;
+		if ($ptdef) {
+			$ptnum = $ptdef->{payload_type};
+		} else {
+			$ptnum = 96;
+			while ($dyn_pt{$ptnum}) {
+				$ptnum++;
+			}
+			$dyn_pt{$ptnum} = 1;
+		}
+		$pt->{payload_type} = $ptnum;
+		push(@codec_list, $pt);
+	}
+	$self->{codec_list} = \@codec_list;
+	$self->codecs_parse();
 
 	$self->{additional_attributes} = [];
 
@@ -162,9 +207,7 @@ sub new_remote {
 	$self->{protocol} = $protocol;
 	$self->{port} = $port;
 	$self->{type} = $type;
-	my @payload_types = [split(/ /, $payload_types)];
-	$self->{codec_list} = [ map {$payload_type_map{$_}} @payload_types ];
-	$self->{codecs} = _codec_list_to_hash(@{$self->{codecs}});
+	$self->{payload_types} = [split(/ /, $payload_types)]; # to be converted in decode()
 
 	return $self;
 };
@@ -180,7 +223,7 @@ sub encode {
 	my $pconn = $parent_connection ? NGCP::Rtpclient::SDP::encode_address($parent_connection) : '';
 	my @out;
 
-	my @payload_types = map {$codec_map{$_}{payload_type}} @{$self->{codec_list}};
+	my @payload_types = map {$_->{payload_type}} @{$self->{codec_list}};
 
 	push(@out, "m=$self->{type} " . $self->{rtp}->sockport() . ' ' . $self->{protocol} . ' '
 		. join(' ', @payload_types));
@@ -190,6 +233,8 @@ sub encode {
 
 	push(@out, 'a=sendrecv');
 
+	# add rtpmap attributes
+
 	if ($self->{rtcp}) {
 		my $rtcpconn = NGCP::Rtpclient::SDP::encode_address($self->{rtcp});
 		push(@out, 'a=rtcp:' . $self->{rtcp}->sockport()
@@ -212,6 +257,29 @@ sub decode {
 		$self->{rtcp_port} = $1;
 		$2 and $self->{rtcp_connection} = decode_address($2);
 	}
+	my @codec_list;
+	for my $pt (@{$self->{payload_types}}) {
+		my $def_fmt = $payload_type_map{$pt};
+		my $rtpmap = $attrs->{"rtpmap:$pt"}->[0];
+		$rtpmap //= "$def_fmt/8000";
+		my ($codec, $clockrate, $channels) = $rtpmap =~ /^(\w+)\/(\d+)(?:\/(\d+))?$/;
+		$channels //= 1;
+		my $ent = { name => $codec, clockrate => $clockrate, channels => $channels, payload_type => $pt };
+		push(@codec_list, $ent);
+	}
+	$self->{codec_list} = \@codec_list;
+	$self->codecs_parse();
+}
+
+sub codecs_parse {
+	my ($self) = @_;
+	$self->{payload_types} = { map {$_->{payload_type} => $_} @{$self->{codec_list}} };
+	$self->{codec_hash} = { map {$_->{name} => $_} @{$self->{codec_list}} };
+}
+
+sub send_codec {
+	my ($self) = @_;
+	return $self->{codecs_send}->[0];
 }
 
 sub connection {

perl/NGCP/Rtpengine/Test.pm

@@ -309,6 +309,7 @@ sub _offered {
 	# XXX validate SDP
 	@{$self->{remote_sdp}->{medias}} == 1 or die;
 	$self->{remote_media} = $self->{remote_sdp}->{medias}->[0];
+	$self->{local_sdp}->codec_negotiate($self->{remote_sdp});
 	$self->{ice} and $self->{ice}->decode($self->{remote_media}->decode_ice());
 }
 
@@ -335,6 +336,7 @@ sub _answered {
 	# XXX validate SDP
 	@{$self->{remote_sdp}->{medias}} == 1 or die;
 	$self->{remote_media} = $self->{remote_sdp}->{medias}->[0];
+	$self->{local_sdp}->codec_negotiate($self->{remote_sdp});
 	$self->{ice} and $self->{ice}->decode($self->{remote_media}->decode_ice());
 }
 
@@ -407,7 +409,10 @@ sub _peer_addr_check {
 sub start_rtp {
 	my ($self) = @_;
 	$self->{rtp} and die;
-	$self->{rtp} = NGCP::Rtpclient::RTP->new($self, %{$self->{rtp_args}}) or die;
+	my %args = %{$self->{rtp_args}};
+	my $send_codec = $self->{local_media}->send_codec();
+	$args{send_codec} = $send_codec;
+	$self->{rtp} = NGCP::Rtpclient::RTP->new($self, %args) or die;
 	$self->{client_components}->[0] = $self->{rtp};
 }
 
@@ -426,4 +431,16 @@ sub stop {
 	print("media packets outstanding: @queues\n");
 }
 
+sub remote_codecs {
+	my ($self) = @_;
+	my $list = $self->{remote_media}->{codec_list};
+	return join(',', map {"$_->{name}/$_->{clockrate}/$_->{channels}"} @$list);
+}
+
+sub send_codecs {
+	my ($self) = @_;
+	my $list = $self->{local_media}->{codecs_send};
+	return join(',', map {"$_->{name}/$_->{clockrate}/$_->{channels}"} @$list);
+}
+
 1;

t/test-transcode.pl

@@ -8,17 +8,21 @@ use IO::Socket;
 my $r = NGCP::Rtpengine::Test->new();
 my ($a, $b) = $r->client_pair(
 	{sockdomain => &Socket::AF_INET, codecs => [qw(PCMU)], no_data_check => 1},
-	{sockdomain => &Socket::AF_INET, codecs => [qw(G729)], no_data_check => 1}
+	{sockdomain => &Socket::AF_INET, codecs => [qw(G722)], no_data_check => 1}
 );
 
 $r->timer_once(3, sub {
 		$b->answer($a, ICE => 'remove', label => "callee");
+		$a->remote_codecs() eq 'PCMU/8000/1' or die;
+		$a->send_codecs() eq 'PCMU/8000/1' or die;
 		$a->start_rtp();
 		$a->start_rtcp();
 	});
 $r->timer_once(10, sub { $r->stop(); });
 
-$a->offer($b, ICE => 'remove', label => "caller", codec => { transcode => ['G729']});
+$a->offer($b, ICE => 'remove', label => "caller", codec => { transcode => ['G722']}, flags => [qw(record-call)]);
+$b->remote_codecs() eq 'PCMU/8000/1,G722/8000/1' or die;
+$b->send_codecs() eq 'G722/8000/1' or die;
 $b->start_rtp();
 $b->start_rtcp();