#!/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__

##</code><code>##

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 synchronization, Server Status Checker
   AdminName:  Syntax-Error
  AdminEMail:  syntax@errorist.tk
     queryid:  72.3
       final: