TT#49600 add test suites for SDES crypto negotiations

Change-Id: Ia615394c9c87c797a0ee58ccc67074f9caba4093

perl/NGCP/Rtpclient/SDES.pm

@@ -0,0 +1,110 @@
+package NGCP::Rtpclient::SDES;
+
+use strict;
+use warnings;
+use NGCP::Rtpclient::SRTP;
+use MIME::Base64;
+
+sub new {
+	my ($class, %args) = @_;
+
+	my $self = {};
+	bless $self, $class;
+
+	# our list of crypto suites
+
+	if (!$args{suites} || !@{$args{suites}}) {
+		$self->{suites} = [@NGCP::Rtpclient::SRTP::crypto_suites];
+	}
+	else {
+		$self->{suites} = [];
+		for my $s (@{$args{suites}}) {
+			my $o = $NGCP::Rtpclient::SRTP::crypto_suites{$s};
+			$o or die;
+			push(@{$self->{suites}}, $o);
+		}
+	}
+
+	# duplicate content and generate random keys
+
+	my $id = 1;
+	for my $s (@{$self->{suites}}) {
+		$s = {%$s};
+		$s->{id} = $id++;
+		$s->{master_key} = join('', map {chr(rand(256))} (1 .. $s->{key_length}));
+		$s->{master_salt} = join('', map {chr(rand(256))} (1 .. $s->{salt_length}));
+	}
+
+	return $self
+}
+
+sub encode {
+	my ($self) = @_;
+	my @ret;
+	for my $s (@{$self->{suites}}) {
+		push(@ret, "a=crypto:$s->{id} $s->{str} inline:" .
+			encode_base64($s->{master_key} . $s->{master_salt}, ''));
+	}
+	return @ret;
+}
+
+sub decode {
+	my ($self, $sdp_media) = @_;
+	$self->{remote_suites} = [];
+	my $suites = $sdp_media->get_attrs('crypto');
+	for my $line (@{$suites}) {
+		my ($id, $s, $b64) = $line =~ /^(\S+) (\S+) inline:(\S+)$/ or next;
+		$s = $NGCP::Rtpclient::SRTP::crypto_suites{$s};
+		$s or next; # crypto suite not supported by perl mod
+		$s = {%$s};
+		$s->{id} = $id;
+		($s->{master_key}, $s->{master_salt}) = NGCP::Rtpclient::SRTP::decode_inline_base64($b64, $s);
+		push(@{$self->{remote_suites}}, $s);
+	}
+	return;
+}
+
+# construct ->suites to match suites from ->remote_suites after an offer
+sub offered {
+	my ($self) = @_;
+	my @out;
+	for my $r (@{$self->{remote_suites}}) {
+		for my $s (@{$self->{suites}}) {
+			if ($r->{str} eq $s->{str}) {
+				my $dup = {%$s};
+				$dup->{remote} = $r;
+				$dup->{id} = $r->{id};
+				push(@out, $dup);
+			}
+		}
+	}
+	@{$self->{suites}} = @out;
+	$self->{suite} = $out[0];
+	return;
+}
+
+# prunes ->suites to contain only matching suites from ->remote_suites after an answer
+sub answered {
+	my ($self) = @_;
+	my @out;
+	for my $s (@{$self->{suites}}) {
+		for my $r (@{$self->{remote_suites}}) {
+			if ($r->{id} eq $s->{id} && $r->{str} eq $s->{str}) {
+				$s->{remote} = $r;
+				push(@out, $s);
+			}
+		}
+	}
+	@{$self->{suites}} = @out;
+	$self->{suite} = $out[0];
+	return;
+}
+
+# after an offer, trims the list of suites to just the one shared/supported one
+sub trim {
+	my ($self) = @_;
+	splice(@{$self->{suites}}, 1);
+	splice(@{$self->{remote_suites}}, 1);
+}
+
+1;

perl/NGCP/Rtpclient/SDP.pm

@@ -327,4 +327,9 @@ sub rtcp_endpoint {
 	die;
 }
 
+sub get_attrs {
+	my ($self, $name) = @_;
+	return $self->{attributes_hash}->{$name} // [];
+}
+
 1;

perl/NGCP/Rtpclient/SRTP.pm

