diff -Nru libnet-sip-perl-0.835/Changes libnet-sip-perl-0.836/Changes --- libnet-sip-perl-0.835/Changes 2023-01-28 17:53:48.000000000 +0000 +++ libnet-sip-perl-0.836/Changes 2023-07-12 17:28:01.000000000 +0000 @@ -1,5 +1,9 @@ Revision history for Net::SIP +0.836 2023-07-12 +- #64: the RTP type mapping from the peer instead of the own mapping was used + when extracting DTMF. This lead to failed extraction if the rtpmap differed + betwen the peers 0.835 2023-01-28 - #60 from pali/max-forwards Make sure that ACK and CANCEL requests have max-forwards header diff -Nru libnet-sip-perl-0.835/debian/changelog libnet-sip-perl-0.836/debian/changelog --- libnet-sip-perl-0.835/debian/changelog 2023-02-04 18:50:02.000000000 +0000 +++ libnet-sip-perl-0.836/debian/changelog 2023-09-29 22:46:32.000000000 +0000 @@ -1,3 +1,10 @@ +libnet-sip-perl (0.836-1) unstable; urgency=medium + + * Import upstream version 0.836. + * Add created test file to debian/clean. (Closes: #1047774) + + -- gregor herrmann Sat, 30 Sep 2023 00:46:32 +0200 + libnet-sip-perl (0.835-1) unstable; urgency=medium * Import upstream version 0.835. diff -Nru libnet-sip-perl-0.835/debian/clean libnet-sip-perl-0.836/debian/clean --- libnet-sip-perl-0.835/debian/clean 1970-01-01 00:00:00.000000000 +0000 +++ libnet-sip-perl-0.836/debian/clean 2023-09-29 22:46:32.000000000 +0000 @@ -0,0 +1 @@ +t/database.drop diff -Nru libnet-sip-perl-0.835/lib/Net/SIP/DTMF.pm libnet-sip-perl-0.836/lib/Net/SIP/DTMF.pm --- libnet-sip-perl-0.835/lib/Net/SIP/DTMF.pm 2021-05-04 15:56:05.000000000 +0000 +++ libnet-sip-perl-0.836/lib/Net/SIP/DTMF.pm 2023-07-12 13:59:10.000000000 +0000 @@ -199,6 +199,8 @@ $end = 1; $volume &= 0b01111111 } + $DEBUG && DEBUG(100,"DTMF event [%s] end=%d vol=%d duration=%d", + $event, $end, $volume, $duration); if ( ! $current_event ) { return if $end; # probably repeated send of end # we don't look at the marker for initial packet, because maybe diff -Nru libnet-sip-perl-0.835/lib/Net/SIP/Leg.pm libnet-sip-perl-0.836/lib/Net/SIP/Leg.pm --- libnet-sip-perl-0.835/lib/Net/SIP/Leg.pm 2023-01-03 10:46:43.000000000 +0000 +++ libnet-sip-perl-0.836/lib/Net/SIP/Leg.pm 2023-01-28 18:20:08.000000000 +0000 @@ -165,10 +165,12 @@ $self->{src} = ip_sockaddr2parts($saddr); $self->{src}{host} = $host if $host; } - if ((!$dst or !$sockpeer) and my $saddr = getpeername($sock)) { - # set from connected socket - $sockpeer = ip_sockaddr2parts($saddr); - $dst ||= $sockpeer; + if (my $saddr = getpeername($sock)) { + if (!$dst) { + # set dst from connected socket + $dst = ip_sockaddr2parts($saddr); + } + $sockpeer = $dst; } } diff -Nru libnet-sip-perl-0.835/lib/Net/SIP/Simple/Call.pm libnet-sip-perl-0.836/lib/Net/SIP/Simple/Call.pm --- libnet-sip-perl-0.835/lib/Net/SIP/Simple/Call.pm 2021-09-02 09:32:02.000000000 +0000 +++ libnet-sip-perl-0.836/lib/Net/SIP/Simple/Call.pm 2023-07-12 17:10:44.000000000 +0000 @@ -614,7 +614,6 @@ } my $raddr = $param->{media_raddr} = []; - my @media_dtmfxtract; for( my $i=0;$i<@media;$i++) { my $m = $media[$i]; my $range = $m->{range} || 1; @@ -626,32 +625,9 @@ my @socks = map { ip_parts2sockaddr($m->{addr},$m->{port}+$_) } (0..$range-1); push @$raddr, @socks == 1 ? $socks[0] : \@socks; - - if ( $m->{media} eq 'audio' and $param->{cb_dtmf} ) { - my $fmt = $param->{rtp_param}->[0]; - $fmt = 0 if $fmt != 0 and $fmt != 8; # Only PCMU=0 and PCMA=8 are supported, default is PCMU - my $fmt_name = ($fmt == 8) ? 'PCMA' : 'PCMU'; - my %mt = (audio => "$fmt_name/8000", rfc2833 => "telephone-event/8000"); - my $mt = $param->{dtmf_methods} || 'audio,rfc2833'; - my (%rmap,%pargs); - for($mt =~m{([\w+\-]+)}g) { - my $type = $mt{$_} or die "invalid dtmf_method: $_"; - $rmap{$type} = $_.'_type'; - %pargs = (audio_type => $fmt) if $_ eq 'audio'; - } - for my $l (@{$m->{lines}}) { - $l->[0] eq 'a' or next; - my ($type,$name) = $l->[1] =~m{^rtpmap:(\d+)\s+(\S+)} or next; - my $pname = $rmap{$name} or next; - $pargs{$pname} = $type; - } - $media_dtmfxtract[$i] = dtmf_extractor(%pargs) if %pargs; - } } } - $param->{media_dtmfxtract} = @media_dtmfxtract ? \@media_dtmfxtract :undef; - return 1; } @@ -673,7 +649,9 @@ $sdp = Net::SIP::SDP->new( $sdp ); } + my $laddr = $param->{leg}->laddr(0); + my @media_dtmf; if ( !$sdp ) { # create SDP body my $raddr = $param->{media_rsocks}; @@ -681,6 +659,7 @@ # if no raddr yet just assume one my @media; my $rp = $param->{rtp_param}; + my $dtmf_rtptype = $param->{dtmf_rtptype} || 101; if ( my $sdp_peer = $param->{sdp_peer} ) { foreach my $m ( $sdp_peer->get_media ) { if ( $m->{proto} ne 'RTP/AVP' ) { @@ -696,29 +675,37 @@ "ptime:".$rp->[2]*1000 ) if $rp->[3]; push @a, ( - "rtpmap:101 telephone-event/8000", - "fmtp:101 0-16" + "rtpmap:$dtmf_rtptype telephone-event/8000", + "fmtp:$dtmf_rtptype 0-16" ); } push @media, { media => $m->{media}, proto => $m->{proto}, range => $m->{range}, - fmt => [ $m->{fmt},101 ], + fmt => [ $m->{fmt},$dtmf_rtptype ], a => \@a, }; + push @media_dtmf, dtmf_extractor( + audio_type => $m->{fmt}, + rfc2833_type => $dtmf_rtptype, + ); } } else { my @a; push @a,( "rtpmap:$rp->[0] $rp->[3]" , "ptime:".$rp->[2]*1000) if $rp->[3]; - my $te = $rp->[3] && $rp->[0] == 101 ? 102: 101; + my $te = $rp->[3] && $rp->[0] == $dtmf_rtptype ? $dtmf_rtptype+1: $dtmf_rtptype; push @a, ( "rtpmap:$te telephone-event/8000","fmtp:$te 0-16" ); push @media, { proto => 'RTP/AVP', media => 'audio', fmt => [ $rp->[0] || 0, $te ], a => \@a, - } + }; + push @media_dtmf, dtmf_extractor( + audio_type => $rp->[0] || 0, + rfc2833_type => $te, + ); } my $lsocks = $param->{media_lsocks} = []; @@ -733,8 +720,42 @@ { addr => $laddr }, @media ); + } else { + my $sdpo = UNIVERSAL::isa($sdp, 'Net::SIP::SDP') + ? $sdp : Net::SIP::SDP->new($sdp); + my $i = 0; + for my $m (@{$sdpo->{media}}) { + my $paddr = ip_canonical($m->{addr}); + goto skip if !$m->{port} or $paddr eq '0.0.0.0' or $paddr eq '::'; # on hold + goto skip if !$m->{media} eq 'audio'; # no DMTF transport + + my @fmt = + ! defined $m->{fmt} ? () : + ref $m->{fmt} ? @{$m->{fmt}} : + ($m->{fmt}); + my %pargs; + for my $l (@{$m->{lines}}) { + $l->[0] eq 'a' or next; + my ($type,$name) = $l->[1] =~m{^rtpmap:(\d+)\s+(\S+)} or next; + if ($name eq 'telephone-event/8000') { + $pargs{rfc2833_type} = $type; + } elsif ($name =~m{^pcm[ua]/8000$}i) { + $pargs{audio_type} = $type; + } else { + next; + } + @fmt = grep { $_ != $type } @fmt; + } + $pargs{audio_type} = $fmt[0] if @fmt && ! exists $pargs{audio_type}; + $media_dtmf[$i] = dtmf_extractor(%pargs) if %pargs; + + skip: + $i++; + } } + $param->{media_dtmfxtract} = @media_dtmf ? \@media_dtmf : undef; + unless ( $param->{media_lsocks} ) { # SDP body was provided, but sockets not croak( 'not supported: if you provide SDP body you need to provide sockets too' ); diff -Nru libnet-sip-perl-0.835/lib/Net/SIP/Simple/RTP.pm libnet-sip-perl-0.836/lib/Net/SIP/Simple/RTP.pm --- libnet-sip-perl-0.835/lib/Net/SIP/Simple/RTP.pm 2023-01-28 17:45:57.000000000 +0000 +++ libnet-sip-perl-0.836/lib/Net/SIP/Simple/RTP.pm 2023-07-02 13:56:12.000000000 +0000 @@ -282,8 +282,8 @@ my $padding = $vpxcc & 0x20 ? unpack( 'C', substr($buf,-1,1)) : 0; my $payload = $padding ? substr( $buf,0,length($buf)-$padding ): $buf; - DEBUG( 100,"ch=%d payload=%d/%d pt=%d xh=%d padding=%d cc=%d", - $channel, $seq, length($payload), $mpt & 0x7f, $xh, $padding, $cc); + DEBUG( 100,"ch=%d payload=%d/%d pt=%d/%d xh=%d padding=%d cc=%d", + $channel, $seq, length($payload), $mpt >> 7, $mpt & 0x7f, $xh, $padding, $cc); if ( $targs->{ssrc} && $targs->{ssrc} != $ssrc ) { # RTP stream has changed, reset rseq delete $targs->{rseq}; @@ -415,7 +415,8 @@ $timestamp, $ssrc, ); - DEBUG( 100,"send %d bytes to RTP", length($buf)); + DEBUG( 100,"ch=%d payload=%d/%d pt=%d/%d", + $channel, $seq, length($buf), $payload_type >> 7, $payload_type & 0x7f); send( $sock,$header.$buf,0,$addr ); } diff -Nru libnet-sip-perl-0.835/lib/Net/SIP.pm libnet-sip-perl-0.836/lib/Net/SIP.pm --- libnet-sip-perl-0.835/lib/Net/SIP.pm 2023-01-28 17:53:32.000000000 +0000 +++ libnet-sip-perl-0.836/lib/Net/SIP.pm 2023-07-12 17:27:43.000000000 +0000 @@ -3,7 +3,7 @@ use 5.010; package Net::SIP; -our $VERSION = '0.835'; +our $VERSION = '0.836'; # this includes nearly everything else use Net::SIP::Simple (); diff -Nru libnet-sip-perl-0.835/META.json libnet-sip-perl-0.836/META.json --- libnet-sip-perl-0.835/META.json 2023-01-28 17:59:27.000000000 +0000 +++ libnet-sip-perl-0.836/META.json 2023-07-12 17:39:27.000000000 +0000 @@ -49,6 +49,6 @@ "url" : "https://github.com/noxxi/p5-net-sip" } }, - "version" : "0.835", + "version" : "0.836", "x_serialization_backend" : "JSON::PP version 4.06" } diff -Nru libnet-sip-perl-0.835/META.yml libnet-sip-perl-0.836/META.yml --- libnet-sip-perl-0.835/META.yml 2023-01-28 17:59:27.000000000 +0000 +++ libnet-sip-perl-0.836/META.yml 2023-07-12 17:39:27.000000000 +0000 @@ -24,5 +24,5 @@ homepage: https://github.com/noxxi/p5-net-sip license: http://dev.perl.org/licenses/ repository: https://github.com/noxxi/p5-net-sip -version: '0.835' +version: '0.836' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -Nru libnet-sip-perl-0.835/t/19_call_with_dtmf.t libnet-sip-perl-0.836/t/19_call_with_dtmf.t --- libnet-sip-perl-0.835/t/19_call_with_dtmf.t 2023-01-28 17:46:27.000000000 +0000 +++ libnet-sip-perl-0.836/t/19_call_with_dtmf.t 2023-07-12 13:59:10.000000000 +0000 @@ -8,7 +8,7 @@ use strict; use warnings; -use Test::More tests => 9*6*2; +use Test::More tests => 9*6*2*2; do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; use Net::SIP ':all'; @@ -19,23 +19,33 @@ for my $transport (qw(udp tcp tls)) { for my $family (qw(ip4 ip6)) { for my $codec (qw(pcmu pcma)) { - push @tests, [ $transport, $family, $codec ]; + # same DTMF types for RFC2833 in uac and uas + push @tests, { + transport => $transport, + family => $family, + codec => $codec, + dtmf_type_uac => 101, + dtmf_type_uas => 101, + }; + # different DTMF types for RFC2833 in uac and uas + push @tests, { %{$tests[-1]}, + dtmf_type_uas => 102, + } } } } for my $t (@tests) { - my ($transport,$family,$codec) = @$t; SKIP: { - if (my $err = test_use_config($family,$transport)) { + if (my $err = test_use_config($t->{family},$t->{transport})) { skip $err,9; next; } - note("------- test with family $family transport $transport codec $codec"); + note("------- test with family $t->{family} transport $t->{transport} codec $t->{codec} dtmf_rtptype $t->{dtmf_type_uac}/$t->{dtmf_type_uas}"); # create leg for UAS on dynamic port - my ($sock_uas,$uas_addr) = create_socket($transport); + my ($sock_uas,$uas_addr) = create_socket($t->{transport}); diag( "UAS on $uas_addr" ); # fork UAS and make call from UAC to UAS @@ -47,7 +57,7 @@ $SIG{ __DIE__ } = undef; close($from_uas); $to_uac->autoflush; - uas( $sock_uas, $to_uac, $codec ); + uas( $sock_uas, $to_uac, %$t); exit(0); } @@ -59,7 +69,7 @@ local $SIG{__DIE__} = sub { kill 9,$pid; ok( 0,'died' ) }; local $SIG{ALRM} = sub { kill 9,$pid; ok( 0,'timed out' ) }; - uac(test_sip_uri($uas_addr), $from_uas, $codec); + uac(test_sip_uri($uas_addr), $from_uas, %$t); my $uas = <$from_uas>; killall(); @@ -80,7 +90,7 @@ ############################################### sub uac { - my ($peer_uri,$from_uas,$codec) = @_; + my ($peer_uri,$from_uas,%args) = @_; Debug->set_prefix( "DEBUG(uac):" ); # line noise when no DTMF is sent @@ -116,8 +126,9 @@ my $call = $uac->invite( test_sip_uri('you.uas@example.com'), init_media => $uac->rtp( 'send_recv', $send_something ), - rtp_param => rtp_param($codec), + rtp_param => rtp_param($args{codec}), cb_rtp_done => \$rtp_done, + dtmf_rtptype => $args{dtmf_type_uac}, cb_dtmf => sub { push @events,shift; } @@ -139,7 +150,13 @@ $uas = <$from_uas>; like($uas, qr/UAS RTP ok/, "UAS RTP ok"); # DTMF echoed back - is( "@events","1 2 D # 3 4 B *", "UAC DTMF received"); + if ($args{dtmf_type_uac} != $args{dtmf_type_uas}) { + # with non-matching DMTP RTP types a simple RTP echo will mean that + # UAC will not be able to detect the echoed back DTMF events + is( "@events","3 4 B *", "UAC DTMF received"); + } else { + is( "@events", "1 2 D # 3 4 B *", "UAC DTMF received"); + } $uac->cleanup; } @@ -148,7 +165,7 @@ ############################################### sub uas { - my ($sock,$to_uac,$codec) = @_; + my ($sock,$to_uac,%args) = @_; Debug->set_prefix( "DEBUG(uas):" ); my $uas = Net::SIP::Simple->new( domain => 'example.com', @@ -192,7 +209,8 @@ $call_closed =1; }, init_media => $uas->rtp( 'recv_echo', $save_rtp ), - rtp_param => rtp_param($codec), + rtp_param => rtp_param($args{codec}), + dtmf_rtptype => $args{dtmf_type_uas}, cb_dtmf => sub { push @events,shift }