rtpengine/utils/rtpengine-ng-client

#!/usr/bin/perl

# sample usage:
# ./ng-client offer --trust-address --from-tag=sgadhdagf --call-id=sfghjfsh --sdp=$'v=0\no=moo 1 2 IN IP4 192.168.1.90\ns=-\nc=IN IP4 192.168.1.90\nt=0 0\nm=audio 3456 RTP/AVP 0\n'

use warnings;
use strict;
use Getopt::Long;
use Data::Dumper;
use NGCP::Rtpengine;

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

GetOptions(
	'proxy-address=s'		=> \$options{'proxy-address'},
	'proxy-port=s'			=> \$options{'proxy-port'},
	'from-tag=s'			=> \$options{'from-tag'},
	'to-tag=s'			=> \$options{'to-tag'},
	'call-id=s'			=> \$options{'call-id'},
	'via-branch=s'			=> \$options{'via-branch'},
	'protocol=s'			=> \$options{'transport protocol'},
	'trust-address'			=> \$options{'trust address'},
	'sip-source-address'		=> \$options{'sip source address'},
	'no-rtcp-attribute'		=> \$options{'no rtcp attribute'},
	'full-rtcp-attribute'		=> \$options{'full rtcp attribute'},
	'symmetric'			=> \$options{'symmetric'},
	'asymmetric'			=> \$options{'asymmetric'},
	'unidirectional'		=> \$options{'unidirectional'},
	'replace-origin'		=> \$options{'replace-origin'},
	'replace-session-connection'	=> \$options{'replace-session connection'},
	'replace-sdp-version'		=> \$options{'replace-sdp version'},
	'replace-username'		=> \$options{'replace-username'},
	'replace-session-name'		=> \$options{'replace-session-name'},
	'replace-zero-address'		=> \$options{'replace-zero-address'},
	'client-address=s'		=> \$options{'client-address'},
	'sdp=s'				=> \$options{'sdp'},
	'sdp-file=s'			=> \$options{'sdp-file'},
	'ICE=s'				=> \$options{'ICE'},
	'DTLS=s'			=> \$options{'DTLS'},
	'SDES=s@'			=> \$options{'SDES'},
	'rtcp-mux=s@'			=> \$options{'rtcp-mux'},
	'address-family=s'		=> \$options{'address family'},
	'direction=s'			=> \$options{'direction'},
	'force'				=> \$options{'force'},
	'v|verbose'			=> \$options{'verbose'},
	'strict-source'			=> \$options{'strict source'},
	'media-handover'		=> \$options{'media handover'},
	'TOS=i'				=> \$options{'TOS'},
	'delete-delay=i'		=> \$options{'delete-delay'},
	'reset'				=> \$options{'reset'},
	'port-latching'			=> \$options{'port latching'},
	'loop-protect'			=> \$options{'loop protect'},
	'record-call'			=> \$options{'record call'},
	'media-address=s'		=> \$options{'media address'},
	'codec-strip=s@'		=> \$options{'codec-strip'},
	'codec-offer=s@'		=> \$options{'codec-offer'},
	'codec-transcode=s@'		=> \$options{'codec-transcode'},
	'codec-mask=s@'			=> \$options{'codec-mask'},
	'codec-consume=s@'		=> \$options{'codec-consume'},
	'codec-accept=s@'		=> \$options{'codec-accept'},
	'codec-set=s@'			=> \$options{'codec-set'},
	'ptime=i'			=> \$options{'ptime'},
	'flags=s@'			=> \$options{'flags'},
	'codec-options-flat'		=> \$options{'codec options flag'},
	'flags=s@'			=> \$options{'flags'},
	'supports=s@'			=> \$options{'supports'},
	'xmlrpc-callback=s'		=> \$options{'xmlrpc-callback'},
	'always-transcode'		=> \$options{'always transcode'},
	'metadata=s'			=> \$options{'metadata'},
	'all'				=> \$options{'all'},
	'address=s'			=> \$options{'address'},
	'pad-crypto'			=> \$options{'pad crypto'},
	'generate-mid'			=> \$options{'generate mid'},
	'fragment'			=> \$options{'fragment'},
	'original-sendrecv'		=> \$options{'original sendrecv'},
	'file=s'			=> \$options{'file'},
	'blob=s'			=> \$options{'blob'},
	'blob-file=s'			=> \$options{'blob-file'},
	'db-id=i'			=> \$options{'db-id'},
	'T38=s@'			=> \$options{'T.38'},
	'code=s'			=> \$options{'code'},
	'OSRTP=s@'			=> \$options{'OSRTP'},
	'symmetric-codecs'		=> \$options{'symmetric codecs'},
	'asymmetric-codecs'		=> \$options{'asymmetric codecs'},
	'inject-DTMF'			=> \$options{'inject DTMF'},
	'DTLS-fingerprint=s'		=> \$options{'DTLS-fingerprint'},
	'ICE-lite=s'			=> \$options{'ICE-lite'},
	'no-jitter-buffer'  		=> \$options{'no jitter buffer'},
	'generate-RTCP'			=> \$options{'generate RTCP'},
	'single-codec'			=> \$options{'single codec'},
	'reorder-codecs'		=> \$options{'reorder codecs'},
	'media-echo=s'			=> \$options{'media echo'},
) or die;

