#!/usr/bin/perl use 5.10.0; use warnings; use strict; use Data::Dumper; use IO::Socket::Multicast; use IO::Interface::Simple; my $wait = 10; alarm($wait); $SIG{ALRM} = sub {exit 0}; my $if = IO::Interface::Simple->new('eth0'); my $s = IO::Socket::Multicast->new(Reuse => 1, LocalPort => 1900, PeerPort => 1900, Broadcast => 1) or die $!; $s->mcast_add('192.168.80.255', $if); $s->mcast_loopback(0); my $msg = "NOTIFY * HTTP/1.1\r HOST: 239.255.255.250:1900\r CACHE-CONTROL: max-age=20\r SERVER: AIR CONDITIONER\r \r SPEC_VER: MSpec-1.00\r SERVICE_NAME: ControlServer-MLib\r MESSAGE_TYPE: CONTROLLER_START\r "; $s->mcast_send($msg, $if->broadcast . ':1900');; my $data=''; my %seen = (); say "Waiting for responses"; while ($s->recv($data, 1024)) { my %response = map { my ($n, $v) = split /:\s*/, $_, 2; (lc $n => $v) } split /[\r\n]+/, $data; # Filter out background noise from the upnp server running on the same box next unless defined $response{message_type} && $response{message_type} eq 'DEVICEDESCRIPTION'; next if $seen{$response{mac_addr}} ++; # Make the nickname english not hex $response{decoded_nickname} = unpack('a*', pack('H*', $response{nickname})); print Dumper(\%response); }