http://www.perlmonks.org?node_id=11104303


in reply to Re^6: Querying program port
in thread Querying program port

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.