#!/usr/bin/perl 
use Socket;

$IP             = "239.255.255.250";
$PORT           = 1900;
$TIMEOUT        = 3;

$request_header = <<"__REQUEST_HEADER__";
M-SEARCH * HTTP/1.1
Host:$IP:$PORT
Man:"ssdp:discover"
ST:upnp:rootdevice
MX:3

__REQUEST_HEADER__
$request_header =~ s/\r//g;
$request_header =~ s/\n/\r\n/g;

$proto = getprotobyname('udp');
socket(S, AF_INET, SOCK_DGRAM, $proto) || die "socket(S): $!\n";
setsockopt(S, SOL_SOCKET, SO_BROADCAST, 1) || die "setsockopt(S): $!\n";
$that = sockaddr_in($PORT, inet_aton($IP));

print $request_header;
send(S, $request_header, 0, $that) || die "send(S): $!\n";

$rin = '';
vec($rin, fileno(S), 1) = 1;
while( select($rout = $rin, undef, undef, $TIMEOUT) ) {
	recv(S, $response_header, 4096, 0) || die "recv(S): $!\n";
	print "$response_header";
}

close(S);
exit 0;