r8871 - in /branches/upstream/libnet-sip-perl/current: Changes META.yml bin/answer_machine.pl lib/Net/SIP.pm lib/Net/SIP/Dispatcher.pm

[rmayorga-guest at users.alioth.debian.org]

Author: rmayorga-guest
Date: Mon Nov  5 18:07:59 2007
New Revision: 8871

URL: http://svn.debian.org/wsvn/?sc=1&rev=8871
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.38)

Modified:
    branches/upstream/libnet-sip-perl/current/Changes
    branches/upstream/libnet-sip-perl/current/META.yml
    branches/upstream/libnet-sip-perl/current/bin/answer_machine.pl
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm

Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/Changes?rev=8871&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Mon Nov  5 18:07:59 2007
@@ -1,4 +1,11 @@
 Revision history for Net::SIP
+
+0.38
+  - fix dns lookup problem for SRV records. Instead of using the
+    IP it used the service name (e.g. _sip._udp....) as the target
+    of the packet
+  - bin/answer_machine.pl - crude attempt to create filenames
+    which don't have chars special to windows ('<',...)
 
 0.37
   - Endpoint::close_context now cancel all outstanding deliveries 

Modified: branches/upstream/libnet-sip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/META.yml?rev=8871&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Mon Nov  5 18:07:59 2007
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Net-SIP
-version:      0.37
+version:      0.38
 version_from: lib/Net/SIP.pm
 installdirs:  site
 requires:

Modified: branches/upstream/libnet-sip-perl/current/bin/answer_machine.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/bin/answer_machine.pl?rev=8871&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/bin/answer_machine.pl (original)
+++ branches/upstream/libnet-sip-perl/current/bin/answer_machine.pl Mon Nov  5 18:07:59 2007
@@ -158,7 +158,7 @@
 
 	my $from = $call->get_peer;
 	my $filename = sprintf "%d_%s_.pcmu-8000", time(),$from;
-	$filename =~s{[/[:^print:]]}{_}g; # normalize
+	$filename =~s{[/<>:\.[:^print:]]}{_}g; # normalize
 	DEBUG( "call=$call param=$param peer=$from filename='$filename'" );
 	$filename = $savedir."/".$filename if $savedir;
 

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm?rev=8871&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Mon Nov  5 18:07:59 2007
@@ -4,7 +4,7 @@
 require 5.008;
 
 package Net::SIP;
-our $VERSION = '0.37';
+our $VERSION = '0.38';
 
 # this includes nearly everything else
 use Net::SIP::Simple ();

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm?rev=8871&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm Mon Nov  5 18:07:59 2007
@@ -775,16 +775,42 @@
 	my $dns = Net::DNS::Resolver->new;
 
 	# Try to get SRV records for _sip._udp.domain or _sip._tcp.domain
-	my @resp;
+	my (@resp,%addr2ip);
 	foreach my $proto ( @$protos ) {
 		if ( my $q = $dns->query( '_'.$sip_proto.'._'.$proto.'.'.$domain,'SRV' )) {
 			foreach my $rr ( $q->answer ) {
-				$rr->type eq 'SRV' || next;
-				# XXX fixme, get IPs for name
-				push @resp,[ $rr->priority, $proto,$rr->name,$rr->port ]
-			}
-		}
-	}
+				if ( $rr->type eq 'A' ) {
+					push @{ $addr2ip{$rr->name} }, $rr->address;
+				} elsif ( $rr->type eq 'SRV' ) {
+					push @resp,[ $rr->priority, $proto,$rr->target,$rr->port ]
+				}
+			}
+		}
+	}
+
+	# name to addr based on additional records in DNS answer
+	my @resp_resolved;
+	for my $r (@resp) {
+		if ( my $addr = $addr2ip{ $r->[2] } ) {
+			for (@$addr) {
+				my @cp = @$r;
+				$cp[2] = $_;
+				push @resp_resolved, \@cp;
+			}
+		} else {
+			# either already IP or no additional data for resolving -> later
+			my @cp = @$r;
+			# XXX fixme blocking DNS lookup
+			my $ipn = gethostbyname( $r->[2] ) or do {
+				DEBUG( 1,"cannot resolve $r->[2]" );
+				next;
+			};
+			$cp[2] = inet_ntoa($ipn);
+			push @resp_resolved, \@cp;
+		}
+	}
+	@resp = @resp_resolved;
+
 	# if no SRV records try to resolve address directly
 	unless (@resp) {
 		# try addr directly
@@ -792,7 +818,8 @@
 		if ( my $q = $dns->query( $domain,'A' )) {
 			foreach my $rr ($q->answer ) {
 				$rr->type eq 'A' || next;
-				# XXX fixme, get *all* IPs for name
+				# XXX fixme, check that name in response corresponds to query
+				# (beware of CNAMEs!)
 				push @resp,map {
 					[ -1, $_ , $rr->address,$default_port ]
 				} @$protos;