From bc30f8384670a7ae0a61d84b66cddc87ebdace1b Mon Sep 17 00:00:00 2001 From: Richard Fuchs Date: Thu, 25 Feb 2016 12:09:22 -0500 Subject: [PATCH] incorporate dtls stuff into tests Change-Id: I7049bc1476131b6e86a3afd25bef5e7f64f535ce --- utils/DTLS.pm | 219 +++++++++++++++++++++++++++++++++------------ utils/Rtpengine.pm | 6 ++ utils/test.pl | 13 ++- utils/test2.pl | 178 ++++++++++++++++++++++++++++++++++++ 4 files changed, 359 insertions(+), 57 deletions(-) create mode 100644 utils/test2.pl diff --git a/utils/DTLS.pm b/utils/DTLS.pm index a9f7d125a..bc89d0360 100644 --- a/utils/DTLS.pm +++ b/utils/DTLS.pm @@ -8,13 +8,26 @@ use Crypt::OpenSSL::RSA; use IO::Socket::INET; use IPC::Open3; use IO::Multiplex; +use Time::HiRes qw(sleep time); sub new { - my ($class) = @_; + my ($class, $mux, $local_sockets, $output_func, $tag, $cert) = @_; my $self = {}; bless $self, $class; + $self->{_output_func} = $output_func; + $self->{_mux} = $mux; + $self->{_tag} = $tag; + $self->{_local_sockets} = $local_sockets; + + if ($cert) { + $self->set_cert($cert); + } + else { + $self->new_cert(); + } + return $self; } @@ -53,33 +66,15 @@ sub set_cert { $self->{_cert_key_file} = $file; } -sub check_cert { - my ($self, $file) = @_; - $self->{_cert_key_file} and return; - $self->new_cert(); -} - +# XXX unify these two sub connect { - my ($self, $local, $dest) = @_; - $self->check_cert(); + my ($self) = @_; - $self->{_connected} and return 1; + $self->{_connected} and return; $self->_kill_openssl_child(); my $near = $self->{_near}; - my $far = $self->{_far}; - - if (!$far) { - if (ref($local)) { - $far = $local; - } - else { - $far = IO::Socket::INET->new(Type => SOCK_DGRAM, PeerAddr => $dest, - LocalAddr => $local, Proto => 'udp'); - } - $self->{_far} = $far; - } $near or ($near = $self->{_near} = IO::Socket::INET->new(Type => SOCK_DGRAM, LocalAddr => 'localhost', Proto => 'udp')); @@ -97,16 +92,52 @@ sub connect { $self->{_openssl_in} = $openssl_in; $self->{_openssl_buf} = ''; - my $mux = IO::Multiplex->new(); - $mux->add($near); - $mux->add($far); - $mux->add($openssl_out); + $self->{_mux}->add($near); + $self->{_mux}->add($openssl_out); +} +sub accept { + my ($self) = @_; - $mux->set_callback_object($self); - $mux->loop; + $self->{_connected} and return; - $self->{_connected} or return 0; - return 1; + $self->_kill_openssl_child(); + + my ($near_port, $near_peer); + my $near = $self->{_near}; + if ($near) { + $near_port = $near->peerport(); + $near_peer = $near->peeraddr(); + } + else { + my $tmp = IO::Socket::INET->new(Type => SOCK_DGRAM, LocalAddr => 'localhost', Proto => 'udp'); + $near_port = $tmp->sockport(); + undef($tmp); + + $near = $self->{_near} = IO::Socket::INET->new(Type => SOCK_DGRAM, LocalAddr => 'localhost', + Proto => 'udp'); + $near_peer = pack_sockaddr_in($near_port, inet_aton("localhost")); + # $near gets connected below + } + + my ($openssl_in, $openssl_out); + $self->{_openssl_pid} = open3($openssl_in, $openssl_out, undef, + qw(openssl s_server -accept), + $near_port, + '-cert', $self->{_cert_key_file}->filename(), qw(-dtls1 -use_srtp + SRTP_AES128_CM_SHA1_80:SRTP_AES128_CM_SHA1_32 -keymatexport EXTRACTOR-dtls_srtp + -keymatexportlen 60)); + # XXX dtls 1.2 ? + + sleep(0.2); # given openssl a short while to start up + + $self->_near_peer($near_peer); + + $self->{_openssl_out} = $openssl_out; + $self->{_openssl_in} = $openssl_in; + $self->{_openssl_buf} = ''; + + $self->{_mux}->add($near); + $self->{_mux}->add($openssl_out); } sub _kill_openssl_child { @@ -127,39 +158,69 @@ sub DESTROY { $self->_kill_openssl_child(); } -sub mux_input { - my ($self, $mux, $fh, $input) = @_; +sub _openssl_input { + my ($self, $fh, $s_r, $peer) = @_; - if ($fh == $self->{_openssl_out}) { - $self->{_openssl_buf} .= $$input; - } - elsif ($fh == $self->{_near}) { - send($self->{_far}, $$input, 0); - if (!$self->{_near_peer}) { - $self->{_near_peer} = $mux->udp_peer($fh); - CORE::connect($self->{_near}, $self->{_near_peer}); - } - } - if ($fh == $self->{_far}) { - if (is_dtls($$input) && $self->{_near_peer}) { - send($self->{_near}, $$input, 0); - } + if ($self->{_openssl_done}) { + $$s_r = ''; + return; } - $$input = ''; + $self->{_openssl_buf} .= $$s_r; + $$s_r = ''; if ($self->{_openssl_buf} =~ /Server certificate\n(-----BEGIN CERTIFICATE-----\n.*?\n-----END CERTIFICATE-----\n).*SRTP Extension negotiated, profile=(\S+).*Keying material: ([0-9a-fA-F]{120})/s) { $self->{_peer_cert} = $1; $self->{_profile} = $2; $self->{_keys} = pack('H*', $3); $self->{_connected} = 1; - $mux->endloop(); + $self->{_openssl_done} = 1; } if ($self->{_openssl_buf} =~ /\nDONE\n/s) { - $mux->endloop(); + $self->{_openssl_done} = 1; } } +sub _near_peer { + my ($self, $peer) = @_; + + $self->{_near_peer} and return; + + $self->{_near_peer} = $peer; + CORE::connect($self->{_near}, $self->{_near_peer}); +} + +sub _near_input { + my ($self, $fh, $s_r, $peer) = @_; + + $self->{_output_func}->($self->{_tag}, $$s_r); + + $self->_near_peer($peer); + + $$s_r = ''; +} + +sub input { + my ($self, $fh, $s_r, $peer) = @_; + + $$s_r eq '' and return; + + if ($fh == $self->{_openssl_out}) { # openssl's stdout + return $self->_openssl_input($fh, $s_r, $peer); + } + elsif ($fh == $self->{_near}) { # UDP input from openssl - forward to peer + return $self->_near_input($fh, $s_r, $peer); + } + + # UDP input from peer - demux and forward to openssl + is_dtls($$s_r) or return; + $self->{_near_peer} or return; # nowhere to forward it to + grep {$fh == $_} @{$self->{_local_sockets}} or return; # not one of ours + + send($self->{_near}, $$s_r, 0); + $$s_r = ''; +} + sub peer_cert { my ($self) = @_; $self->{_peer_cert_file} and return $self->{_peer_cert_file}; @@ -182,12 +243,9 @@ sub cert_fingerprint { return $1; } -sub mux_eof { - my ($self, $mux, $fh) = @_; - - if ($fh == $self->{_openssl_out}) { - $mux->endloop(); - } +sub fingerprint { + my ($self) = @_; + return cert_fingerprint($self->{_cert_key_file}); } sub get_keys { @@ -206,4 +264,55 @@ sub is_dtls { return 1; } +sub encode { + my ($self) = @_; + my @ret; + push(@ret, 'a=setup:actpass'); + push(@ret, 'a=fingerprint:sha-1 ' . $self->fingerprint()); + return @ret; +} + +package DTLS::Group; + +sub new { + my ($class, $mux, $output_func, $socket_components, $cert) = @_; + + my $self = []; + bless $self, $class; + + my $max_component = $#{$socket_components}; + + for my $idx (0 .. $max_component) { + my $local_sockets = $socket_components->[$idx]; + my $cl = DTLS->new($mux, $local_sockets, $output_func, $idx, $cert); + push(@$self, $cl); + $cert = $cl->get_cert(); + } + + return $self; +} + +sub encode { + my ($self, @rest) = @_; + return $self->[0]->encode(@rest); +} +sub connect { + my ($self, @rest) = @_; + for my $cl (@$self) { + $cl->accept(@rest); + } +} +sub accept { + my ($self, @rest) = @_; + for my $cl (@$self) { + $cl->accept(@rest); + } +} +sub input { + my ($self, @rest) = @_; + for my $cl (@$self) { + $cl->input(@rest); + } +} + 1; diff --git a/utils/Rtpengine.pm b/utils/Rtpengine.pm index 7634c380b..2bc513727 100644 --- a/utils/Rtpengine.pm +++ b/utils/Rtpengine.pm @@ -52,4 +52,10 @@ sub answer { return $self->req( { %$packet, command => 'answer' } ); } +package Rtpengine::Test; + +sub new { + my ($class) = @_; +}; + 1; diff --git a/utils/test.pl b/utils/test.pl index ca15de5ed..6ea200ead 100644 --- a/utils/test.pl +++ b/utils/test.pl @@ -21,7 +21,7 @@ my @A_interfaces = qw( 10.10.8.18 2001:470:1d:76c:feaa:14ff:fe97:be6b fdd5:725c:61d7:0:feaa:14ff:fe97:be6b - 2a02:1b8:7:1:9847:efff:fe2e:f17d + 2a02:1b8:7:1:803d:beff:fe69:fefd ); my @B_interfaces = @A_interfaces; @@ -66,7 +66,7 @@ my $A_main = $A_sockets[0]; # for o= and m= line details my $A_local_sdp = SDP->new($A_main->[0]); # no global connection given # rtp and rtcp, everything else default -my $A_local_media = $A_local_sdp->add_media(SDP::Media->new($A_main->[0], $A_main->[1])); +my $A_local_media = $A_local_sdp->add_media(SDP::Media->new($A_main->[0], $A_main->[1], 'RTP/SAVPF')); # create side A ICE agent @@ -78,6 +78,14 @@ for my $s (@A_sockets) { $A_local_media->add_attrs($A_ice->encode()); +# create side A DTLS client + +my $A_send_func = sub { + 1; +}; +my $A_dtls = DTLS->new($mux, $A_send_func); +$A_local_media->add_attrs($A_dtls->encode()); + # send side A SDP to rtpengine my $A_local_sdp_body = $A_local_sdp->encode(); @@ -128,6 +136,7 @@ $mux->loop(); sub mux_input { my ($self, $mux, $fh, $input) = @_; my $peer = $mux->udp_peer($fh); + $A_DTLS->input($fh, $input, $peer); $A_ice->input($fh, $input, $peer); $B_ice->input($fh, $input, $peer); } diff --git a/utils/test2.pl b/utils/test2.pl new file mode 100644 index 000000000..cbc8121e5 --- /dev/null +++ b/utils/test2.pl @@ -0,0 +1,178 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use DTLS; +use RTP; +use SDP; +use Rtpengine; +use IO::Socket::IP; +use IO::Multiplex; +use Time::HiRes qw(time); +use List::Util; + +my $mux = IO::Multiplex->new(); +$mux->set_callback_object(__PACKAGE__); + +# create local sockets for A and B sides + +my @A_interfaces = qw( + 192.168.1.90 + 10.10.8.18 + 2001:470:1d:76c:feaa:14ff:fe97:be6b + fdd5:725c:61d7:0:feaa:14ff:fe97:be6b + 2a02:1b8:7:1:803d:beff:fe69:fefd +); +my @B_interfaces = @A_interfaces; + +@A_interfaces = List::Util::shuffle @A_interfaces; +@B_interfaces = List::Util::shuffle @B_interfaces; + +my $sport = 2000; + +my (@A_sockets, @B_sockets, @A_rtp, @A_rtcp, @B_rtp, @B_rtcp, @A_component_peers, @B_component_peers); + +for my $a (@A_interfaces) { + my $rtp = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp', + LocalHost => $a, LocalPort => $sport++) or die($a); + my $rtcp = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp', + LocalHost => $a, LocalPort => $sport++) or die($a); + print("local interface side A: " . $rtp->sockhost() . '/' . $rtp->sockport() . '/' + . $rtcp->sockport() . "\n"); + push(@A_sockets, [$rtp, $rtcp]); + push(@A_rtp, $rtp); + push(@A_rtcp, $rtcp); + $mux->add($rtp); + $mux->add($rtcp); + $mux->set_timeout($rtp, 0.01); +} + +print("-\n"); + +for my $a (@B_interfaces) { + my $rtp = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp', + LocalHost => $a, LocalPort => $sport++) or die($a); + my $rtcp = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp', + LocalHost => $a, LocalPort => $sport++) or die($a); + print("local interface side B: " . $rtp->sockhost() . '/' . $rtp->sockport() . '/' + . $rtcp->sockport() . "\n"); + push(@B_sockets, [$rtp, $rtcp]); + push(@B_rtp, $rtp); + push(@B_rtcp, $rtcp); + $mux->add($rtp); + $mux->add($rtcp); + $mux->set_timeout($rtp, 0.01); +} + +# create outgoing SDP for side A + +my $A_main = $A_sockets[0]; # for o= and m= line details +my $A_local_sdp = SDP->new($A_main->[0]); # no global connection given + +# rtp and rtcp, everything else default +my $A_local_media = $A_local_sdp->add_media(SDP::Media->new($A_main->[0], $A_main->[1], 'RTP/SAVPF')); + +# create side A DTLS clients + +my $A_send_func = sub { + my ($component, $s) = @_; + $A_main->[$component]->send($s, 0, $A_component_peers[$component]); +}; +my $A_dtls = DTLS::Group->new($mux, $A_send_func, [ \@A_rtp, \@A_rtcp ]); +$A_local_media->add_attrs($A_dtls->encode()); +$A_dtls->accept(); + +# send side A SDP to rtpengine + +my $A_local_sdp_body = $A_local_sdp->encode(); +# XXX validate SDP + +my $rtpengine = Rtpengine->new('localhost', 2223); + +my $callid = rand(); +my $fromtag = rand(); +my $totag = rand(); + +print("doing rtpengine offer\n"); +my $offer_sent = time(); +my $A_offer = { command => 'offer', ICE => 'remove', 'call-id' => $callid, 'from-tag' => $fromtag, + sdp => $A_local_sdp_body }; + +my $B_offer = $rtpengine->req($A_offer); +my $offer_done = time(); + +# decode incoming SDP for side B + +my $B_remote_sdp_body = $B_offer->{sdp}; +my $B_remote_sdp = SDP->decode($B_remote_sdp_body); +# XXX validate SDP +@{$B_remote_sdp->{medias}} == 1 or die; +my $B_remote_media = $B_remote_sdp->{medias}->[0]; + +# run the machine and simulate delayed answer + +my $do_answer = time() + 3; + +$mux->loop(); + + + +sub mux_input { + my ($self, $mux, $fh, $input) = @_; + my $peer = $mux->udp_peer($fh); + # + # keep track of peer addresses + peer_addr_check($fh, $peer, \@A_rtp, \@A_component_peers, 0); + peer_addr_check($fh, $peer, \@A_rtcp, \@A_component_peers, 1); + + $A_dtls->input($fh, $input, $peer); +} + +sub mux_timeout { + my ($self, $mux, $fh) = @_; + + if ($do_answer && time() >= $do_answer) { + do_answer(); + } + + $mux->set_timeout($fh, 0.01); +} + +sub do_answer { + $do_answer = 0; + + # create answer from B to A + + my $B_main = $B_sockets[0]; # for o= and m= line details + my $B_local_sdp = SDP->new($B_main->[0]); # no global connection given + + # rtp and rtcp, everything else default + my $B_local_media = $B_local_sdp->add_media(SDP::Media->new($B_main->[0], $B_main->[1])); + + # send side A SDP to rtpengine + my $B_local_sdp_body = $B_local_sdp->encode(); + # XXX validate SDP + + my $B_answer = { command => 'answer', ICE => 'remove', 'call-id' => $callid, 'from-tag' => $fromtag, + 'to-tag' => $totag, sdp => $B_local_sdp_body }; + + print("doing rtpengine answer\n"); + my $A_answer = $rtpengine->req($B_answer); + + # decode incoming SDP for side A + + my $A_remote_sdp_body = $A_answer->{sdp}; + my $A_remote_sdp = SDP->decode($A_remote_sdp_body); + # XXX validate SDP + @{$A_remote_sdp->{medias}} == 1 or die; + my $A_remote_media = $A_remote_sdp->{medias}->[0]; + + # return to IO handler loop +} + +sub peer_addr_check { + my ($fh, $peer, $sockets, $dest_list, $idx) = @_; + if (List::Util::any {$fh == $_} @$sockets) { + $dest_list->[$idx] = $peer; + } +}