my $cmd = shift(@ARGV) or die;

my %packet = (command => $cmd);

for my $x (split(/,/, 'from-tag,to-tag,call-id,transport protocol,media address,ICE,address family,DTLS,via-branch,media address,ptime,xmlrpc-callback,metadata,address,file,db-id,code,DTLS-fingerprint,ICE-lite,media echo')) {
	defined($options{$x}) and $packet{$x} = \$options{$x};
}
for my $x (split(/,/, 'TOS,delete-delay')) {
	defined($options{$x}) and $packet{$x} = $options{$x};
}
for my $x (split(/,/, 'trust address,symmetric,asymmetric,unidirectional,force,strict source,media handover,sip source address,reset,port latching,no rtcp attribute,full rtcp attribute,loop protect,record call,always transcode,all,pad crypto,generate mid,fragment,original sendrecv,symmetric codecs,asymmetric codecs,inject DTMF,generate RTCP,single codec,reorder codecs')) {
	defined($options{$x}) and push(@{$packet{flags}}, $x);
}
for my $x (split(/,/, 'origin,session connection,sdp version,username,session-name,zero-address')) {
	defined($options{'replace-' . $x}) and push(@{$packet{replace}}, $x);
}
for my $x (split(/,/, 'rtcp-mux,SDES,supports,T.38,OSRTP')) {
	$packet{$x} = $options{$x}
		if defined($options{$x}) && ref($options{$x}) eq 'ARRAY';
}
if (defined($options{direction})) {
	$options{direction} =~ /(.*),(.*)/ or die;
	$packet{direction} = [$1,$2];
}
for my $x (qw(strip offer transcode mask set consume accept)) {
	if ($options{'codec-'.$x} && @{$options{'codec-'.$x}}) {
		if (!$options{'codec options flag'}) {
			$packet{codec}{$x} = $options{'codec-'.$x};
		}
		else {
			push(@{$packet{flags}}, map {'codec-'.$x.'-'.$_} @{$options{'codec-'.$x}});
		}
	}
}
if ($options{'flags'} && @{$options{'flags'}}) {
	push(@{$packet{flags}}, @{$options{'flags'}});
}

sub slurp_file {
	local $/ = undef;
	open(my $fh, '<', $_[0]) or die $!;
	my $ret = <$fh>;
	die $! unless defined $ret;
	close($fh);
	return $ret;
}

if (defined($options{sdp})) {
	$packet{sdp} = $options{sdp};
}
elsif (defined($options{'sdp-file'})) {
	$packet{sdp} = slurp_file($options{'sdp-file'});
}
#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;
#}

if (defined($options{blob})) {
	$packet{blob} = $options{blob};
}
elsif (defined($options{'blob-file'})) {
	$packet{blob} = slurp_file($options{'blob-file'});
}

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

if (defined($packet{sdp})) {
	print("Old SDP:\n-----8<-----8<-----8<-----8<-----8<-----\n$packet{sdp}\n".
		"----->8----->8----->8----->8----->8-----\n");
}

my $engine = NGCP::Rtpengine->new($options{'proxy-address'}, $options{'proxy-port'});
my $resp = $engine->req(\%packet);

#print Dumper $resp;
#exit;

if (defined($$resp{sdp})) {
	print("New SDP:\n-----8<-----8<-----8<-----8<-----8<-----\n$$resp{sdp}\n".
		"----->8----->8----->8----->8----->8-----\n");
}
else {
	local $Data::Dumper::Indent = 1;
	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Quotekeys = 0;
	print("Result dictionary:\n-----8<-----8<-----8<-----8<-----8<-----\n"
		. Dumper($resp)
		. "----->8----->8----->8----->8----->8-----\n");
}