#!/usr/bin/perl
#perl script to query the status of a neverwinter server
BEGIN {
$ENV{'POSIXLY_CORRECT'} = 1;
}
use warnings;
use strict;
use IO::Socket;
use Getopt::Long;
use Text::Wrap;
#variable defaults#
my $timeout = 10;
my $host = '127.0.0.1';
my $port = 5121;
my $lvlout = '1';
#placeholders for command line options#
my %opts;
error(), exit unless GetOptions(\%opts,"port=i","hostip=s","help","lvlout=i","timeout=i");
sub error {
print "Try 'status.pl --help' for more information.\n";
}
sub usage {
print "Usage: status.pl [OPTIONS]\n";
print "Query a Neverwinter Nights game server, and return useful information.\n\n";
print "Arguments are mandatory for each option.\n";
print wrap("--port=PORT\t","\t\t","Specify the integer port number as PORT. Default is 5121.");
print "\n\n";
print wrap("--hostip=HOSTIP\t","\t\t","Specify the dotted decimal ip address of the server to be queried as HOSTIP. Default is 127.0.0.1 (which is localhost).");
print "\n\n";
print wrap("--timeout=TIME\t","\t\t","Specify the integer amount of time to try contacting the server until giving up as TIME. Default is 20 ms.");
print "\n\n";
print wrap("--lvlout=LVL\t","\t\t","Specify the integer output verbosity level. Levels are as follows: Level 1 simply reports whether the server is up or not. Level 2 reports the number of players currently playing on the server. Level 3 outputs everything. Default is Level 1.");
print "\n\n";
}
if (exists $opts{'help'}) {
usage();
exit;
}
#test to see what options are set#
if (exists $opts{'port'}){ $port=$opts{'port'}; }
if (exists $opts{'hostip'}){ $host=$opts{'hostip'}; }
if (exists $opts{'timeout'}){ $timeout=$opts{'timeout'}; }
if (exists $opts{'lvlout'}){
$lvlout=$opts{'lvlout'};
if ($lvlout > 3) {
$lvlout=3;
}
if ($lvlout < 1) {
$lvlout=1;
}
}
my $message;
sub alarmhandler {
die "Server is not responding";
}
$SIG{ALRM} = \&alarmhandler;
sub parse_name_data(@) {
my $packet_data=$_[0];
my $server_name=substr($packet_data, 9, 1500);
return $server_name;
}
sub parse_stat_data(@) {
my $packet_data=$_[0];
my @split_temp = split "\x00", $packet_data;
my @player_count=split "|", substr($packet_data, 10, 2);
my @player_levels=split "|", substr($packet_data, 8, 2);
my $module_name=substr($packet_data, 20, length($packet_data)-20);
$player_count[0]=unpack("C*", $player_count[0]);
$player_count[1]=unpack("C*", $player_count[1]);
$player_levels[0]=unpack("C*", $player_levels[0]);
$player_levels[1]=unpack("C*", $player_levels[1]);
my @stat_data=($player_levels[0],$player_levels[1],$player_count[0],$player_count[1],$module_name);
return @stat_data;
}
sub parse_desc_data(@) {
my $packet_data=$_[0];
my $module_desc=substr($packet_data, 14, length($packet_data)-24);
return $module_desc;
}
my $result = eval {
alarm $timeout;
my $client = new IO::Socket::INET(Proto => 'udp', Timeout => "5");
die "Unable to create socket: $!\n" unless $client;
my $serveraddr = sockaddr_in($port, inet_aton($host));
##returns the name of the server
$client->send("\x42\x4E\x45\x53\x00\x14", 0, $serveraddr);
$client->recv($message, 1500, 0);
my $SName=parse_name_data($message);
##returns name of module and other info
$client->send("\x42\x4E\x58\x49\x00\x14", 0, $serveraddr);
$client->recv($message, 1500, 0);
my @SStats=parse_stat_data($message);
##returns full server description
$client->send("\x42\x4E\x44\x53\x00\x14", 0, $serveraddr);
$client->recv($message, 1500, 0);
my $SDesc=parse_desc_data($message);
alarm 0;
if ($lvlout==1) {
print "Server is up\n";
return 1;
}
if ($lvlout==2) {
print "$SStats[2]\n$SStats[2]\n";
return 1;
}
if ($lvlout==3) {
#print "Server name: $SName\n";
#print "
";
#print "Module name: $SStats[4] \n";
##dont know this yet#print "Version Number: $foo[14] \n";
print "Players: $SStats[2] / $SStats[3] \n";
print "
";
#print "Levels: $SStats[0] to $SStats[1] \n";
##dont know this yet#print "Player VS Player type: $foo[9]\n";
#print "Description: $SDesc\n";
return 1;
}
};
if ($lvlout==2) {
print "0\n0\n" unless $result;
}
else {
print "Server seems to be down\n" unless $result;
}