DTLS tests - WIP

Change-Id: If0e738486202bbd256da0215a56d58a388a9af42
10 years ago · 1f8d8d7325
--- a/utils/DTLS.pm
+++ b/utils/DTLS.pm
@ -0,0 +1,209 @@
 package DTLS;

 use strict;
 use warnings;
 use SRTP;
 use File::Temp;
 use Crypt::OpenSSL::RSA;
 use IO::Socket::INET;
 use IPC::Open3;
 use IO::Multiplex;

 sub new {
 	my ($class) = @_;

 	my $self = {};
 	bless $self, $class;

 	return $self;
 }

 sub new_cert {
 	my ($self) = @_;

 	my $rsa_key = Crypt::OpenSSL::RSA->generate_key(1024);
 	my $priv_key = $rsa_key->get_private_key_string();
 	my $key_file = File::Temp->new();
 	print $key_file $priv_key;
 	close($key_file);

 	my $cert_file = File::Temp->new();
 	system(qw(openssl req -key), $key_file->filename(), '-out', $cert_file->filename(),
 		qw(-new -x509 -days 30 -subj /CN=tester -batch));
 	my $cert;
 	read($cert_file, $cert, 10000);
 	close($cert_file);

 	my $cert_key_file = File::Temp->new();
 	print $cert_key_file $cert;
 	print $cert_key_file $priv_key;
 	close($cert_key_file);

 	$self->set_cert($cert_key_file);
 	return $cert_key_file;
 }

 sub get_cert {
 	my ($self) = @_;
 	return $self->{_cert_key_file};
 }

 sub set_cert {
 	my ($self, $file) = @_;
 	$self->{_cert_key_file} = $file;
 }

 sub check_cert {
 	my ($self, $file) = @_;
 	$self->{_cert_key_file} and return;
 	$self->new_cert();
 }

 sub connect {
 	my ($self, $local, $dest) = @_;
 	$self->check_cert();

 	$self->{_connected} and return 1;

 	$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'));

 	my $near_port = $near->sockport();

 	my ($openssl_in, $openssl_out);
 	$self->{_openssl_pid} = open3($openssl_in, $openssl_out, undef,
 		qw(openssl s_client -connect),
 		"localhost:$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));
 	$self->{_openssl_out} = $openssl_out;
 	$self->{_openssl_in} = $openssl_in;
 	$self->{_openssl_buf} = '';

 	my $mux = IO::Multiplex->new();
 	$mux->add($near);
 	$mux->add($far);
 	$mux->add($openssl_out);

 	$mux->set_callback_object($self);
 	$mux->loop;

 	$self->{_connected} or return 0;
 	return 1;
 }

 sub _kill_openssl_child {
 	my ($self) = @_;

 	if ($self->{_openssl_pid}) {
 		kill(9, $self->{_openssl_pid});
 		waitpid($self->{_openssl_pid}, 0);
 	}
 	delete($self->{_openssl_pid});
 	delete($self->{_openssl_in});
 	delete($self->{_openssl_out});
 }

 sub DESTROY {
 	my ($self) = @_;

 	$self->_kill_openssl_child();
 }

 sub mux_input {
 	my ($self, $mux, $fh, $input) = @_;

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

 	$$input = '';

 	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();
 	}
 	if ($self->{_openssl_buf} =~ /\nDONE\n/s) {
 		$mux->endloop();
 	}
 }

 sub peer_cert {
 	my ($self) = @_;
 	$self->{_peer_cert_file} and return $self->{_peer_cert_file};
 	$self->{_peer_cert} or return;

 	my $cert_file = File::Temp->new();
 	print $cert_file $self->{_peer_cert};
 	close($cert_file);

 	return ($self->{_peer_cert_file} = $cert_file);
 }

 sub cert_fingerprint {
 	my ($cert_file) = @_;
 	my $fd;
 	open($fd, '-|', qw(openssl x509 -in), $cert_file->filename(), qw(-fingerprint -noout));
 	my $fp = <$fd>;
 	close($fd);
 	$fp =~ /SHA1 Fingerprint=([0-9a-f:]+)/i or return;
 	return $1;
 }

 sub mux_eof {
 	my ($self, $mux, $fh) = @_;

 	if ($fh == $self->{_openssl_out}) {
 		$mux->endloop();
 	}
 }

 sub get_keys {
 	my ($self) = @_;

 	$self->{_keys} =~ /^(.{16})(.{16})(.{14})(.{14})$/s or return;
 	return ($self->{_profile}, $1, $2, $3, $4);
 }

 sub is_dtls {
 	my ($s) = @_;
 	length($s) < 1 and return 0;
 	my $c = ord(substr($s, 0, 1));
 	$c < 20 and return 0;
 	$c > 63 and return 0;
 	return 1;
 }

 1;
