Merge pull request #2840 from connortechnology/onvif_multicast_route

Onvif multicast route

onvif/modules/lib/WSDiscovery/TransportUDP.pm

@@ -43,7 +43,7 @@ my %message_of :ATTR(:name<message>     :default<()>);
 my %is_success_of :ATTR(:name<is_success> :default<()>);
 
 my %local_addr_of :ATTR(:name<local_addr> :init_arg<local_addr> :default<()>);
-
+my $net_interface;
 
 # create methods normally inherited from SOAP::Client
 SUBFACTORY: {
@@ -60,14 +60,22 @@ sub _notify_response
   
 }
 
+sub set_net_interface {
+	my $self = shift;
+	$net_interface = shift;
+}
+
 sub send_multi() {
   my ($self, $address, $port, $utf8_string) = @_;
 
   my $destination = $address . ':' . $port;
-  my $socket = IO::Socket::Multicast->new(PROTO => 'udp', 
+  my $socket = IO::Socket::Multicast->new(
-      LocalPort=>$port, PeerAddr=>$destination, ReuseAddr=>1)
+			PROTO => 'udp',
-      
+      LocalPort=>$port,
-      or die 'Cannot open multicast socket to ' . ${address} . ':' . ${port};
+			PeerAddr=>$destination,
+			ReuseAddr=>1
+			) or die 'Cannot open multicast socket to ' . ${address} . ':' . ${port};
+	$_ = $socket->mcast_if($net_interface) if $net_interface;
 
   my $bytes = $utf8_string;
   utf8::encode($bytes);
@@ -80,9 +88,11 @@ sub receive_multi() {
   my ($self, $address, $port) = @_;
   my $data = undef;
   
-  my $socket = IO::Socket::Multicast->new(PROTO => 'udp', 
+  my $socket = IO::Socket::Multicast->new(
-      LocalPort=>$port, ReuseAddr=>1);
+			PROTO => 'udp',
-	$socket->mcast_add($address);
+      LocalPort=>$port,
+			ReuseAddr=>1);
+	$socket->mcast_add($address, $net_interface);
   
   my $readbits = '';
   vec($readbits, $socket->fileno, 1) = 1;
@@ -98,10 +108,14 @@ sub receive_uni() {
   my ($self, $address, $port, $localaddr) = @_;
   my $data = undef;
   
-  my $socket = IO::Socket::Multicast->new(PROTO => 'udp', 
+  my $socket = IO::Socket::Multicast->new(
-      LocalAddr => $localaddr, LocalPort=>$port, ReuseAddr=>1);
+			PROTO => 'udp',
+			LocalAddr => $localaddr,
+			LocalPort=>$port,
+			ReuseAddr=>1
+			);
       
-	$socket->mcast_add($address);
+	$socket->mcast_add($address, $net_interface);
   
   my $readbits = '';
   vec($readbits, $socket->fileno, 1) = 1;
@@ -126,6 +140,7 @@ sub send_receive {
 	$self->send_multi($address, $port, $envelope);
 
 	my $localaddr = $self->get_local_addr();
+#warn "localddr $localaddr";
 
 	my ($response, $last_response);
 	my $wait = WAIT_COUNT;
@@ -146,13 +161,12 @@ sub send_receive {
 
 	if ( $last_response ) {
 		$self->set_code();
-      $self->set_message("");
+		$self->set_message('');
 		$self->set_is_success(1);
 		$self->set_status('OK');
-    }
+	} else {
-    else{
 		$self->set_code();
-      $self->set_message("Timed out waiting for response");
+		$self->set_message('Timed out waiting for response');
 		$self->set_is_success(0);
 		$self->set_status('TIMEOUT');
 	}
@@ -161,3 +175,4 @@ sub send_receive {
 }
 
 1;
+__END__

scripts/ZoneMinder/lib/ZoneMinder/ONVIF.pm.in

@@ -172,7 +172,7 @@ sub interpret_messages {
 # functions
 
 sub discover {
-  my ( $soap_version ) = @_;
+  my ( $soap_version, $net_interface ) = @_;
   my @results;
 
 ## collect all responses
@@ -193,12 +193,17 @@ sub discover {
 		my %services;
 
     if ( $verbose ) {
-      print "Probing for SOAP 1.1\n"
+      print "Probing for SOAP 1.1\n";
     }
     my $svc_discover = WSDiscovery10::Interfaces::WSDiscovery::WSDiscoveryPort->new({
 #    no_dispatch => '1',
         });
     $svc_discover->set_soap_version('1.1');
+		if ( $net_interface ) {
+			my $transport = $svc_discover->get_transport();
+			print "Setting net interface for $transport to $net_interface\n";
+			$transport->set_net_interface($net_interface);
+		}
 
     my $uuid = $uuid_gen->create_str();
 
@@ -222,12 +227,17 @@ sub discover {
   if ( ( ! $soap_version ) or ( $soap_version eq '1.2' ) ) {
 		my %services;
     if ( $verbose ) {
-      print "Probing for SOAP 1.2\n"
+      print "Probing for SOAP 1.2\n";
     }
     my $svc_discover = WSDiscovery10::Interfaces::WSDiscovery::WSDiscoveryPort->new({
 #    no_dispatch => '1',
         });
     $svc_discover->set_soap_version('1.2');
+		if ( $net_interface ) {
+			my $transport = $svc_discover->get_transport();
+			print "Setting net interface for $transport to $net_interface\n";
+			$transport->set_net_interface($net_interface);
+		}
 
 # copies of the same Probe message must have the same MessageID. 
 # This is not a copy. So we generate a new uuid.
@@ -250,7 +260,7 @@ sub discover {
     push @results, interpret_messages($svc_discover, \%services, @responses);
   } # end if doing soap 1.2
   return @results;
-}
+} # end sub discover
 
 sub profiles {
   my ( $client ) = @_;

scripts/zmcamtool.pl.in

@@ -352,9 +352,13 @@ sub exportsql {
   }
 
   my $name = $ARGV[0];
-  if ($name && $name =~ /^([A-Za-z0-9 ,.&()\/\-]+)$/) { # Allow alphanumeric and " ,.&()/-"
+  if ( $name ) {
+		if ( $name =~ /^([A-Za-z0-9 ,.&()\/\-]+)$/ ) { # Allow alphanumeric and " ,.&()/-"
 			$name = $1;
 			$command .= qq( --where="Name = '$name'");
+		} else {
+			print "Invalid characters in Name\n";
+		}
   }
 
   $command .= " zm Controls MonitorPresets";

scripts/zmonvif-probe.pl.in

@@ -41,7 +41,7 @@ my $OPTIONS = 'v';
 
 sub HELP_MESSAGE {
   my ($fh, $pkg, $ver, $opts) = @_;
-  print $fh "Usage: " . __FILE__ . " [-v] probe <soap version>\n";
+  print $fh "Usage: " . __FILE__ . " [-v] probe <soap version> <network interface>\n";
   print $fh "       " . __FILE__ . " [-v] <command> <device URI> <soap version> <user> <password>\n";
   print $fh  <<EOF
   Commands are:
@@ -84,7 +84,8 @@ if ( defined $opt_v ) {
 
 if ( $action eq 'probe' ) {
   my $soap_version = shift;
-  ZoneMinder::ONVIF::discover($soap_version);
+	my $net_interface = shift;
+  ZoneMinder::ONVIF::discover($soap_version, $net_interface);
 } else {
 # all other actions need URI and credentials
   my $url_svc_device = shift @ARGV;