RuhNetConsulting
/
rtpengine
mirror of https://github.com/sipwise/rtpengine
1
1
Fork 0
Code Issues 0 Projects 0 Releases 822 Wiki Activity
Browse Source

DTLS tests - WIP 

Change-Id: If0e738486202bbd256da0215a56d58a388a9af42
changes/34/5834/1
Richard Fuchs 10 years ago
parent
942966b463
commit
1f8d8d7325
8 changed files with 1500 additions and 35 deletions
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +209
    -0
      utils/DTLS.pm
  2. +803
    -0
      utils/ICE.pm
  3. +6
    -0
      utils/RTP.pm
  4. +55
    -0
      utils/Rtpengine.pm
  5. +221
    -0
      utils/SDP.pm
  6. +2
    -0
      utils/SRTP.pm
  7. +20
    -35
      utils/ng-client
  8. +184
    -0
      utils/test.pl

+ 209
- 0
utils/DTLS.pm View File

@ -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;

+ 803
- 0
utils/ICE.pm View File

@ -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;

+ 6
- 0
utils/RTP.pm View File

@ -0,0 +1,6 @@
package RTP;
use strict;
use warnings;
1;

+ 55
- 0
utils/Rtpengine.pm View File

@ -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;

+ 221
- 0
utils/SDP.pm View File

@ -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;

+ 2
- 0
utils/SRTP.pm View File

@ -11,6 +11,7 @@ our $SRTP_DEBUG = 0;
our @crypto_suites = ( our @crypto_suites = (
{ {
str => 'AES_CM_128_HMAC_SHA1_80', str => 'AES_CM_128_HMAC_SHA1_80',
dtls_name => 'SRTP_AES128_CM_SHA1_80',
auth_tag => 10, auth_tag => 10,
enc_func => \&aes_cm, enc_func => \&aes_cm,
iv_rtp => \&aes_cm_iv_rtp, iv_rtp => \&aes_cm_iv_rtp,
@ -18,6 +19,7 @@ our @crypto_suites = (
}, },
{ {
str => 'AES_CM_128_HMAC_SHA1_32', str => 'AES_CM_128_HMAC_SHA1_32',
dtls_name => 'SRTP_AES128_CM_SHA1_32',
auth_tag => 4, auth_tag => 4,
enc_func => \&aes_cm, enc_func => \&aes_cm,
iv_rtp => \&aes_cm_iv_rtp, iv_rtp => \&aes_cm_iv_rtp,


+ 20
- 35
utils/ng-client View File

@ -5,11 +5,9 @@
use warnings; use warnings;
use strict; use strict;
use Bencode qw(bencode bdecode);
use Getopt::Long; use Getopt::Long;
use Socket;
use Socket6;
use Data::Dumper; use Data::Dumper;
use Rtpengine;
my %options = ('proxy-address' => 'localhost', 'proxy-port' => 2223); my %options = ('proxy-address' => 'localhost', 'proxy-port' => 2223);
@ -81,45 +79,32 @@ elsif (defined($options{'sdp-file'})) {
close(F); close(F);
$packet{sdp} = join('', @sdp); $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; $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; #print Dumper $resp;
#exit; #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})) { if (defined($$resp{sdp})) {
print("New SDP:\n-----8<-----8<-----8<-----8<-----8<-----\n$$resp{sdp}\n". print("New SDP:\n-----8<-----8<-----8<-----8<-----8<-----\n$$resp{sdp}\n".
"----->8----->8----->8----->8----->8-----\n"); "----->8----->8----->8----->8----->8-----\n");


+ 184
- 0
utils/test.pl View File

@ -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
}

Write Preview
Loading…
Cancel
Save