--- a/utils/ICE.pm
+++ b/utils/ICE.pm
@ -0,0 +1,803 @@
 package ICE;

 use strict;
 use warnings;
 use Socket;
 use Socket6;
 use IO::Socket;
 use IO::Multiplex;
 use Math::BigInt;
 use Digest::HMAC_SHA1 qw(hmac_sha1);
 use Digest::CRC qw(crc32);
 use Time::HiRes qw(time);

 my @ice_chars = ('A' .. 'Z', 'a' .. 'z', '0' .. '9');
 my %type_preferences = (
 	host => 126,
 	srflx => 100,
 	prflx => 110,
 	relay => 0,
 );
 my %protocols = ( 17 => 'UDP' );

 sub random_string {
 	my ($len) = @_;
 	return join('', (map {$ice_chars[rand(@ice_chars)]} (1 .. $len)));
 }

 sub new {
 	my ($class, $components, $controlling) = @_;

 	my $self = {};
 	bless $self, $class;

 	$self->{my_ufrag} = random_string(8);
 	$self->{my_pwd} = random_string(26);
 	$self->{controlling} = $controlling;
 	$self->{components} = $components;
 	$self->{tie_breaker} = i64from32(rand(2**32), rand(2**32));

 	$self->{candidates} = {}; # foundation -> candidate
 	$self->{remote_candidates} = {}; # foundation -> candidate
 	$self->{candidate_pairs} = {}; # foundation pairs -> pair
 	$self->{remote_peers} = {}; # peer_hash_key -> component
 	$self->{changed_foundations} = {}; # old -> new

 	$self->{triggered_checks} = [];
 	$self->{last_timer} = 0;

 	$self->debug("created, controll" . ($controlling ? "ing" : "ed")
 		. ", tie breaker " . $self->{tie_breaker}->bstr() . "\n");

 	return $self;
 }

 sub i64from32 {
 	my ($hi, $lo) = @_;
 	my $i = Math::BigInt->new(int($hi));
 	$i->blsft(32);
 	$i->badd(int($lo));
 	return $i;
 }

 sub calc_priority {
 	my ($type, $local_pref, $component) = @_;
 	defined($type_preferences{$type}) or die;
 	return (2 ** 24) * $type_preferences{$type} + (2 ** 8) * $local_pref + (256 - $component);
 }

 sub add_candidate {
 	my ($self, $local_pref, $type, @components) = @_;
 	# highest local pref = 65535, lowest = 0

 	@components == $self->{components} or die;
 	defined($type_preferences{$type}) or die;

 	my $foundation = random_string(16);
 	my $cands = $self->{candidates};
 	$cands->{$foundation} and die;

 	my $comps = [];
 	my $comp_id = 1;
 	for my $c (@components) {
 		my $comp = { socket => $c, component => $comp_id,
 				priority => calc_priority($type, $local_pref, $comp_id),
 				foundation => $foundation,
 				protocol => 'UDP', af => $c->sockdomain(),
 				address => $c->sockhost(), port => $c->sockport() };
 		push(@$comps, $comp);
 		$self->debug("$foundation/$comp_id is $comp->{address}/$comp->{port}\n");

 		$comp_id++;
 	}

 	$cands->{$foundation} = { foundation => $foundation, preference => $local_pref,
 		base_priority => calc_priority($type, $local_pref, 0),
 		type => $type, components => $comps, protocol => 'UDP',
 		af => $comps->[0]->{af}, address => $comps->[0]->{address} };

 	$self->pair_candidates();
 }

 sub encode {
 	my ($self) = @_;

 	my @ret;

 	push(@ret, "a=ice-ufrag:$self->{my_ufrag}");
 	push(@ret, "a=ice-pwd:$self->{my_pwd}");

 	for my $cand (values(%{$self->{candidates}})) {
 		for my $comp (@{$cand->{components}}) {
 			my $prot = $comp->{socket}->protocol();
 			my $sa = $comp->{socket}->sockhost();
 			my $sp = $comp->{socket}->sockport();
 			push(@ret, "a=candidate:$cand->{foundation} $comp->{component} $protocols{$prot} $comp->{priority} $sa $sp typ $cand->{type}");
 		}
 	}

 	return @ret;
 }

 sub remote_foundation_change {
 	my ($self, $old, $new, $type) = @_;

 	if ($self->{changed_foundations}->{$old}) {
 		$self->{changed_foundations}->{$old} eq $new or die;
 		return;
 	}
 	$self->debug("changing remote candidate foundation from $old to $new\n");
 	my $old_cand = $self->{remote_candidates}->{$old} or die;
 	$old_cand->{type} = $type;
 	$old_cand->{foundation} = $new;

 	for my $comp (@{$old_cand->{components}}) {
 		$comp->{foundation} = $new;
 	}

 	for my $foundation_pair (keys(%{$self->{candidate_pairs}})) {
 		my $pair = $self->{candidate_pairs}->{$foundation_pair};
 		$pair->{remote} == $old_cand or next;

 		my $new_foundation = $pair->{local}->{foundation} . $new;
 		delete($self->{candidate_pairs}->{$foundation_pair});
 		$self->{candidate_pairs}->{$new_foundation} = $pair;

 		for my $comp (@{$pair->{components}}) {
 			$comp->{foundation} = $new_foundation;
 		}
 	}

 	$self->{remote_candidates}->{$new} = $old_cand;
 	delete($self->{remote_candidates}->{$old});
 	$self->{changed_foundations}->{$old} = $new;
 }

 sub new_remote_candidate {
 	my ($self, $cand_str) = @_;
 	$self->_new_remote_candidates_start();
 	my $ret = $self->_new_remote_candidate($cand_str);
 	$self->_got_new_candidates();
 	return $ret;
 }

 sub _new_remote_candidates_start {
 	my ($self) = @_;
 	$self->{new_candidates} = {};
 }

 sub _new_remote_candidate {
 	my ($self, $c) = @_;

 	$self->debug("adding remote candidate $c\n");
 	my ($foundation, $component, $protocol, $priority, $address, $port, $type)
 		= $c =~ /^(\w+) (\d) (\w+) (\d+) ([0-9a-fA-F:.]+) (\d+) typ (\w+)/ or die $c;

 	$protocol = uc($protocol);
 	my $phk = "$protocol/$address/$port";

 	if (my $old = $self->{remote_peers}->{$phk}) {
 		# must be a previously learned prflx candidate
 		$old = $old->{candidate};
 		$old->{type} eq 'prflx' or die;
 		# replace the learned prflx candidate with the new one
 		$self->remote_foundation_change($old->{foundation}, $foundation, $type);
 		return;
 	}

 	my $f = ($self->{new_candidates}->{$foundation} // (
 		$self->{new_candidates}->{$foundation} = {
 			foundation => $foundation,
 			type => $type,
 			protocol => $protocol,
 			components => [],
 		}));

 	$f->{type} eq $type or die;
 	$f->{protocol} eq $protocol or die;

 	$f->{components}->[$component - 1] and die;
 	my $comp = $f->{components}->[$component - 1] = {
 		candidate => $f,
 		foundation => $foundation,
 		component => $component,
 		priority => $priority,
 		address => $address,
 		port => $port,
 		peer_hash_key => $phk,
 	};

 	if ($address =~ /^\d+\.\d+\.\d+\.\d+$/) {
 		$f->{af} = $comp->{af} = &AF_INET;
 		$comp->{packed_peer} = pack_sockaddr_in($port, inet_pton(&AF_INET, $address));
 	}
 	elsif ($address =~ /^[0-9a-fA-F:]+$/) {
 		$f->{af} = $comp->{af} = &AF_INET6;
 		$comp->{packed_peer} = pack_sockaddr_in6($port, inet_pton(&AF_INET6, $address));
 	}
 	else {
 		die;
 	}

 	$self->{remote_peers}->{$phk} = $comp;

 	return $comp;
 }

 sub _got_new_candidates {
 	my ($self) = @_;

 	# validate received info and eliminate duplicates
 	my $r_cand = $self->{remote_candidates};
 	my $r_peers = $self->{remote_peers};
 	for my $c (values(%{$self->{new_candidates}})) {
 		# @{$c->{components}} == $self->{components} or die;

 		if (my $exist = $r_cand->{$c->{foundation}}) {
 			# duplicate. OK if this is a learned prflx
 			if ($exist->{type} eq 'prflx' && $c->{type} eq 'prflx') {
 				# merge components
 				for my $idx (0 .. $#{$c->{components}}) {
 					defined($c->{components}->[$idx]) or next;
 					defined($exist->{components}->[$idx]) and die;
 					$exist->{components}->[$idx] = $c->{components}->[$idx];
 				}
 				next;
 			}
 			warn;
 			next;
 		}
 		$r_cand->{$c->{foundation}} = $c;
 	}

 	delete($self->{new_candidates});
 	$self->pair_candidates();
 };

 sub decode {
 	my ($self, $h) = @_;
 	# $h is output of SDP::Media->decode_ice()

 	$self->{other_ufrag} = $h->{ufrag} or die;
 	$self->{other_pwd} = $h->{pwd} or die;

 	my $cands = $h->{candidates} or die;
 	$self->_new_remote_candidates_start();
 	for my $c (@$cands) {
 		$self->_new_remote_candidate($c);
 	}
 	$self->_got_new_candidates();
 }

 sub pair_candidates {
 	my ($self) = @_;

 	my $pairs = $self->{candidate_pairs};

 	for my $rem (values(%{$self->{remote_candidates}})) {
 		for my $loc (values(%{$self->{candidates}})) {
 			$loc->{protocol} eq $rem->{protocol} or next;
 			$loc->{af} == $rem->{af} or next;

 			@{$loc->{components}} == $self->{components} or die;

 			my $foundation = $loc->{foundation} . $rem->{foundation};
 			my $pair = $pairs->{$foundation} || ($pairs->{$foundation} =
 					{ foundation => $foundation, local => $loc, remote => $rem,
 					components => []}
 				);
 			my $comps = $pair->{components};

 			for my $idx (0 .. ($self->{components} - 1)) {
 				defined($loc->{components}->[$idx]) or next;
 				defined($rem->{components}->[$idx]) or next;

 				my $c = $comps->[$idx] || ($comps->[$idx] =
 					{ foundation => $foundation,
 					local => $loc->{components}->[$idx],
 					remote => $rem->{components}->[$idx] });
 				$c->{state} = $c->{state} || ($idx == 0 ? 'waiting' : 'frozen');
 			}
 		}
 	}
 }

 sub pair_priority {
 	my ($self, $pair) = @_;
 	# could be a candidate pair or a component pair. only components have priorities
 	my $gk = $self->{controlling} ? 'local' : 'remote';
 	my $dk = $self->{controlling} ? 'remote' : 'local';
 	my $gc = $pair->{$gk};
 	my $dc = $pair->{$dk};
 	if (exists($gc->{components})) {
 		$gc = $gc->{components}->[0];
 		$dc = $dc->{components}->[0];
 	}
 	my $g = $gc->{priority};
 	my $d = $dc->{priority};
 	return (($g < $d ? $g : $d) << 32) + (($g > $d ? $g : $d) * 2) + ($g > $d ? 1 : 0);
 }

 sub get_pair {
 	my ($self, $local, $remote, $component) = @_;
 	my $found = "$local$remote";
 	my $pair = $self->{candidate_pairs}->{$found} or return;
 	$component or return $pair;
 	return $pair->{components}->[$component - 1];
 }

 sub is_ice {
 	my ($s) = @_;

 	length($s) < 20 and return 0;
 	my $c = ord(substr($s, 0, 1));
 	($c & 0xb0) != 0 and return 0;
 	$c = ord(substr($s, 3, 1));
 	($c & 0x03) != 0 and return 0;
 	$c = substr($s, 4, 4);
 	$c ne "\x21\x12\xA4\x42" and return 0;
 	return 1;
 }

 sub input {
 	my ($self, $fh, $s_r, $peer) = @_;

 	$$s_r eq '' and return;
 	is_ice($$s_r) or return;

 	for my $cands (values(%{$self->{candidates}})) {
 		for my $comp (@{$cands->{components}}) {
 			$fh == $comp->{socket} or next;
 			$self->do_input($comp, $$s_r, $peer);
 			$$s_r = '';
 			return;
 		}
 	}
 }

 my %attr_handlers = (
 	0x0006 => \&stun_handler_USERNAME,
 	0x0008 => \&stun_handler_MESSAGE_INTEGRITY,
 	0x0009 => \&stun_handler_ERROR_CODE,
 	0x000a => \&stun_handler_UNKNOWN_ATTRIBUTES,
 	0x0020 => \&stun_handler_XOR_MAPPED_ADDRESS,
 	0x0024 => \&stun_handler_PRIORITY,
 	0x0025 => \&stun_handler_USE_CANDIDATE,
 	0x8022 => \&stun_handler_SOFTWARE,
 	0x8028 => \&stun_handler_FINGERPRINT,
 	0x8029 => \&stun_handler_ICE_CONTROLLED,
 	0x802a => \&stun_handler_ICE_CONTROLLING,
 );

 my %type_handlers = (
 	1   => \&stun_handler_binding_request,
 	17  => \&stun_handler_binding_indication,
 	257 => \&stun_handler_binding_success,
 	273 => \&stun_handler_binding_error,
 );

 sub do_input {
 	my ($self, $comp, $s, $peer) = @_;

 	my $hdr = substr($s, 0, 20, '');
 	my ($mtype, $mlen, $cookie, $tid) = unpack('nnNa12', $hdr);
 	$cookie == 0x2112A442 or return;

 	my (@stack, %hash);

 	while (my ($type, $len) = unpack('nn', $s)) {
 		my $padding = 4 - ($len % 4);
 		$padding == 4 and $padding = 0;

 		my $raw = substr($s, 0, 4 + $len + $padding);

 		substr($s, 0, 4) = '';
 		my $data = substr($s, 0, $len, '');
 		substr($s, 0, $padding) = '';

 		my $handler = $attr_handlers{$type};
 		if (!$handler) {
 			warn("unknown STUN attribute $type data $data");
 			next;
 		}

 		my $parsed = $handler->($data, $tid) or die;
 		$parsed->{raw} = $raw;

 		push(@stack, $parsed);
 		$hash{$parsed->{name}} = $parsed;
 	}

 	$stack[$#stack]->{name} eq 'fingerprint' or die;
 	$stack[$#stack - 1]->{name} eq 'integrity' or die;

 	my $pwd_check = $mtype == 1 ? $self->{my_pwd} : $self->{other_pwd};
 	# XXX unify these with sub integrity/fingerprint ?
 	my $int_check = join('', (map {$_->{raw}} @stack[0 .. ($#stack - 2)]));
 	$int_check = pack('nnNa12', $mtype, length($int_check) + 24, $cookie, $tid) . $int_check;
 	my $digest = hmac_sha1($int_check, $pwd_check);
 	$digest eq $hash{integrity}->{digest} or die;

 	my $fp_check = join('', (map {$_->{raw}} @stack[0 .. ($#stack - 1)]));
 	$fp_check = pack('nnNa12', $mtype, length($fp_check) + 8, $cookie, $tid) . $fp_check;
 	my $crc = crc32($fp_check);
 	($crc ^ 0x5354554e) == $hash{fingerprint}->{crc} or die;

 	# decode peer address
 	my $domain = $comp->{af};
 	my (@peer, $address);
 	if ($domain == &AF_INET) {
 		@peer = unpack_sockaddr_in($peer);
 	}
 	elsif ($domain == &AF_INET6) {
 		@peer = unpack_sockaddr_in6($peer);
 	}
 	else {
 		die;
 	}
 	$address = inet_ntop($domain, $peer[1]);

 	# process it
 	my $handler = $type_handlers{$mtype} or die;
 	my $response = $handler->($self, $comp, \@stack, \%hash, $tid, $peer, $peer[1], $address, $peer[0]);

 	if ($response) {
 		# construct and send response packet
 		$self->integrity($response->{attrs}, $response->{mtype}, $tid, $self->{my_pwd});
 		$self->fingerprint($response->{attrs}, $response->{mtype}, $tid);

 		# XXX unify
 		my $packet = join('', @{$response->{attrs}});
 		$packet = pack('nnNa12', $response->{mtype}, length($packet), 0x2112A442, $tid) . $packet;
 		$comp->{socket}->send($packet, 0, $peer);
 	}
 }

 sub stun_reply {
 	my ($self, $attrs, $mtype) = @_;

 	unshift(@$attrs, attr(0x8022, 'perl:ICE.pm'));

 	my $response = { mtype => $mtype, attrs => $attrs };
 }

 sub stun_success {
 	my ($self, $attrs) = @_;
 	return $self->stun_reply($attrs, 257);
 }

 sub stun_error {
 	my ($self, $code, $msg) = @_;
 	return $self->stun_reply([ attr(0x0009, pack('Na*', ((($code / 100) << 8) | ($code % 100)), $msg)) ], 273);
 }

 sub debug {
 	my ($self, @rest) = @_;
 	print("ICE agent", ' ', $self->{my_ufrag}, ' - ', @rest);
 }

 sub dummy_foundation {
 	my ($protocol, $address) = @_;
 	return $protocol . unpack('H*', $address);
 }

 sub stun_handler_binding_request {
 	my ($self, $comp, $stack, $hash, $tid, $packed_peer, $packed_host, $address, $port) = @_;

 	$hash->{username}->{my_ufrag} eq $self->{my_ufrag} or die;

 	# check role
 	if ($self->{controlling} && $hash->{controlling}) {
 		if ($self->{tie_breaker}->bcmp($hash->{controlling}->{tie_breaker}) >= 0) {
 			$self->debug("returning 487 role conflict\n");
 			return $self->stun_error(487, "Role conflict");
 		}
 		$self->debug("role conflict, switching to controlled\n");
 		$self->{controlling} = 0;
 	}
 	elsif (!$self->{controlling} && $hash->{controlled}) {
 		if ($self->{tie_breaker}->bcmp($hash->{controlled}->{tie_breaker}) < 0) {
 			$self->debug("returning 487 role conflict\n");
 			return $self->stun_error(487, "Role conflict");
 		}
 		$self->debug("role conflict, switching to controlling\n");
 		$self->{controlling} = 1;
 	}

 	$self->debug("binding request from $address/$port\n");

 	# check if peer is known - learn prflx candidates
 	my $cand = $self->{remote_peers}->{"UDP/$address/$port"};
 	if (!$cand) {
 		$cand = $self->new_remote_candidate(dummy_foundation('UDP', $packed_host)
 			. " $comp->{component} UDP "
 			. "$hash->{priority}->{priority} $address $port typ prflx");
 		# this also pairs up the new candidate, which goes against 7.2.1.3
 	}

 	# get candidate pair and trigger check
 	my $pair = $self->get_pair($comp->{foundation}, $cand->{foundation}, $comp->{component});
 	$pair or die;
 	$self->trigger_check($pair);

 	# set and check nominations
 	if ($hash->{use}) {
 		$pair->{nominated} = 1;
 		$self->debug("$pair->{foundation} - got nominated\n");
 		$self->{controlling} or $self->check_nominations();
 	}

 	# construct response
 	my $attrs = [];

 	if ($comp->{af} == &AF_INET) {
 		push(@$attrs, attr(0x0020, pack('nna4', 1, $port ^ 0x2112, $packed_host ^ "\x21\x12\xa4\x42")));
 	}
 	elsif ($comp->{af} == &AF_INET6) {
 		push(@$attrs, attr(0x0020, pack('nna16', 2, $port ^ 0x2112,
 			$packed_host ^ ("\x21\x12\xa4\x42" . $tid))));
 	}

 	return $self->stun_success($attrs);
 }

 sub check_nominations {
 	my ($self) = @_;

 	my @nominated;

 	for my $pair (values(%{$self->{candidate_pairs}})) {
 		my @comps = @{$pair->{components}};
 		my @nominated_comps = grep {$_->{nominated}} @comps;
 		@comps < $self->{components} and next;
 		$self->debug("got fully nominated pair $pair->{foundation}\n");
 		push(@nominated, $pair);
 	}

 	if (!@nominated) {
 		$self->debug("no fully nominated pairs yet\n");
 		return;
 	}

 	@nominated = $self->sort_pairs(\@nominated);
 	my $pair = $nominated[0];
 	$self->debug("highest priority nominated pair is $pair->{foundation}\n");
 }

 sub stun_handler_binding_success {
 	my ($self, $comp, $stack, $hash, $tid, $packed_peer, $packed_host, $address, $port) = @_;

 	$self->debug("binding success from $address/$port\n");

 	# check xor address
 	$comp->{address} eq $hash->{address}->{address} or die;
 	$comp->{port} == $hash->{address}->{port} or die;

 	# we must have remote candidate and a pair
 	my $cand = $self->{remote_peers}->{"UDP/$address/$port"};
 	$cand or die;
 	my $pair = $self->get_pair($comp->{foundation}, $cand->{foundation}, $comp->{component});
 	$pair or die;
 	$tid eq $pair->{transaction} or die;

 	$self->debug("$pair->{foundation} succeeded\n");
 	$pair->{state} = 'succeeded';

 	# unfreeze other components
 	my $parent_pair = $self->{candidate_pairs}->{$pair->{foundation}};
 	my $components = $parent_pair->{components};
 	my @frozen_pairs = grep {$_->{state} eq 'frozen'} @$components;
 	for my $p (@frozen_pairs) {
 		$self->debug("unfreezing $p->{local}->{port}\n");
 		$p->{state} = 'waiting';
 	}

 	return;
 }

 sub integrity {
 	my ($self, $attrs, $mtype, $tid, $pwd) = @_;

 	my $int_check = join('', @$attrs);
 	$int_check = pack('nnNa12', $mtype, length($int_check) + 24, 0x2112A442, $tid) . $int_check;
 	my $digest = hmac_sha1($int_check, $pwd);
 	push(@$attrs, attr(0x0008, $digest));
 }

 sub fingerprint {
 	my ($self, $attrs, $mtype, $tid) = @_;

 	my $fp_check = join('', @$attrs);
 	$fp_check = pack('nnNa12', $mtype, length($fp_check) + 8, 0x2112A442, $tid) . $fp_check;
 	my $crc = crc32($fp_check);
 	push(@$attrs, attr(0x8028, pack('N', ($crc ^ 0x5354554e))));
 }

 sub attr {
 	my ($id, $data) = @_;
 	my $len = length($data);
 	my $padding = 4 - ($len % 4);
 	$padding == 4 and $padding = 0;
 	return pack('nn a*a*', $id, $len, $data, "\0" x $padding);
 }

 sub stun_handler_SOFTWARE {
 	my ($data, $out) = @_;
 	return { name => 'software', data => $data };
 }
 sub stun_handler_USE_CANDIDATE {
 	my ($data, $out) = @_;
 	return { name => 'use' };
 }
 sub stun_handler_ICE_CONTROLLED {
 	my ($data) = @_;
 	my $out = { name => 'controlled' };
 	$out->{controlled} = 1;
 	($out->{tie_breaker_hi}, $out->{tie_breaker_lo}) = unpack('NN', $data);
 	$out->{tie_breaker} = i64from32($out->{tie_breaker_hi}, $out->{tie_breaker_lo});
 	return $out;
 }
 sub stun_handler_ICE_CONTROLLING {
 	my ($data) = @_;
 	my $out = { name => 'controlling' };
 	$out->{controlling} = 1;
 	($out->{tie_breaker_hi}, $out->{tie_breaker_lo}) = unpack('NN', $data);
 	$out->{tie_breaker} = i64from32($out->{tie_breaker_hi}, $out->{tie_breaker_lo});
 	return $out;
 }
 sub stun_handler_USERNAME {
 	my ($data) = @_;
 	my $out = { name => 'username' };
 	$data =~ /^(.*):(.*)$/ or die;
 	$out->{my_ufrag} = $1;
 	$out->{other_ufrag} = $2;
 	return $out;
 }
 sub stun_handler_PRIORITY {
 	my ($data) = @_;
 	my $out = { name => 'priority' };
 	($out->{priority}) = unpack('N', $data);
 	return $out;
 }
 sub stun_handler_MESSAGE_INTEGRITY {
 	my ($data) = @_;
 	my $out = { name => 'integrity' };
 	$out->{digest} = $data;
 	return $out;
 }
 sub stun_handler_FINGERPRINT {
 	my ($data) = @_;
 	my $out = { name => 'fingerprint' };
 	($out->{crc}) = unpack('N', $data);
 	return $out;
 }
 sub stun_handler_ERROR_CODE {
 	my ($data) = @_;
 	my $out = { name => 'error' };
 	my ($code, $msg) = unpack('Na*', $data);
 	$out->{msg} = $msg;
 	$out->{code} = (($code & 0x700) >> 8) * 100 + ($code & 0x0ff);
 	return $out;
 }
 sub stun_handler_XOR_MAPPED_ADDRESS {
 	my ($data, $tid) = @_;
 	my $out = { name => 'address' };
 	if (length($data) == 8) {
 		my ($fam, $port, $addr) = unpack('nna4', $data);
 		$fam == 1 or die;
 		$out->{af} = &AF_INET;
 		$out->{port} = $port ^ 0x2112;
 		$out->{address} = $addr ^ "\x21\x12\xa4\x42";
 	}
 	elsif (length($data) == 20) {
 		my ($fam, $port, $addr) = unpack('nna16', $data);
 		$fam == 2 or die;
 		$out->{af} = &AF_INET6;
 		$out->{port} = $port ^ 0x2112;
 		$out->{address} = $addr ^ ("\x21\x12\xa4\x42" . $tid);
 	}
 	else {
 		die;
 	}
 	$out->{address} = inet_ntop($out->{af}, $out->{address});
 	return $out;
 }

 sub timer {
 	my ($self) = @_;
 	my $now = time();
 	$now - $self->{last_timer} < 0.02 and return;
 	$self->{last_timer} = $now;

 	# run checks

 	defined($self->{other_ufrag}) && defined($self->{other_pwd}) or return; # not enough info

 	if (my $pair = shift(@{$self->{triggered_checks}})) {
 		$self->debug("$pair->{foundation} - running triggered check\n");
 		$self->run_check($pair);
 		return;
 	}

 	# get all component pairs, sort by their priority and run check for the highest waiting one

 	my @candidate_pairs = values(%{$self->{candidate_pairs}});
 	my @component_pairs = map {@{$_->{components}}} @candidate_pairs;
 	my @sorted_pairs = $self->sort_pairs(\@component_pairs);
 	my @waiting_pairs = grep {$_->{state} eq 'waiting'} @sorted_pairs;

 	if (my $pair = shift(@waiting_pairs)) {
 		$self->debug("$pair->{foundation} - running scheduled check (waiting state)\n");
 		$self->run_check($pair);
 		return;
 	}
 }

 sub sort_pairs {
 	my ($self, $pair_list) = @_;
 	return sort {$self->pair_priority($a) <=> $self->pair_priority($b)} @$pair_list;
 }

 sub trigger_check {
 	my ($self, $pair) = @_;
 	$self->debug("$pair->{foundation} - trigger check\n");
 	if ($pair->{state} eq 'succeeded') {
 		$self->debug("$pair->{foundation} - already succeeded\n");
 		return;
 	}
 	if ($pair->{state} eq 'in progress') {
 		$self->cancel_check($pair);
 	}
 	push(@{$self->{triggered_checks}}, $pair);
 }

 sub run_check {
 	my ($self, $pair) = @_;

 	$pair->{state} eq 'in progress' and return;

 	$self->debug("$pair->{foundation} - running check\n");
 	$pair->{state} = 'in progress';
 	$pair->{transaction} = random_string(12);
 	$self->send_check($pair);
 }

 sub cancel_check {
 	my ($self, $pair) = @_;
 	$self->debug("$pair->{foundation} - canceling existing check $pair->{transaction}\n");
 	$pair->{previous_transactions}->{$pair->{transaction}} = 1;
 	delete $pair->{transaction};
 	$pair->{state} = 'waiting';
 }

 sub send_check {
 	my ($self, $pair) = @_;

 	$self->debug("$pair->{foundation} - sending check $pair->{transaction}\n");

 	$pair->{last_transmit} = time();
 	my $local_comp = $pair->{local};
 	my $remote_comp = $pair->{remote};
 	my $local_cand = $self->{candidates}->{$local_comp->{foundation}};

 	my $attrs = [];
 	unshift(@$attrs, attr(0x8022, 'perl:ICE.pm'));
 	my $hexbrk = $self->{tie_breaker}->as_hex();
 	$hexbrk =~ s/^0x// or die;
 	$hexbrk = ('0' x (16 - length($hexbrk))) . $hexbrk;
 	unshift(@$attrs, attr($self->{controlling} ? 0x802a : 0x8029, pack('H*', $hexbrk)));
 	unshift(@$attrs, attr(0x0024, pack('N', calc_priority('prflx',
 				$local_cand->{preference}, $local_comp->{component}))));
 	unshift(@$attrs, attr(0x0006, "$self->{other_ufrag}:$self->{my_ufrag}"));

 	$self->integrity($attrs, 1, $pair->{transaction}, $self->{other_pwd});
 	$self->fingerprint($attrs, 1, $pair->{transaction});

 	my $packet = join('', @$attrs);
 	$packet = pack('nnNa12', 1, length($packet), 0x2112A442, $pair->{transaction}) . $packet;
 	$local_comp->{socket}->send($packet, 0, $remote_comp->{packed_peer});
 }

 # XXX use multiple packages here for candidates, components and pairs

 1;
--- a/utils/RTP.pm
+++ b/utils/RTP.pm
@ -0,0 +1,6 @@
 package RTP;

 use strict;
 use warnings;

 1;
--- a/utils/Rtpengine.pm
+++ b/utils/Rtpengine.pm
@ -0,0 +1,55 @@
 package Rtpengine;

 use strict;
 use warnings;
 use IO::Socket::IP;
 use Bencode;
 use Data::Dumper;

 sub new {
 	my ($class, $addr, $port) = @_;

 	my $self = {};
 	bless $self, $class;

 	if (ref($addr)) {
 		$self->{socket} = $addr;
 	}
 	else {
 		$self->{socket} = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp',
 				PeerHost => $addr, PeerPort => $port);
 	}

 	return $self;
 }

 sub req {
 	my ($self, $packet) = @_;

 	my $cookie = rand() . ' ';
 	my $p = $cookie . Bencode::bencode($packet);
 	$self->{socket}->send($p, 0) or die $!;
 	my $ret;
 	$self->{socket}->recv($ret, 65535) or die $!;
 	$ret =~ s/^\Q$cookie\E//s or die $ret;
 	my $resp = Bencode::bdecode($ret, 1);

 	$resp->{result} or die Dumper $resp;

 	if ($resp->{result} eq 'error') {
 		die "Error reason: \"$resp->{'error-reason'}\"";
 	}

 	return $resp;
 }

 sub offer {
 	my ($self, $packet) = @_;
 	return $self->req( { %$packet, command => 'offer' } );
 }
 sub answer {
 	my ($self, $packet) = @_;
 	return $self->req( { %$packet, command => 'answer' } );
 }

 1;
--- a/utils/SDP.pm
+++ b/utils/SDP.pm
@ -0,0 +1,221 @@
 package SDP;

 use strict;
 use warnings;
 use IO::Socket;
 use Time::HiRes qw(gettimeofday);

 sub new {
 	my ($class, $origin, $connection) = @_;

 	my $self = {};
 	bless $self, $class;

 	$self->{version} = 1;
 	$self->{medias} = [];
 	$self->{origin} = $origin;
 	$self->{connection} = $connection;

 	return $self;
 }

 sub decode {
 	my ($class, $body) = @_;

 	my $self = {};
 	bless $self, $class;

 	my $medias = $self->{medias} = [];

 	my @lines = split(/\r\n/, $body);

 	my ($media, $attr_store);

 	for my $line (@lines) {
 		$attr_store = $media ? $media : $self;

 		if ($line =~ /^[ost]=/) {
 			# ignore
 			next;
 		}
 		if ($line =~ /^m=(\S+) (\d+) (\S+) (\d+(?: \d+)*)$/s) {
 			$media = $self->add_media(SDP::Media->new_remote($1, $2, $3, $4));
 			next;
 		}
 		if ($line =~ /^c=(.*)$/) {
 			$attr_store->{connection} = decode_address($1);
 			next;
 		}
 		if ($line =~ /^a=(([\w-]+)(?::(.*))?)$/) {
 			my $full = $1;
 			my $name = $2;
 			my $cont = $3;

 			push(@{$attr_store->{attributes_list}}, $full);
 			push(@{$attr_store->{attributes_hash}->{$name}}, $cont);
 		}
 	}

 	for my $m (@$medias) {
 		$m->decode();
 	}

 	return $self;
 }

 sub add_media {
 	my ($self, $media) = @_;

 	push(@{$self->{medias}}, $media);
 	$media->{parent} = $self;

 	return $media;
 }

 sub encode {
 	my ($self) = @_;

 	my ($secs, $msecs) = gettimeofday();

 	my @out;

 	push(@out, 'v=0');
 	push(@out, 'o=- ' . ($secs ^ $msecs) . ' ' . ($self->{version}++) . ' ' . encode_address($self->{origin}));
 	push(@out, 's=tester');
 	$self->{connection} and push(@out, 'c=' . encode_address($self->{connection}));
 	push(@out, 't=0 0');

 	for my $m (@{$self->{medias}}) {
 		push(@out, $m->encode($self->{connection}));
 	}

 	return join("\r\n", @out) . "\r\n";
 }

 sub encode_address {
 	my ($sock) = @_;

 	my $domain = $sock->sockdomain();
 	my $addr = $sock->sockhost();

 	$domain == &AF_INET and return "IN IP4 $addr";
 	$domain == &AF_INET6 and return "IN IP6 $addr";
 	die "$domain $addr";
 }

 sub decode_address {
 	my ($s) = @_;
 	if ($s =~ /^IN IP4 (\d+\.\d+\.\d+\.\d+)$/s) {
 		return $1;
 	}
 	if ($s =~ /^IN IP6 ([0-9a-fA-F:]+)$/s) {
 		return $1;
 	}
 	die $s;
 }


 package SDP::Media;

 sub new {
 	my ($class, $rtp, $rtcp, $protocol, $type) = @_;

 	my $self = {};
 	bless $self, $class;

 	$self->{rtp} = $rtp; # main transport
 	$self->{rtcp} = $rtcp; # optional
 	$self->{protocol} = $protocol // 'RTP/AVP';
 	$self->{type} = $type // 'audio';
 	$self->{payload_types} = [0];

 	$self->{additional_attributes} = [];

 	return $self;
 };

 sub new_remote {
 	my ($class, $protocol, $port, $type, $payload_types) = @_;

 	my $self = {};
 	bless $self, $class;

 	$self->{protocol} = $protocol;
 	$self->{port} = $port;
 	$self->{type} = $type;
 	$self->{payload_types} = [split(/ /, $payload_types)];

 	return $self;
 };

 sub add_attrs {
 	my ($self, @list) = @_;
 	push(@{$self->{additional_attributes}}, @list);
 }

 sub encode {
 	my ($self, $parent_connection) = @_;

 	my $pconn = $parent_connection ? SDP::encode_address($parent_connection) : '';
 	my @out;

 	push(@out, "m=$self->{type} " . $self->{rtp}->sockport() . ' ' . $self->{protocol} . ' '
 		. join(' ', @{$self->{payload_types}}));

 	my $rtpconn = SDP::encode_address($self->{rtp});
 	$rtpconn eq $pconn or push(@out, "c=$rtpconn");

 	push(@out, 'a=sendrecv');

 	if ($self->{rtcp}) {
 		my $rtcpconn = SDP::encode_address($self->{rtcp});
 		push(@out, 'a=rtcp:' . $self->{rtcp}->sockport()
 			. ($rtcpconn eq $rtpconn ? '' : (' ' . SDP::encode_address($self->{rtcp}))));
 	}

 	push(@out, @{$self->{additional_attributes}});

 	return @out;
 }

 sub decode {
 	my ($self) = @_;

 	my $attrs = $self->{attributes_hash};

 	if ($attrs->{rtcp}) {
 		my $a = $attrs->{rtcp}->[0];
 		$a =~ /^(\d+)(?: (IN .*))?$/ or die $a;
 		$self->{rtcp_port} = $1;
 		$2 and $self->{rtcp_connection} = decode_address($2);
 	}
 }

 sub connection {
 	my ($self) = @_;
 	$self->{connection} and return $self->{connection};
 	return $self->{parent}->{connection};
 }

 sub rtcp_port {
 	my ($self) = @_;
 	$self->{rtcp_port} and return $self->{rtcp_port};
 	return $self->{port} + 1;
 }

 sub rtcp_connection {
 	my ($self) = @_;
 	$self->{rtcp_connection} and return $self->{rtcp_connection};
 	return $self->connection();
 }

 sub decode_ice {
 	my ($self) = @_;
 	my $ret = {};
 	$ret->{ufrag} = $self->{attributes_hash}->{'ice-ufrag'}->[0];
 	$ret->{pwd} = $self->{attributes_hash}->{'ice-pwd'}->[0];
 	$ret->{candidates} = $self->{attributes_hash}->{'candidate'};
 	return $ret;
 }

 1;
--- a/utils/SRTP.pm
+++ b/utils/SRTP.pm
@ -11,6 +11,7 @@ our $SRTP_DEBUG = 0;
 our @crypto_suites = (
 	{
 		str		=> 'AES_CM_128_HMAC_SHA1_80',
 		dtls_name	=> 'SRTP_AES128_CM_SHA1_80',
 		auth_tag	=> 10,
 		enc_func	=> \&aes_cm,
 		iv_rtp		=> \&aes_cm_iv_rtp,
@ -18,6 +19,7 @@ our @crypto_suites = (
 	},
 	{
 		str		=> 'AES_CM_128_HMAC_SHA1_32',
 		dtls_name	=> 'SRTP_AES128_CM_SHA1_32',
 		auth_tag	=> 4,
 		enc_func	=> \&aes_cm,
 		iv_rtp		=> \&aes_cm_iv_rtp,
--- a/utils/ng-client
+++ b/utils/ng-client
@ -5,11 +5,9 @@

 use warnings;
 use strict;
 use Bencode qw(bencode bdecode);
 use Getopt::Long;
 use Socket;
 use Socket6;
 use Data::Dumper;
 use Rtpengine;

 my %options = ('proxy-address' => 'localhost', 'proxy-port' => 2223);

@ -81,45 +79,32 @@ elsif (defined($options{'sdp-file'})) {
 	close(F);
 	$packet{sdp} = join('', @sdp);
 }
 elsif (@ARGV && $ARGV[0] eq 'sdp') {
 	shift(@ARGV);
 	$options{'client-address'} or die;
 	my ($ca, $cp);
 	if ($ca = inet_pton(AF_INET, $options{'client-address'})) {
 		$ca = inet_ntop(AF_INET, $ca);
 		$cp = "IP4";
 	}
 	elsif ($ca = inet_pton(AF_INET6, $options{'client-address'})) {
 		$ca = inet_ntop(AF_INET6, $ca);
 		$cp = "IP6";
 	}
 	$ca or die;
 	my $sdp = "v=0\r\no=- 12345 67890 IN $cp $ca\r\ns=session\r\nc=IN $cp $ca\r\nt=0 0\r\n";

 	$packet{sdp} = $sdp;
 }
 #elsif (@ARGV && $ARGV[0] eq 'sdp') {
 #	shift(@ARGV);
 #	$options{'client-address'} or die;
 #	my ($ca, $cp);
 #	if ($ca = inet_pton(AF_INET, $options{'client-address'})) {
 #		$ca = inet_ntop(AF_INET, $ca);
 #		$cp = "IP4";
 #	}
 #	elsif ($ca = inet_pton(AF_INET6, $options{'client-address'})) {
 #		$ca = inet_ntop(AF_INET6, $ca);
 #		$cp = "IP6";
 #	}
 #	$ca or die;
 #	my $sdp = "v=0\r\no=- 12345 67890 IN $cp $ca\r\ns=session\r\nc=IN $cp $ca\r\nt=0 0\r\n";
 #
 #	$packet{sdp} = $sdp;
 #}

 $options{verbose} and print Dumper \%packet;

 my $cookie = rand() . ' ';
 my $packet = $cookie . bencode(\%packet);

 socket(S, AF_INET, SOCK_DGRAM, 0) or die $!;
 send(S, $packet, 0, pack_sockaddr_in($options{'proxy-port'}, inet_aton($options{'proxy-address'}))) or die $!;
 my $ret;
 recv(S, $ret, 0x10000, 0);
 $ret =~ s/^\Q$cookie\E//s or die $ret;
 my $resp = bdecode($ret, 1);
 my $engine = Rtpengine->new($options{'proxy-address'}, $options{'proxy-port'});
 my $resp = $engine->req(\%packet);

 #print Dumper $resp;
 #exit;

 exists($$resp{result}) or die Dumper $resp;
 print("Result: \"$$resp{result}\"\n");
 if ($$resp{result} eq 'error') {
 	print("Error reason: \"$$resp{'error-reason'}\"\n");
 	exit(1);
 }
 if (defined($$resp{sdp})) {
 	print("New SDP:\n-----8<-----8<-----8<-----8<-----8<-----\n$$resp{sdp}\n".
 		"----->8----->8----->8----->8----->8-----\n");
--- a/utils/test.pl
+++ b/utils/test.pl
@ -0,0 +1,184 @@
 #!/usr/bin/perl

 use strict;
 use warnings;
 use DTLS;
 use ICE;
 use RTP;
 use SDP;
 use Rtpengine;
 use IO::Socket::IP;
 use IO::Multiplex;
 use Time::HiRes qw(time);

 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:9847:efff:fe2e:f17d
 );
 my @B_interfaces = @A_interfaces;

@A_interfaces = sort {rand() <=> rand()} @A_interfaces;
@B_interfaces = sort {rand() <=> rand()} @B_interfaces;

 my $sport = 2000;

 my (@A_sockets, @B_sockets);

 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]);
 	$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]);
 	$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]));

 # create side A ICE agent

 my $A_ice = ICE->new(2, 1); # 2 components, controlling
 my $pref = 65535;
 for my $s (@A_sockets) {
 	$A_ice->add_candidate($pref--, 'host', @$s); # 2 components
 }

 $A_local_media->add_attrs($A_ice->encode());

 # 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 => 'force', '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];

 # create side B ICE agent

 my $B_ice = ICE->new(2, 0); # 2 components, controlled
 $pref = 65535;
 for my $s (@B_sockets) {
 	$B_ice->add_candidate($pref--, 'host', @$s); # 2 components
 }

 # add remote ICE infos for side B

 $B_ice->decode($B_remote_media->decode_ice());

 # 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);
 	$A_ice->input($fh, $input, $peer);
 	$B_ice->input($fh, $input, $peer);
 }

 sub mux_timeout {
 	my ($self, $mux, $fh) = @_;

 	$A_ice->timer();
 	$B_ice->timer();

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

 	$B_local_media->add_attrs($B_ice->encode());

 	# send side A SDP to rtpengine
 	my $B_local_sdp_body = $B_local_sdp->encode();
 	# XXX validate SDP

 	my $B_answer = { command => 'answer', ICE => 'force', '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];

 	# add remote ICE infos for side B

 	$A_ice->decode($A_remote_media->decode_ice());

 	# return to IO handler loop
 }