mirror of https://github.com/sipwise/rtpengine.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
111 lines
2.4 KiB
111 lines
2.4 KiB
package NGCP::Rtpclient::SDES;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use NGCP::Rtpclient::SRTP;
|
|
use MIME::Base64;
|
|
|
|
sub new {
|
|
my ($class, %args) = @_;
|
|
|
|
my $self = {};
|
|
bless $self, $class;
|
|
|
|
# our list of crypto suites
|
|
|
|
if (!$args{suites} || !@{$args{suites}}) {
|
|
$self->{suites} = [@NGCP::Rtpclient::SRTP::crypto_suites];
|
|
}
|
|
else {
|
|
$self->{suites} = [];
|
|
for my $s (@{$args{suites}}) {
|
|
my $o = $NGCP::Rtpclient::SRTP::crypto_suites{$s};
|
|
$o or die;
|
|
push(@{$self->{suites}}, $o);
|
|
}
|
|
}
|
|
|
|
# duplicate content and generate random keys
|
|
|
|
my $id = 1;
|
|
for my $s (@{$self->{suites}}) {
|
|
$s = {%$s};
|
|
$s->{id} = $id++;
|
|
$s->{master_key} = join('', map {chr(rand(256))} (1 .. $s->{key_length}));
|
|
$s->{master_salt} = join('', map {chr(rand(256))} (1 .. $s->{salt_length}));
|
|
}
|
|
|
|
return $self
|
|
}
|
|
|
|
sub encode {
|
|
my ($self) = @_;
|
|
my @ret;
|
|
for my $s (@{$self->{suites}}) {
|
|
push(@ret, "a=crypto:$s->{id} $s->{str} inline:" .
|
|
encode_base64($s->{master_key} . $s->{master_salt}, ''));
|
|
}
|
|
return @ret;
|
|
}
|
|
|
|
sub decode {
|
|
my ($self, $sdp_media) = @_;
|
|
$self->{remote_suites} = [];
|
|
my $suites = $sdp_media->get_attrs('crypto');
|
|
for my $line (@{$suites}) {
|
|
my ($id, $s, $b64) = $line =~ /^(\S+) (\S+) inline:(\S+)$/ or next;
|
|
$s = $NGCP::Rtpclient::SRTP::crypto_suites{$s};
|
|
$s or next; # crypto suite not supported by perl mod
|
|
$s = {%$s};
|
|
$s->{id} = $id;
|
|
($s->{master_key}, $s->{master_salt}) = NGCP::Rtpclient::SRTP::decode_inline_base64($b64, $s);
|
|
push(@{$self->{remote_suites}}, $s);
|
|
}
|
|
return;
|
|
}
|
|
|
|
# construct ->suites to match suites from ->remote_suites after an offer
|
|
sub offered {
|
|
my ($self) = @_;
|
|
my @out;
|
|
for my $r (@{$self->{remote_suites}}) {
|
|
for my $s (@{$self->{suites}}) {
|
|
if ($r->{str} eq $s->{str}) {
|
|
my $dup = {%$s};
|
|
$dup->{remote} = $r;
|
|
$dup->{id} = $r->{id};
|
|
push(@out, $dup);
|
|
}
|
|
}
|
|
}
|
|
@{$self->{suites}} = @out;
|
|
$self->{suite} = $out[0];
|
|
return;
|
|
}
|
|
|
|
# prunes ->suites to contain only matching suites from ->remote_suites after an answer
|
|
sub answered {
|
|
my ($self) = @_;
|
|
my @out;
|
|
for my $s (@{$self->{suites}}) {
|
|
for my $r (@{$self->{remote_suites}}) {
|
|
if ($r->{id} eq $s->{id} && $r->{str} eq $s->{str}) {
|
|
$s->{remote} = $r;
|
|
push(@out, $s);
|
|
}
|
|
}
|
|
}
|
|
@{$self->{suites}} = @out;
|
|
$self->{suite} = $out[0];
|
|
return;
|
|
}
|
|
|
|
# after an offer, trims the list of suites to just the one shared/supported one
|
|
sub trim {
|
|
my ($self) = @_;
|
|
splice(@{$self->{suites}}, 1);
|
|
splice(@{$self->{remote_suites}}, 1);
|
|
}
|
|
|
|
1;
|