Here is a Perl solution that not only indicates which port answered, but also decodes that backslash-delimited blob into a nicely formatted list.
This script takes full advantage of UDP by sending all of the queries before attempting to read a response.
#!/usr/bin/perl
# A simple tool to find a UDP server on a known host, adapted from an
# example in perlipc. The server speaks a strange protocol.
# This script is free software; you can redistribute it and/or modify
+it
# under the same terms as Perl itself.
use strict;
use warnings;
use Socket;
# Configuration
my $HOST_ADDR = '333networks.com';
my @PORTS = (27895 .. 27905);
my $TIMEOUT = 3.0; # seconds
# Translate network addresses
my $Host = inet_aton $HOST_ADDR;
my $UDP_Protocol = getprotobyname 'udp';
# Open socket
socket(SOCKET, PF_INET, SOCK_DGRAM, $UDP_Protocol) or die "socket: $!"
+;
# Go!
foreach my $port (@PORTS)
{ defined(send(SOCKET, qq[\\status\\], 0, sockaddr_in($port, $Host)))
or die "send: $!" }
# Any replies within timeout period?
my @Reports = (); # each element: [$sockaddr, $data]
my $Start_time = time;
my $rout; my $rin = ''; vec($rin, fileno(SOCKET), 1) = 1;
while ((time < ($Start_time + 2*$TIMEOUT))
&& (select($rout = $rin, undef, undef, $TIMEOUT))) {
my $remote_sockaddr; my $report;
($remote_sockaddr = recv(SOCKET, $report, 4096, 0)) or die "recv: $!
+";
push @Reports, [$remote_sockaddr, $report];
}
# Parse and pretty-print
unless (scalar @Reports) {
print "No responses received.\n";
exit 1
}
foreach my $report (@Reports) {
my ($remote_port, $remote_address) = sockaddr_in $report->[0];
my @rows = (); # cannot use hash due to duplicate keys
{
local $_ = $report->[1];
# \---- $1: key $2: value ----\
while (m/\\([^\\]+)\\([^\\]*)(?=\\|\z)/gs) { push @rows, [$1, $2]
+}
}
my $namewidth = 0;
foreach my $row (@rows)
{ $namewidth = length $row->[0] if length $row->[0] > $namewidth }
print "Response from port $remote_port:\n";
printf ' %*s: %s%s', $namewidth, @$_, "\n" for @rows;
}
exit 0
__END__
Sample output:
Response from port 27900:
gamename: 333networks
gamever: MS-perl 2.4.3
location: 0
queryid: 72.1
hostname: master.errorist.tk (The Errorist Network Master Server)
hostport: 28900
gametype: MasterServer
mapname: 333networks
numplayers: 14
maxplayers: 2965
gamemode: openplaying
queryid: 72.2
mutators: 333networks synchronization, UCC Master applet synchron
+ization, Server Status Checker
AdminName: Syntax-Error
AdminEMail: syntax@errorist.tk
queryid: 72.3
final:
Your homework assignment is to learn enough of Perl to explain how this script works. I have used some odd features and deliberately written parts of the script to illustrate some features of Perl that I would not have used if this were not intended as a teaching aid. Learning Perl enough to complete this assignment may take a while, so you are not expected to present it here for grading, only to yourself. And remember, if you cheat on this assignment, you are only cheating yourself. |