Send multicast message, receive unicast reply

athanasia has asked for the wisdom of the Perl Monks concerning the following question:

Fellow monks,

This is a rather long post, so please bear with me... I have successfully used the Module Net::UPnP (version 1.2.1) , found in http://search.cpan.org/~skonno/Net-UPnP-1.2.1/ in Windows XP.
What I wanted to do was multicast an SSDP M-Search message and receive replies from all UPnP-compatible devices connected to my PC. Therefore, I used the Net::UPnP::ControlPoint->search() function found in the relative docs:

#!/usr/local/bin/perl
use Net::UPnP::ControlPoint;
my $obj = Net::UPnP::ControlPoint->new();
my @dev_list = $obj->search();
my $nodevs = @dev_list;
print "Found $nodevs\n";
[download]

Everything was fine in Windows XP. However when I tried the same thing in Windows Vista (Home Premium), the above code failed. Opening Wireshark, I realised that the M-Search message that was to be multicast never left my pc. I suspected that Vista has a more strict control over how the multicast join is done (do correct me if I am wrong). Browsing the active bug list of Net::UPnP, I found this post
http://rt.cpan.org/Public/Bug/Display.html?id=39979
that provides a patch for Net::UPnP::ControPoint module as follows:

package Net::UPnP::ControlPoint;

#-----------------------------------------------------------------
# Net::UPnP::ControlPoint
#-----------------------------------------------------------------

use strict;
use warnings;

use IO::Select;
use IO::Socket::INET;

use Net::UPnP;
use Net::UPnP::HTTP;
use Net::UPnP::Device;

#------------------------------
# new
#------------------------------

sub new {
    my($class) = shift;
    my($this) = {};
    bless $this, $class;
}

#------------------------------
# search
#------------------------------

sub search {
    my($this) = shift;
    my %args = (
        st => 'upnp:rootdevice',    
        mx =>3,
        @_,
    );
    my(
        @dev_list,
        $ssdp_header,
        $ssdp_mcast,
        $rin,
        $rout,
        $ssdp_res_msg,
        $dev_location,
        $dev_addr,
        $dev_port,
        $dev_path,
        $dev_friendly_name,
        $http_req,
        $post_res,
        $post_content,
        $key,
        $dev,
        );
my $mcast_addr = $Net::UPnP::SSDP_ADDR . ':' . $Net::UPnP::SSDP_PORT;
        
$ssdp_header = <<"SSDP_SEARCH_MSG";
M-SEARCH * HTTP/1.1
Host: $mcast_addr
Man: "ssdp:discover"
ST: $args{st}
MX: $args{mx}

SSDP_SEARCH_MSG

    $ssdp_header =~ s/\r//g;
    $ssdp_header =~ s/\n/\r\n/g;

    my $sock = IO::Socket::INET->new(
        LocalPort => $Net::UPnP::SSDP_PORT,
        Proto     => 'udp',
    ) or die "Cannot create socket to send multicast $@\n";
    
    # add the socket to the correct IGMP multicast group
    _mcast_add( $sock, $mcast_addr );
    
    # send the search query
    _mcast_send( $sock, $ssdp_header, $mcast_addr );
 
    my $sel = IO::Select->new($sock);

    @dev_list = ();
    
    while ( $sel->can_read( $args{mx} ) ) {
        recv ($sock, $ssdp_res_msg, 4096, 0);
        print "$ssdp_res_msg";
        unless ($ssdp_res_msg =~ m/LOCATION[ :]+(.*)\r/i) {
            next;
        }        
        $dev_location = $1;
        unless ($dev_location =~ m/http:\/\/([0-9a-z.]+)[:]*([0-9]*)\/
+(.*)/i) {
            next;
        }
        $dev_addr = $1;
        $dev_port = $2;
        $dev_path = '/' . $3;
    
        $http_req = Net::UPnP::HTTP->new();
        $post_res = $http_req->post($dev_addr, $dev_port, "GET", $dev_
+path, "", "");

        if ($Net::UPnP::DEBUG) {
            print $post_res->getstatus() . "\n";
            print $post_res->getheader() . "\n";
            print $post_res->getcontent() . "\n";
        }

         $post_content = $post_res->getcontent();

        $dev = Net::UPnP::Device->new();
         $dev->setssdp($ssdp_res_msg);
        $dev->setdescription($post_content);
    
        if ($Net::UPnP::DEBUG) {
             print "friendlyName = $dev_friendly_name\n";
             print "ssdp = $ssdp_res_msg\n";
             print "description = $post_content\n";
         }

        push(@dev_list, $dev);
    }

    close $sock;
    
    @dev_list;
}

sub _mcast_add {
    my ( $sock, $host ) = @_;
    my ( $addr, $port ) = split /:/, $host;
    my $ip_mreq = inet_aton( $addr ) . INADDR_ANY;
    
    setsockopt(
        $sock,
        getprotobyname('ip') || 0,
        _constant('IP_ADD_MEMBERSHIP'),
        $ip_mreq
    ) || warn "Unable to add IGMP membership: $!\n";
}

sub _mcast_send {
    my ( $sock, $msg, $host ) = @_;
    my ( $addr, $port ) = split /:/, $host;
    
    # Set a TTL of 4 as per UPnP spec
    setsockopt(
        $sock,
        getprotobyname('ip') || 0,
        _constant('IP_MULTICAST_TTL'),
        pack 'I', 4,
    ) || do {
        warn "Error setting multicast TTL to 4: $!\n";
        return;
    };
    
    
    my $dest_addr = sockaddr_in( $port, inet_aton( $addr ) );
    my $bytes = send( $sock, $msg, 0, $dest_addr );
    print "Sent $bytes bytes\n";
}

sub _constant {
    my $name = shift;
    my %names = (
        IP_MULTICAST_TTL  => 0,
        IP_ADD_MEMBERSHIP => 1,
        IP_MULTICAST_LOOP => 0,
    );
    
    my %constants = (
        MSWin32 => [10,12],
        cygwin  => [3,5],
        darwin  => [10,12],
        default => [33,35],
    );
    
    my $index = $names{$name};
    my $ref = $constants{ $^O } || $constants{default};
    return $ref->[ $index ];
}
1;
[download]

This patch partly fixed my problem, meaning that now, in Wireshark, I can observe the right sequence of packets, i.e. an SSDP M-SEARCH from my pc to the multicast address 239.255.255.250 and the unicast HTTP 200 OK reply from the UPnP-device to my pc. However, the above code fails to catch the unicast reply and I can only see my own broadcast in the print statement below :

while ( $sel->can_read( $args{mx} ) ) {
        recv ($sock, $ssdp_res_msg, 4096, 0);
        print "$ssdp_res_msg";
                ...
}
[download]

I think the problem is that the socket created can only handle multicast messages. If this is so, how can I recv unicast replies, especially taking into account the fact that I need to use the same port (1900) for both send and recv? (tried ReusePort option but with no success..)

I am relatively new to socket programming, so any help would be greatly appreciated.

Cheers,
Athanasia

Comment on Send multicast message, receive unicast reply Select or Download Code