1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#!/usr/bin/perl
use strict;
use warnings;
use NGCP::Rtpengine::Test;
use IO::Socket;
my $iterations = 10;
my @interfaces = qw(int ext);
my @domains = (&Socket::AF_INET);
my $r = NGCP::Rtpengine::Test->new(media_port => 50000);
for my $a_domain (@domains) {
for my $b_domain (@domains) {
if (!@interfaces) {
for (1 .. $iterations) {
run_test([], $a_domain, $b_domain);
}
}
else {
for my $a_interface (@interfaces) {
for my $b_interface (@interfaces) {
for (1 .. $iterations) {
run_test([$a_interface, $b_interface], $a_domain, $b_domain);
}
}
}
}
}
}
sub run_test {
my ($directions, $a_domain, $b_domain) = @_;
print("Testing directions @{$directions} between $a_domain and $b_domain\n");
my ($a, $b) = $r->client_pair(
{sockdomain => $a_domain},
{sockdomain => $b_domain}
);
print("Offering with address: " . $a->{sockets}->[0]->[0]->sockhost . "\n");
my %dir_arg = ();
$dir_arg{direction} = $directions if @{$directions};
$a->offer($b, ICE => 'remove', label => "caller", %dir_arg);
print("Offer out with address: " . $b->{remote_media}->connection->{address} . "\n");
print("Answering with address: " . $b->{sockets}->[0]->[0]->sockhost . "\n");
$b->answer($a, ICE => 'remove', label => "callee");
print("Answer out with address: " . $a->{remote_media}->connection->{address} . "\n");
$a->teardown();
print("\n");
}
|
