diff --git a/utils/Rtpengine.pm b/utils/Rtpengine.pm index 2bc513727..4ab72a39d 100644 --- a/utils/Rtpengine.pm +++ b/utils/Rtpengine.pm @@ -2,9 +2,20 @@ package Rtpengine; use strict; use warnings; +use Socket; +use Socket6; +use IO::Socket; use IO::Socket::IP; use Bencode; use Data::Dumper; +use Net::Interface; +use List::Util; +use IO::Multiplex; +use Time::HiRes qw(time); +use SDP; +use ICE; +use DTLS; +use RTP; sub new { my ($class, $addr, $port) = @_; @@ -16,7 +27,7 @@ sub new { $self->{socket} = $addr; } else { - $self->{socket} = IO::Socket::IP->new(Type => SOCK_DGRAM, Proto => 'udp', + $self->{socket} = IO::Socket::IP->new(Type => &Socket::SOCK_DGRAM, Proto => 'udp', PeerHost => $addr, PeerPort => $port); } @@ -55,7 +66,158 @@ sub answer { package Rtpengine::Test; sub new { - my ($class) = @_; + my ($class, $callback) = @_; + + my $self = {}; + bless $self, $class; + + # detect local interfaces + + my @intfs = Net::Interface->interfaces(); + + my @v4 = map {$_->address(&IO::Socket::AF_INET)} @intfs; + @v4 = map {Socket6::inet_ntop(&IO::Socket::AF_INET, $_)} @v4; + @v4 = grep {$_ !~ /^127\./} @v4; + @v4 or die("no IPv4 addresses found"); + + my @v6 = map {$_->address(&IO::Socket::AF_INET6)} @intfs; + @v6 = map {Socket6::inet_ntop(&IO::Socket::AF_INET6, $_)} @v6; + @v6 = grep {$_ !~ /^::|^fe80:/} @v6; + @v4 or die("no IPv6 addresses found"); + + $self->{v4_addresses} = \@v4; + $self->{v6_addresses} = \@v6; + $self->{all_addresses} = [ @v4, @v6 ]; + + # supporting objects + + $self->{mux} = IO::Multiplex->new(); + $self->{mux}->set_callback_object($self); + + $self->{media_port} = 2000; + + $self->{rtpe} = Rtpengine->new('localhost', 2223); + $self->{callid} = rand(); + + $self->{callback} = $callback; + + return $self; }; +sub client { + my ($self, %args) = @_; + return Rtpengine::Test::Client->_new($self, %args); +} + +sub run { + my ($self) = @_; + + $self->{mux}->loop(); +} + +sub mux_input { + my ($self, $mux, $fh, $input) = @_; + + my $peer = $mux->udp_peer($fh); +} + +sub mux_timeout { + my ($self, $mux, $fh) = @_; + + $self->{callback}->(time()); + + $mux->set_timeout($fh, 0.01); +} + + +package Rtpengine::Test::Client; + +sub _new { + my ($class, $parent, %args) = @_; + + my $self = {}; + bless $self, $class; + + $self->{parent} = $parent; + $self->{tag} = rand(); + + # create media sockets + my @addresses = @{$parent->{all_addresses}}; + @addresses = List::Util::shuffle @addresses; + my (@sockets, @rtp, @rtcp); + + for my $address (@addresses) { + my $rtp = IO::Socket::IP->new(Type => &Socket::SOCK_DGRAM, Proto => 'udp', + LocalHost => $address, LocalPort => $parent->{media_port}++) or die($address); + my $rtcp = IO::Socket::IP->new(Type => &Socket::SOCK_DGRAM, Proto => 'udp', + LocalHost => $address, LocalPort => $parent->{media_port}++) or die($address); + push(@sockets, [$rtp, $rtcp]); + push(@rtp, $rtp); + push(@rtcp, $rtcp); + $parent->{mux}->add($rtp); + $parent->{mux}->add($rtcp); + $parent->{mux}->set_timeout($rtp, 0.01); # XXX overkill, only need this on one + } + + $self->{sockets} = \@sockets; + $self->{rtp_sockets} = \@rtp; + $self->{rtcp_sockets} = \@rtcp; + + $self->{main_sockets} = $sockets[0]; # for m= and o= + $self->{local_sdp} = SDP->new($self->{main_sockets}->[0]); # no global c= + + $self->{local_media} = $self->{local_sdp}->add_media(SDP::Media->new( + $self->{main_sockets}->[0], $self->{main_sockets}->[1], 'RTP/AVP')); # main rtp and rtcp + + return $self; +} + +sub offer { + my ($self, $other) = @_; + + my $sdp_body = $self->{local_sdp}->encode(); + # XXX validate SDP + + my $req = { command => 'offer', ICE => 'remove', 'call-id' => $self->{parent}->{callid}, + 'from-tag' => $self->{tag}, sdp => $sdp_body }; + + my $out = $self->{parent}->{rtpe}->req($req); + + $other->offered($out); +} + +sub offered { + my ($self, $req) = @_; + + my $sdp_body = $req->{sdp} or die; + $self->{remote_sdp} = SDP->decode($sdp_body); + # XXX validate SDP + @{$self->{remote_sdp}->{medias}} == 1 or die; + $self->{remote_media} = $self->{remote_sdp}->{medias}->[0]; +} + +sub answer { + my ($self, $other) = @_; + + my $sdp_body = $self->{local_sdp}->encode(); + # XXX validate SDP + + my $req = { command => 'answer', ICE => 'remove', 'call-id' => $self->{parent}->{callid}, + 'from-tag' => $other->{tag}, 'to-tag' => $self->{tag}, sdp => $sdp_body }; + + my $out = $self->{parent}->{rtpe}->req($req); + + $other->answered($out); +} + +sub answered { + my ($self, $req) = @_; + + my $sdp_body = $req->{sdp} or die; + $self->{remote_sdp} = SDP->decode($sdp_body); + # XXX validate SDP + @{$self->{remote_sdp}->{medias}} == 1 or die; + $self->{remote_media} = $self->{remote_sdp}->{medias}->[0]; +} + 1; diff --git a/utils/test3.pl b/utils/test3.pl new file mode 100644 index 000000000..05130a939 --- /dev/null +++ b/utils/test3.pl @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Rtpengine; +use Time::HiRes qw(time); + +my ($r, $a, $b); + +my $offer = time(); +my $answer = $offer + 3; + +my $answer_done = 0; +my $cb = sub { + my ($now) = @_; + if ($now >= $answer && !$answer_done) { + $b->answer($a); + $answer_done = 1; + } +}; + +$r = Rtpengine::Test->new($cb); +$a = $r->client(); +$b = $r->client(); + +$a->offer($b); +$r->run();