From 84f152bc629e8e0a2ae84a99f0b937d449beb158 Mon Sep 17 00:00:00 2001 From: Richard Fuchs Date: Thu, 27 Dec 2018 10:29:37 -0500 Subject: [PATCH] TT#49600 add test suites for SDES crypto negotiations Change-Id: Ia615394c9c87c797a0ee58ccc67074f9caba4093 --- perl/NGCP/Rtpclient/SDES.pm | 110 ++++++++++++++++++++++ perl/NGCP/Rtpclient/SDP.pm | 5 + perl/NGCP/Rtpclient/SRTP.pm | 75 ++++++++++++++- perl/NGCP/Rtpengine/Test.pm | 27 +++++- t/test-plain-sdes-full.pl | 34 +++++++ t/test-plain-sdes.pl | 37 ++++++++ t/test-sdes-plain.pl | 34 +++++++ t/test-sdes-sdes-select-offer-restrict.pl | 46 +++++++++ t/test-sdes-sdes-select-offer.pl | 46 +++++++++ t/test-sdes-sdes.pl | 43 +++++++++ 10 files changed, 455 insertions(+), 2 deletions(-) create mode 100644 perl/NGCP/Rtpclient/SDES.pm create mode 100755 t/test-plain-sdes-full.pl create mode 100755 t/test-plain-sdes.pl create mode 100755 t/test-sdes-plain.pl create mode 100755 t/test-sdes-sdes-select-offer-restrict.pl create mode 100755 t/test-sdes-sdes-select-offer.pl create mode 100755 t/test-sdes-sdes.pl diff --git a/perl/NGCP/Rtpclient/SDES.pm b/perl/NGCP/Rtpclient/SDES.pm new file mode 100644 index 000000000..299f247f4 --- /dev/null +++ b/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; diff --git a/perl/NGCP/Rtpclient/SDP.pm b/perl/NGCP/Rtpclient/SDP.pm index 419ce6446..611a71a3f 100644 --- a/perl/NGCP/Rtpclient/SDP.pm +++ b/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; diff --git a/perl/NGCP/Rtpclient/SRTP.pm b/perl/NGCP/Rtpclient/SRTP.pm index 2f5ec825e..38a42c8a9 100644 --- a/perl/NGCP/Rtpclient/SRTP.pm +++ b/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; diff --git a/perl/NGCP/Rtpengine/Test.pm b/perl/NGCP/Rtpengine/Test.pm index 0129316d9..ef7d76b8d 100644 --- a/perl/NGCP/Rtpengine/Test.pm +++ b/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]} = (); diff --git a/t/test-plain-sdes-full.pl b/t/test-plain-sdes-full.pl new file mode 100755 index 000000000..afcc221e1 --- /dev/null +++ b/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(); diff --git a/t/test-plain-sdes.pl b/t/test-plain-sdes.pl new file mode 100755 index 000000000..870702602 --- /dev/null +++ b/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(); diff --git a/t/test-sdes-plain.pl b/t/test-sdes-plain.pl new file mode 100755 index 000000000..23fda2a2b --- /dev/null +++ b/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(); diff --git a/t/test-sdes-sdes-select-offer-restrict.pl b/t/test-sdes-sdes-select-offer-restrict.pl new file mode 100755 index 000000000..0eebd852a --- /dev/null +++ b/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(); diff --git a/t/test-sdes-sdes-select-offer.pl b/t/test-sdes-sdes-select-offer.pl new file mode 100755 index 000000000..ab5016902 --- /dev/null +++ b/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(); diff --git a/t/test-sdes-sdes.pl b/t/test-sdes-sdes.pl new file mode 100755 index 000000000..c24b32aa3 --- /dev/null +++ b/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();