#!/usr/bin/perl -w

# FILE:         q3ctrl
# AUTHOR:	Barry Ferg <bferg@users.sourceforge.net>
# DESCRIPTION:	Implements q3test server communication protocol as outlined by
#               Graeme Devine in 
#                 http://www.quake3arena.com/tech/ServerCommandsHowto.html
#               Handy for sending commands to your dedicated server, or just 
#               want to check its status.  
#               Also checks Q3 master servers.
# COPYRIGHT:    1999 Barry Ferg
# USAGE:        Released under GNU Generic Public License (http://www.gnu.org/)
# VERSION:      1.0
# SOURCE:       http://q3ctrl.sourceforge.net/
# SYNTAX:	Call q3ctrl with --status, --info, or --cmd for sending
#               rcon commands.  You can also send a list of rcon commands from
#               a text file or from stdin.  Run with no arguments for a brief
#               usage summary.
#
# NOTES:	I'm new to Perl, so the code here may be a little naive in
#               parts.  Let me know if there are areas where I can make
#               improvements.  Yes, I know there aren't any comments, but 
#               the code is self-documenting, right? :-)
#
use diagnostics;
use strict;
use Socket;
use Getopt::Long;
use Sys::Hostname;


sub q3msg 
{
    my ($host, $port, $timeout, $msg) = @_;

    my $iaddr = gethostbyname(hostname());
    my $sin = sockaddr_in(0, $iaddr);
    socket(SOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp')) or die "socket: $!\n";
    bind(SOCK, $sin) or die "bind: $!\n";

    my $hisaddr = inet_aton($host) or die "unknown host \"$host\"\n";
    my $srvaddr = sockaddr_in($port, $hisaddr);
    defined(send(SOCK, chr(255) x 4 . $msg, 0, $srvaddr)) or die "send: $!\n";

    my ($rin, $rout);
    $rin = "";
    vec($rin, fileno(SOCK), 1) = 1;
    if (select($rout=$rin, undef, undef, $timeout))
    {
	recv(SOCK, $_, 65507, 0) or die "recv: $!\n";
	s/\033.//g;
	my @response = split /^/m;
	shift @response;
	return \@response;
    }
    else
    {
	return undef;
    }
}


sub q3status
{
    my $response = q3msg(@_, "getstatus") or return undef;
    chop $response->[0];
    return { (split /\\/, substr $response->[0], 1) };
}


sub q3info
{
    my $response = q3msg(@_, "getinfo") or return undef;
    return { (split /\\/, substr $response->[0], 1) };
}


sub q3fmt_info
{
    my $info = shift;
    print              $info->{addr}          . "\t"
	. "\""       . $info->{hostname}      . "\"\t"
	. "map:"     . $info->{mapname}       . "\t"
	. "clients:" . $info->{clients}       . "/" 
                     . $info->{sv_maxclients} . "\n";
}


sub q3scan
{
    my ($port, $msg, $timeout) = @_;

    my $iaddr = gethostbyname(hostname());
    my $sin = sockaddr_in(0, $iaddr);
    socket(SOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp')) or die "socket: $!\n";
    setsockopt(SOCK, SOL_SOCKET, SO_BROADCAST, 1) or die "setsockopt: $!\n";
    bind(SOCK, $sin) or die "bind: $!\n";

    my $srvaddr = sockaddr_in($port, INADDR_BROADCAST);
    defined(send(SOCK, chr(255) x 4 . $msg, 0, $srvaddr)) or die "send: $!\n";

    my ($rin, $rout, $rxdata);
    $rin = "";
    vec($rin, fileno(SOCK), 1) = 1;
    
    my @scan_list;

    my $end_time = time + $timeout;
    while (time < $end_time)
    {
	if (select($rout=$rin, undef, undef, $timeout))
	{
	    $srvaddr = recv(SOCK, $rxdata, 65507, 0) or die "recv: $!\n";
	    $rxdata =~ s/\e.//g;  # strip control characters from names
	    my ($portno, $ipaddr) = sockaddr_in($srvaddr);
	    my @response = split /^/m, $rxdata;
	    shift @response;

	    my %info = (split /\\/, substr $_[0], 1);
	    $info{addr} = (gethostbyaddr($ipaddr, AF_INET) or inet_ntoa($ipaddr)) . ":$portno";

	    push @scan_list, { %info };
	}
	$timeout = $end_time - time;
    }

    foreach my $info (@scan_list)
    {
	q3fmt_info($info);
    }

    return ();
}


sub q3rcon_msg
{
    my ($host, $port, $command, $password, $timeout) = @_;

    if ($command eq "quit")
    {
	# there is no reponse to a quit command
	$timeout = 0;
    }
    my $response = q3msg($host, $port, $timeout, "rcon $password $command") 
	or die "timeout contacting $host:$port\n";
    foreach (@$response)
    {
	defined $_ && print;
    }
}


sub q3fmt_master_response
{
    my $resp = shift;
    my @master_response;
    
    while (length $resp)
    {
	my %info;

	$info{addr} = join('.', unpack('C4n', $resp));
	$info{addr} =~ s/\.(\d*)$/:$1/;
	substr($resp, 0, 7) = "";  # remove address

	$_ = $resp;
	/(.*?):/ or return;
	$info{mapname} = $1;
	s/.*?://;  # remove map

	($info{clients}, $info{sv_maxclients}) = unpack "C2", $_; # not too sure about this one
	substr($_, 0, 3) = "";  # remove clients

	/(.*?)\\/;
	$info{hostname} = $1;
	$info{hostname} =~ s/\e.//g;
	s/.*?\\//m;  # remove name

	$resp = $_;

	push @master_response, { %info };

    }

    return \@master_response;
}

sub q3query_master
{
    my ($host, $port, $msg, $timeout) = @_;

    my $iaddr = gethostbyname(hostname());
    my $sin = sockaddr_in(0, $iaddr);
    socket(SOCK, PF_INET, SOCK_DGRAM, getprotobyname('udp')) or die "socket: $!\n";
    bind(SOCK, $sin) or die "bind: $!\n";

    my $hisaddr = inet_aton($host) or die "unknown host \"$host\"\n";
    my $srvaddr = sockaddr_in($port, $hisaddr);
    defined(send(SOCK, chr(255) x 4 . $msg, 0, $srvaddr)) or die "send: $!\n";

    my ($rin, $rout);
    $rin = "";
    vec($rin, fileno(SOCK), 1) = 1;
    
    my @master_response;
    my $end_time = time + $timeout;
    while (time < $end_time)
    {
	if (select($rout=$rin, undef, undef, $timeout))
	{
	    recv(SOCK, $_, 65507, 0) or die "recv: $!\n";
	    last if /^EOT/;
	    s/.*\\//;
	    push @master_response, @{q3fmt_master_response($_)};
	}
	$timeout = $end_time - time;
    }
    if (not $#master_response)
    {
	return undef;
    }
    return \@master_response;
}


my $host;
my $password = "";
my $command;
my $port;
my $timeout;
my $status;
my $info;
my $scan;
my $querymaster;
my $cmdfile;
my $cmdstdin;

&GetOptions("host=s" => \$host,
	    "password=s" => \$password,
	    "cmd=s" => \$command,
	    "port=i" => \$port,
	    "status" => \$status,
	    "info" => \$info,
	    "scan" => \$scan,
	    "query" => \$querymaster,
	    "timeout=f" => \$timeout,
	    "cmdfile=s" => \$cmdfile,
	    "-" => \$cmdstdin);

if ((!defined $host) && (!defined ($host = shift)))
{
    $host = "localhost";
    if (defined $querymaster)
    {
	$host = "master3.idsoftware.com";
    }
}
else
{
    $_ = $host;
    if (/^(.*):(.*)$/)
    {
	$host = $1;
	$port = $2;
    }
}

if (!defined $timeout)
{
    $timeout = 10;
    if (defined $scan)
    {
	$timeout = 1;
    }
}

if (!defined $port)
{
    $port = 27960;
    if (defined $scan)
    {
	$port = -1;
    }
    elsif (defined $querymaster)
    {
	$port = 27950;
    }
}
	
if (defined $status)
{
    my $status_vars = q3status($host, $port, $timeout) 
	or die "timeout contacting $host:$port\n";

    foreach my $key (sort keys %$status_vars)
    {
	print "$key => $status_vars->{$key}\n";
    }
}
elsif (defined $info)
{
    my $info_vars = q3info($host, $port, $timeout)
	or die "timeout contacting $host:$port\n";
    $info_vars->{addr} = "$host:$port";
    print q3fmt_info($info_vars);
}

elsif (defined $scan)
{
    if ($port == -1)
    {
	q3scan(27960, "getinfo", $timeout);
	q3scan(27961, "getinfo", $timeout);
	q3scan(27962, "getinfo", $timeout);
	q3scan(27963, "getinfo", $timeout);
    }
    else
    {
	q3scan($port, "getinfo", $timeout);
    }
}
elsif (defined $querymaster)
{
    my $response = q3query_master($host, $port, "getservers 40", $timeout) 
	or die "timeout contacting $host:$port\n";

    foreach my $info (@$response)
    {
	print q3fmt_info($info);
    }
}
elsif (defined $command)
{
    q3rcon_msg($host, $port, $command, $password, $timeout);
}
elsif (defined $cmdfile or defined $cmdstdin)
{
    my $filehandle;

    if (defined $cmdfile)
    {
	open(CMDFILE, $cmdfile) or die "can't open $cmdfile\n";
	$filehandle = \*CMDFILE;
    }
    else
    {
	$filehandle = \*STDIN;
    }
    while (<$filehandle>)
    {
	q3rcon_msg($host, $port, $_, $password, $timeout) if not /^\#/;
    }
}
else
{
    print "q3ctrl: perl utility to talk to q3test servers\n"
	. "Usage:  q3ctrl --status|--info|--scan|--cmd <command>|--cmdfile <filename>\n"
	. "               [--host <hostname>] [--port <portnum>]\n"
	. "               [--timeout <time in secs>]\n"
        . "               [--password <password>]\n"
      	. "        --status : send \"getstatus\"\n"
	. "        --info   : send \"getinfo\"\n"
        . "        --scan   : scan LAN for q3test servers\n"
        . "        --query  : query master (default master3.idsoftware.com) for server list\n"
	. "        --cmd    : send an rcon command - use with --password\n"
	. "        --cmdfile: send all commands in the text command file\n"
        . "        -        : use stdin for input\n"
        . "Host defaults to localhost, port defaults to 27960, timeout to 10s.\n"
        . "The host parameter may be of the form \"host:port\", which takes\n"
        . "precedence over the port parameter.\n";
}