@@ -258,6 +258,8 @@ sub aes_f8_iv_rtcp {
 
 sub decode_inline_base64 {
 	my ($b64, $cs) = @_;
+	# append possibly missing trailing ==
+	$b64 .= '=' x (4 - (length($b64) % 4)) if ((length($b64) % 4) != 0);
 	my $ks = decode_base64($b64);
 	length($ks) == ($cs->{key_length} + $cs->{salt_length}) or die;
 	my @ret = unpack("a$cs->{key_length}a$cs->{salt_length}", $ks);
@@ -290,7 +292,7 @@ sub encrypt_rtp {
 sub decrypt_rtp {
 	my ($suite, $skey, $ssalt, $sauth, $roc, $packet) = @_;
 
-	# XXX MKI
+	# XXX MKI, session parameters
 
 	my $plen = length($packet);
 	my $auth_tag = substr($packet, $plen - $$suite{auth_tag}, $$suite{auth_tag});
@@ -374,4 +376,75 @@ sub append_mki {
 	$$pack_r .= $mki;
 }
 
+package NGCP::Rtpclient::SRTP::Context;
+
+sub new {
+	my ($class, $suite) = @_;
+
+	my $self = {};
+	bless $self, $class;
+
+	$self->{suite} = $suite; # includes all parameters
+	my $remote = $self->{remote} = $suite->{remote}; # shortcut
+
+	$self->{roc} = 0;
+	$self->{remote_roc} = 0;
+
+	@$self{qw(session_key auth_key session_salt)}
+		= NGCP::Rtpclient::SRTP::gen_rtp_session_keys($suite->{master_key}, $suite->{master_salt});
+	@$self{qw(rtcp_session_key rtcp_auth_key rtcp_session_salt)}
+		= NGCP::Rtpclient::SRTP::gen_rtcp_session_keys($suite->{master_key}, $suite->{master_salt});
+	@$self{qw(remote_session_key remote_auth_key remote_session_salt)}
+		= NGCP::Rtpclient::SRTP::gen_rtp_session_keys($remote->{master_key}, $remote->{master_salt});
+	@$self{qw(remote_rtcp_session_key remote_rtcp_auth_key remote_rtcp_session_salt)}
+		= NGCP::Rtpclient::SRTP::gen_rtcp_session_keys($remote->{master_key}, $remote->{master_salt});
+
+	return $self;
+};
+
+sub encrypt {
+	my ($self, $component, $pack) = @_;
+
+	if ($component == 0) {
+		# XXX MKI, SRTP/SDES session options
+		my ($p, $roc) = NGCP::Rtpclient::SRTP::encrypt_rtp(@$self{qw(suite session_key session_salt
+			auth_key roc)}, '', 0,
+			0, 0, $pack);
+		$self->{roc} = $roc;
+		return $p;
+	}
+	else {
+		# RTCP
+		my ($p, $idx) = NGCP::Rtpclient::SRTP::encrypt_rtcp(@$self{qw(suite rtcp_session_key
+			rtcp_session_salt
+			rtcp_auth_key rtcp_index)}, '', 0,
+			0, $pack);
+		$self->{rtcp_index} = $idx;
+		return $p;
+	}
+}
+
+sub decrypt {
+	my ($self, $component, $pack) = @_;
+
+	if ($component == 0) {
+		# XXX MKI, SRTP/SDES session options
+		my ($p, $roc) = NGCP::Rtpclient::SRTP::decrypt_rtp(@$self{qw(remote remote_session_key
+			remote_session_salt
+			remote_auth_key remote_roc)}, $pack);
+		$self->{remote_roc} = $roc;
+		# XXX verify hmac/auth
+		return $p;
+	}
+	else {
+		# RTCP
+		my ($p, $idx) = NGCP::Rtpclient::SRTP::decrypt_rtcp(@$self{qw(remote remote_rtcp_session_key
+			remote_rtcp_session_salt
+			remote_rtcp_auth_key)}, $pack);
+		$self->{remote_rtcp_index} = $idx;
+		# XXX verify hmac/auth
+		return $p;
+	}
+}
+
 1;

perl/NGCP/Rtpengine/Test.pm

@@ -14,6 +14,7 @@ use IO::Multiplex;
 use Time::HiRes qw(time);
 use NGCP::Rtpclient::SDP;
 use NGCP::Rtpclient::ICE;
+use NGCP::Rtpclient::SDES;
 use NGCP::Rtpclient::DTLS;
 use NGCP::Rtpclient::RTP;
 use NGCP::Rtpclient::RTCP;
@@ -179,6 +180,7 @@ sub _new {
 
 	# default protocol
 	my $proto = 'RTP/AVP';
+	$args{sdes} and $proto = 'RTP/SAVP';
 	$args{dtls} and $proto = 'UDP/TLS/RTP/SAVP';
 	$args{protocol} and $proto = $args{protocol};
 
@@ -189,6 +191,9 @@ sub _new {
 	));
 	# XXX support multiple medias
 
+	if ($args{sdes}) {
+		$self->{sdes} = NGCP::Rtpclient::SDES->new(%{$args{sdes_args}});
+	}
 	if ($args{dtls}) {
 		$self->{dtls} = NGCP::Rtpclient::DTLS::Group->new($parent->{mux}, $self, [ \@rtp, \@rtcp ]);
 		$self->{local_media}->add_attrs($self->{dtls}->encode());
@@ -250,6 +255,10 @@ sub _packet_send {
 		($local_socket, $dest) = $self->{ice}->get_send_component($component);
 	}
 
+	if ($self->{srtp}) {
+		$s = $self->{srtp}->encrypt($component, $s);
+	}
+
 	$local_socket->send($s, 0, $dest);
 }
 sub _media_send {
@@ -291,6 +300,7 @@ sub _default_req_args {
 sub offer {
 	my ($self, $other, %args) = @_;
 
+	$self->{sdes} and $self->{local_media}->add_attrs($self->{sdes}->encode());
 	my $sdp_body = $self->{local_sdp}->encode();
 	# XXX validate SDP
 
@@ -311,12 +321,18 @@ sub _offered {
 	@{$self->{remote_sdp}->{medias}} == 1 or die;
 	$self->{remote_media} = $self->{remote_sdp}->{medias}->[0];
 	$self->{local_sdp}->codec_negotiate($self->{remote_sdp});
+	if ($self->{sdes}) {
+		$self->{sdes}->decode($self->{remote_media});
+		$self->{sdes}->offered();
+		$self->{srtp} = NGCP::Rtpclient::SRTP::Context->new($self->{sdes}->{suite});
+	}
 	$self->{ice} and $self->{ice}->decode($self->{remote_media}->decode_ice());
 }
 
 sub answer {
 	my ($self, $other, %args) = @_;
 
+	$self->{sdes} and $self->{local_media}->add_attrs($self->{sdes}->encode());
 	my $sdp_body = $self->{local_sdp}->encode();
 	# XXX validate SDP
 
@@ -338,6 +354,11 @@ sub _answered {
 	@{$self->{remote_sdp}->{medias}} == 1 or die;
 	$self->{remote_media} = $self->{remote_sdp}->{medias}->[0];
 	$self->{local_sdp}->codec_negotiate($self->{remote_sdp});
+	if ($self->{sdes}) {
+		$self->{sdes}->decode($self->{remote_media});
+		$self->{sdes}->answered();
+		$self->{srtp} = NGCP::Rtpclient::SRTP::Context->new($self->{sdes}->{suite});
+	}
 	$self->{ice} and $self->{ice}->decode($self->{remote_media}->decode_ice());
 }
 
@@ -371,8 +392,12 @@ sub _input {
 
 	# must be RTP or RTCP input
 	if (!$self->{args}->{no_data_check}) {
+		if ($self->{srtp}) {
+			$$input = $self->{srtp}->decrypt($component, $$input);
+		}
+
 		my $exp = shift(@{$self->{media_receive_queues}->[$component]}) or die;
-		$$input eq $exp or die;
+		$$input eq $exp or die unpack('H*', $$input) . ' ne ' . unpack('H*', $exp);
 	}
 	else {
 		@{$self->{media_receive_queues}->[$component]} = ();

t/test-plain-sdes-full.pl

@@ -0,0 +1,34 @@
+#!/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(
+	{},
+	{sdes => 1}
+);
+
+@{$b->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove', 'transport-protocol' => 'RTP/SAVP');
+
+@{$b->{sdes}->{remote_suites}} >= 7 or die; # all that we support
+
+$b->answer($a, ICE => 'remove');
+
+@{$b->{sdes}->{remote_suites}} >= 7 or die; # still the full list
+@{$b->{sdes}->{suites}} >= 7 or die; # still the full list
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();

t/test-plain-sdes.pl

@@ -0,0 +1,37 @@
+#!/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(
+	{},
+	{sdes => 1}
+);
+
+@{$b->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove', 'transport-protocol' => 'RTP/SAVP');
+
+@{$b->{sdes}->{remote_suites}} >= 7 or die; # all that we support
+$b->{sdes}->trim();
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 for answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 for answer
+
+$b->answer($a, ICE => 'remove');
+
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();

t/test-sdes-plain.pl

@@ -0,0 +1,34 @@
+#!/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(
+	{sdes => 1},
+	{}
+);
+
+@{$a->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove', 'transport-protocol' => 'RTP/AVP');
+
+@{$a->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$b->answer($a, ICE => 'remove');
+
+@{$a->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$a->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();

t/test-sdes-sdes-select-offer-restrict.pl

@@ -0,0 +1,46 @@
+#!/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(
+	{sdes => 1, sdes_args => {suites => [qw(
+		AES_CM_256_HMAC_SHA1_80 AES_CM_256_HMAC_SHA1_32
+		AES_CM_128_HMAC_SHA1_80 AES_CM_128_HMAC_SHA1_32
+	)]}},
+	{sdes => 1}
+);
+
+@{$a->{sdes}->{suites}} == 4 or die; # the ones we selected
+@{$b->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove', flags => [qw(SDES-no-AES_CM_256_HMAC_SHA1_80 SDES-no-AES_CM_256_HMAC_SHA1_32)]);
+
+@{$a->{sdes}->{suites}} == 4 or die; # the ones we selected
+
+@{$b->{sdes}->{remote_suites}} >= 5 or die; # all that we support (our selected + added by rtpengine - restrict)
+$b->{sdes}->trim();
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 for answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 for answer
+
+$b->answer($a, ICE => 'remove');
+
+@{$a->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$a->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();

t/test-sdes-sdes-select-offer.pl

@@ -0,0 +1,46 @@
+#!/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(
+	{sdes => 1, sdes_args => {suites => [qw(
+		AES_CM_256_HMAC_SHA1_80 AES_CM_256_HMAC_SHA1_32
+		AES_CM_128_HMAC_SHA1_80 AES_CM_128_HMAC_SHA1_32
+	)]}},
+	{sdes => 1}
+);
+
+@{$a->{sdes}->{suites}} == 4 or die; # the ones we selected
+@{$b->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove');
+
+@{$a->{sdes}->{suites}} == 4 or die; # the ones we selected
+
+@{$b->{sdes}->{remote_suites}} >= 7 or die; # all that we support (our selected + added by rtpengine)
+$b->{sdes}->trim();
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 for answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 for answer
+
+$b->answer($a, ICE => 'remove');
+
+@{$a->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$a->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();

t/test-sdes-sdes.pl

@@ -0,0 +1,43 @@
+#!/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(
+	{sdes => 1},
+	{sdes => 1}
+);
+
+@{$a->{sdes}->{suites}} >= 7 or die; # all that we support
+@{$b->{sdes}->{suites}} >= 7 or die; # all that we support
+
+$r->timer_once(10, sub { $r->stop(); });
+
+$a->offer($b, ICE => 'remove');
+
+@{$a->{sdes}->{suites}} >= 7 or die; # all that we support
+
+@{$b->{sdes}->{remote_suites}} >= 7 or die; # all that we support
+$b->{sdes}->trim();
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 for answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 for answer
+
+$b->answer($a, ICE => 'remove');
+
+@{$a->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$a->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+@{$b->{sdes}->{remote_suites}} == 1 or die; # just 1 answer
+@{$b->{sdes}->{suites}} == 1 or die; # just 1 after negotiation
+
+$a->start_rtp();
+$a->start_rtcp();
+$b->start_rtp();
+$b->start_rtcp();
+
+$r->run();
+
+$a->teardown();