From ec1946fde8869dfcd64e78315c3aa53d474abb57 Mon Sep 17 00:00:00 2001 From: Richard Fuchs Date: Thu, 13 Jun 2013 15:09:04 -0400 Subject: [PATCH] adding srtp support to simulator script --- tests/simulator-ng.pl | 265 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 246 insertions(+), 19 deletions(-) diff --git a/tests/simulator-ng.pl b/tests/simulator-ng.pl index 9b1a5ac0c..6333bc665 100755 --- a/tests/simulator-ng.pl +++ b/tests/simulator-ng.pl @@ -9,6 +9,9 @@ use Getopt::Long; use Socket6; use Bencode qw( bencode bdecode ); use Time::HiRes; +use Crypt::Rijndael; +use Digest::SHA qw(hmac_sha1); +use MIME::Base64; my ($NUM, $RUNTIME, $STREAMS) = (1000, 30, 1); my ($NODEL, $IP, $IPV6, $KEEPGOING, $REINVITES, $BRANCHES); @@ -29,6 +32,14 @@ GetOptions( $SIG{ALRM} = sub { print "alarm!\n"; }; setrlimit(RLIMIT_NOFILE, 8000, 8000); +# global for now +#my $srtp_master_key = pack("H*", 'E1F97A0D3E018BE0D64FA32C06DE4139'); +#my $srtp_master_salt = pack("H*", '0EC675AD498AFEEBB6960B3AABE6'); +#my ($srtp_session_key, $srtp_session_auth_key, $srtp_session_salt) +# = gen_rtp_session_keys($srtp_master_key, $srtp_master_salt); +#my ($srtcp_session_key, $srtcp_session_auth_key, $srtcp_session_salt) +# = gen_rtcp_session_keys($srtp_master_key, $srtp_master_salt); + my @chrs = ('a' .. 'z', 'A' .. 'Z', '0' .. '9'); sub rand_str { my ($len) = @_; @@ -76,21 +87,160 @@ sub send_receive { return $x; } -sub send_expect { - my ($send_fd, $receive_fd, $payload, $expect, $destination) = @_; +sub aes_cm { + my ($data, $key, $iv) = @_; + + my $c = Crypt::Rijndael->new($key) or die; + length($iv) == 16 or die; + my @iv = unpack("C16", $iv); + my $out = ''; + + while ($data ne '') { + $iv = pack("C16", @iv); + my $key_segment = $c->encrypt($iv); + length($key_segment) == 16 or die; + my @ks = unpack("C16", $key_segment); + my @ds = unpack("C16", $data); + + for my $i (0 .. $#ds) { + my $ss = $ds[$i]; + my $kk = $ks[$i]; + $out .= chr($ss ^ $kk); + } + + substr($data, 0, 16, ''); + $data eq '' and last; - my $x = send_receive($send_fd, $receive_fd, $payload, $destination); - if (($x || '') ne $expect) { - return 0; + for my $i (reverse(0 .. 15)) { + $iv[$i]++; + if ($iv[$i] == 256) { + $iv[$i] = 0; + } + else { + last; + } + } } - return 1; + + return $out; +} + +sub prf_n { + my ($n, $key, $x) = @_; + my $d = "\0" x ($n / 8); + my $ks = aes_cm($d, $key, $x . "\0\0"); + return substr($ks, 0, $n / 8); +} + +sub xor_n { + my ($n, @l) = @_; + $n /= 8; + my @o = (0) x $n; + for my $e (@l) { + my @e = unpack("C$n", $e); + if (@e < $n) { + unshift(@e, ((0) x ($n - @e))); + } + for my $i (0 .. $#o) { + $o[$i] ^= $e[$i]; + } + } + return pack("C$n", @o); +} + +sub xor_112 { + return xor_n(112, @_); +} +sub xor_128 { + return xor_n(128, @_); +} + +sub gen_rtp_session_keys { + my ($master_key, $master_salt) = @_; + + my $session_key = prf_n(128, $master_key, xor_112($master_salt, "\0\0\0\0\0\0\0")); + my $auth_key = prf_n(160, $master_key, xor_112($master_salt, "\1\0\0\0\0\0\0")); + my $session_salt = prf_n(112, $master_key, xor_112($master_salt, "\2\0\0\0\0\0\0")); + + return ($session_key, $auth_key, $session_salt); +} + +sub gen_rtcp_session_keys { + my ($master_key, $master_salt) = @_; + + my $session_key = prf_n(128, $master_key, xor_112($master_salt, "\3\0\0\0\0")); + my $auth_key = prf_n(160, $master_key, xor_112($master_salt, "\4\0\0\0\0")); + my $session_salt = prf_n(112, $master_key, xor_112($master_salt, "\5\0\0\0\0")); + + return ($session_key, $auth_key, $session_salt); +} + +sub rtcp_encrypt { + my ($r, $ctx, $dir) = @_; + + if (!$$ctx{rtcp_session_key}) { + ($$ctx{$dir}{rtcp_session_key}, $$ctx{$dir}{rtcp_session_auth_key}, $$ctx{$dir}{rtcp_session_salt}) + = gen_rtp_session_keys($$ctx{$dir}{rtp_master_key}, $$ctx{$dir}{rtp_master_salt}); + } + + my $idx = $$ctx{$dir}{rtcp_index} || 0; + my ($hdr, $ssrc, $to_enc) = unpack('a4a4a*', $r); + my $iv = xor_128($$ctx{$dir}{rtcp_session_salt} . "\0\0", + $ssrc . "\0\0\0\0\0\0\0\0", pack("Nn", $idx, 0)); + my $enc = aes_cm($to_enc, $$ctx{$dir}{rtcp_session_key}, $iv); + my $pkt = $hdr . $ssrc . $enc; + $pkt .= pack("N", ($idx | 0x80000000)); + + my $hmac = hmac_sha1($pkt, $$ctx{$dir}{rtcp_session_auth_key}); + + #$pkt .= pack("N", 1); # mki + $pkt .= substr($hmac, 0, 10); + + $$ctx{$dir}{rtcp_index} = ++$idx; + + return $pkt; +} + +sub rtp_encrypt { + my ($r, $ctx, $dir) = @_; + + if (!$$ctx{$dir}{rtp_session_key}) { + ($$ctx{$dir}{rtp_session_key}, $$ctx{$dir}{rtp_session_auth_key}, $$ctx{$dir}{rtp_session_salt}) + = gen_rtp_session_keys($$ctx{$dir}{rtp_master_key}, $$ctx{$dir}{rtp_master_salt}); + } + + my $roc = $$ctx{$dir}{rtp_roc} || 0; + my ($hdr, $seq, $ts, $ssrc, $to_enc) = unpack('a2na4a4a*', $r); + $seq == 0 and $roc++; + my $iv = xor_128($$ctx{$dir}{rtp_session_salt} . "\0\0", + $ssrc . "\0\0\0\0\0\0\0\0", pack("Nnn", $roc, $seq, 0)); + my $enc = aes_cm($to_enc, $$ctx{$dir}{rtp_session_key}, $iv); + my $pkt = pack("a*na*a*a*", $hdr, $seq, $ts, $ssrc, $enc); + + my $hmac = hmac_sha1($pkt . pack("N", $roc), $$ctx{$dir}{rtp_session_auth_key}); + + #$pkt .= pack("N", 1); # mki + $pkt .= substr($hmac, 0, 10); + + $$ctx{$dir}{rtp_roc} = $roc; + + return $pkt; +} + +sub savp_sdp { + my ($ctx) = @_; + if (!$$ctx{out}{rtp_master_key}) { + $$ctx{out}{rtp_master_key} = rand_str(16); + $$ctx{out}{rtp_master_salt} = rand_str(14); + } + return "a=crypto:1 AES_CM_128_HMAC_SHA1_80 inline:" . encode_base64($$ctx{out}{rtp_master_key} . $$ctx{out}{rtp_master_salt}, '') . "\n"; } sub rtcp_sr { my @now = Time::HiRes::gettimeofday(); my $secs = $now[0] + 2208988800; my $frac = $now[1] / 1000000 * 2**32; - my $sr = pack('CCnN NNN NN', (2 << 6) | 1, 200, 12, rand() * 2**32, $secs, $frac, + my $sr = pack('CCnN NNN NN', (2 << 6) | 1, 200, 12, rand(2**32), $secs, $frac, 12345, 0, 0); $sr .= pack('N CCCC NNNN', 0, 0, 0, 0, 0, 0, 0, 0, 0); return $sr; @@ -101,13 +251,24 @@ sub rtcp_rtpfb { } sub rtcp_avp { - my ($recv, $send) = @_; + my ($recv, $ctx, $ctx_o) = @_; + my $sr = rtcp_sr(); + my $exp = $sr; + $$recv{name} eq 'RTP/SAVP' and $exp = rtcp_encrypt($sr, $ctx_o, 'in'); + return ($sr, $exp); +} + +sub rtcp_savp { + my ($recv, $ctx, $ctx_o) = @_; my $sr = rtcp_sr(); - return ($sr, $sr); + my $enc = rtcp_encrypt($sr, $ctx, 'out'); + my $exp = $enc; + $$recv{name} eq 'RTP/AVP' and $exp = $sr; + return ($enc, $exp); } sub rtcp_avpf { - my ($recv, $send) = @_; + my ($recv, $ctx, $ctx_o) = @_; my $sr = rtcp_sr(); my $fb = rtcp_rtpfb(); my $exp = $sr; @@ -115,28 +276,78 @@ sub rtcp_avpf { return ($sr . $fb, $exp); } +sub rtp { + my ($ctx) = @_; + my $seq = $$ctx{rtp_seqnum} || (int(rand(0xfffff)) + 1); + my $hdr = pack("CCnNN", 0x80, 0x00, $seq, rand(2**32), rand(2**32)); + my $pack = $hdr . rand_str(100); + $$ctx{rtp_seqnum} = (++$seq & 0xffff); + return $pack; +} + +sub rtp_avp { + my ($recv, $ctx, $ctx_o) = @_; + my $pack = rtp($ctx); + my $exp = $pack; + $$recv{name} eq 'RTP/SAVP' and $exp = rtp_encrypt($pack, $ctx_o, 'in'); + return ($pack, $exp); +} + +sub rtp_savp { + my ($recv, $ctx, $ctx_o) = @_; + my $pack = rtp($ctx); + my $enc = rtp_encrypt($pack, $ctx, 'out'); + my $exp = $enc; + $$recv{name} eq 'RTP/AVP' and $exp = $pack; + return ($enc, $exp); +} + +sub savp_crypto { + my ($sdp, $ctx) = @_; + + my @a = $sdp =~ /[\r\n]a=crypto:1 AES_CM_128_HMAC_SHA1_80 inline:([\w\/+]{40})(?:\|(?:2\^(\d+)|(\d+)))?(?:\|(\d+):(\d+))?[\r\n]/si; + @a or die; + my $ks = decode_base64($a[0]); + length($ks) == 30 or die; + ($$ctx{in}{rtp_master_key}, $$ctx{in}{rtp_master_salt}) = unpack('a16a14', $ks); + $$ctx{in}{rtp_mki} = $a[3]; + $$ctx{in}{rtp_mki_len} = $a[4]; +} + +sub hexdump { + my $o = ''; + for my $a (@_) { + $o .= "<< " . unpack("H*", $a) . " >> "; + } + return $o; +} + sub do_rtp { print("sending rtp\n"); for my $c (@calls) { $c or next; - my ($fds,$outputs,$protos,$cfds,$trans) = @$c{qw(fds outputs protos rtcp_fds transports)}; + my ($fds,$outputs,$protos,$cfds,$trans,$tctxs) + = @$c{qw(fds outputs protos rtcp_fds transports trans_contexts)}; for my $j (0 .. $#{$$fds[0]}) { for my $i ([0,1],[1,0]) { my ($a, $b) = @$i; my $pr = $$protos[$a]; + my $tcx = $$tctxs[$a]; + my $tcx_o = $$tctxs[$b]; my $addr = inet_pton($$pr{family}, $$outputs[$b][$j][1]); - my $payload = rand_str(100); + my ($payload, $expect) = $$trans[$a]{rtp_func}($$trans[$b], $tcx, $tcx_o); my $dst = $$pr{sockaddr}($$outputs[$b][$j][0], $addr); - if (!send_expect($$fds[$a][$j], $$fds[$b][$j], $payload, $payload, $dst)) { + my $repl = send_receive($$fds[$a][$j], $$fds[$b][$j], $payload, $dst); + if ($repl eq '') { warn("no rtp reply received, ports $$outputs[$b][$j][0] and $$outputs[$a][$j][0]"); $KEEPGOING or undef($c); } + $repl eq $expect or die hexdump($repl, $expect); - my $expect; - ($payload, $expect) = $$trans[$a]{rtcp_func}($$trans[$b], $$trans[$a]); + ($payload, $expect) = $$trans[$a]{rtcp_func}($$trans[$b], $tcx, $tcx_o); $dst = $$pr{sockaddr}($$outputs[$b][$j][0] + 1, $addr); - my $repl = send_receive($$cfds[$a][$j], $$cfds[$b][$j], $payload, $dst); - $repl eq $expect or die; + $repl = send_receive($$cfds[$a][$j], $$cfds[$b][$j], $payload, $dst); + $repl eq $expect or die hexdump($repl, $expect); } } } @@ -170,11 +381,20 @@ my @sides = qw(A B); my @transports = ( { name => 'RTP/AVP', + rtp_func => \&rtp_avp, rtcp_func => \&rtcp_avp, }, +# { +# name => 'RTP/AVPF', +# rtp_func => &rtp_avpf, +# rtcp_func => \&rtcp_avpf, +# }, { - name => 'RTP/AVPF', - rtcp_func => \&rtcp_avpf, + name => 'RTP/SAVP', + sdp_media_params => \&savp_sdp, + sdp_parse_func => \&savp_crypto, + rtp_func => \&rtp_savp, + rtcp_func => \&rtcp_savp, }, ); @@ -200,6 +420,7 @@ sub update_lookup { my $protos = $$c{protos} || ($$c{protos} = []); my $trans = $$c{transports} || ($$c{transports} = []); + my $tctxs = $$c{trans_contexts} || ($$c{trans_contexts} = []); my $fds_a = $$c{fds} || ($$c{fds} = []); my $cfds_a = $$c{rtcp_fds} || ($$c{rtcp_fds} = []); for my $x (0,1) { @@ -214,6 +435,8 @@ sub update_lookup { } my ($pr, $pr_o) = @$protos[$i, $j]; my ($tr, $tr_o) = @$trans[$i, $j]; + my $tcx = $$tctxs[$i] || ($$tctxs[$i] = {}); + my $tcx_o = $$tctxs[$j] || ($$tctxs[$j] = {}); my @commands = qw(offer answer); my $ports_a = $$c{ports} || ($$c{ports} = []); @@ -264,7 +487,9 @@ m=audio $p $$tr{name} 8 a=rtpmap:8 PCMA/8000 a=rtcp:$cp ! + $$tr{sdp_media_params} and $sdp .= $$tr{sdp_media_params}($tcx); } + print("transport is $$tr{name} -> $$tr_o{name}\n"); # XXX my $dict = {sdp => $sdp, command => $commands[$i], 'call-id' => $callid, 'from-tag' => $$tags[0], @@ -278,6 +503,7 @@ a=rtcp:$cp $i == 1 and $dict->{'to-tag'} = $$tags[1]; my $o = msg($dict); + $$o{result} eq 'ok' or die; my ($rp_af, $rp_add) = $$o{sdp} =~ /c=IN IP([46]) (\S+)/s or die; my @rp_ports = $$o{sdp} =~ /m=audio (\d+) \Q$$tr_o{name}\E /gs or die; @@ -288,6 +514,7 @@ a=rtcp:$cp $rpl == 0 and die "mediaproxy ran out of ports"; push(@$rpl_t, [$rpl,$rp_add]); } + $$tr_o{sdp_parse_func} and $$tr_o{sdp_parse_func}($$o{sdp}, $tcx_o); } for my $iter (1 .. $NUM) {