incorporate dtls stuff into tests

Change-Id: I7049bc1476131b6e86a3afd25bef5e7f64f535ce

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;

utils/Rtpengine.pm

@@ -52,4 +52,10 @@ sub answer {
 	return $self->req( { %$packet, command => 'answer' } );
 }
 
+package Rtpengine::Test;
+
+sub new {
+	my ($class) = @_;
+};
+
 1;

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);
 }

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;
+	}
+}