#!/usr/bin/perl
# you might have to adjust this to your perl path
# try `which perl' or `type perl'

# args: [-2] [-a] [-b] [-q] [-t] [-1] [-d] [-h]
#	-h: a help

# metas are migrating at the moment....!

# shows running xpilotservers
# original metaserver info is stored in $tmp_file .
# by default meta.xpilot.org is asked.

# yet todo: switch between meta/meta2 automatically
# weird, those timeouts

# if entries show up twice, this is a problem of those hosts,
# by default they are skipped

# never reached a host with numerical ip entry
# (they usually won't have a good connection - skip them)

# hosts in .edu .jp etc..  are not  listed by default (see @too_far_away).
# many domains are 'usually' too far for me (net, org..) ..
# some special hosts are never listed (see @bad_hosts)

# Sun Jun  7 18:09:47 MET DST 1998
# Thu Feb  4 15:08:42 MET 1999
# sven mascheck (sven.mascheck@student.uni-ulm.de)

require 5.002;
use strict;
use Socket;
use FileHandle;
use Getopt::Std;

  #store the arriving stuff in a file
my $name = getpwuid($<);
 #adjust here!:
my $tmp_file = "/tmp/meta";
 
my $program = $0;
$program =~ s#.*/##;

my @too_far_away = qw( jp com org net ca nz mil edu cz ru us gov foo kr au);
#my @bad_hosts = qw( absaroka.obgyn.ks.se polaris.tele.nokia.fi
#	padre.dev.milohedge.com 2cust83.tnt14.dfw5.da.uu.net
#	css262.cc.els.att.com obelix.premium.com.au taogii.bit.co.kr
#	ugrad.unbc.ca t0.tecco.at hp00.haulpak.com laplace.numeca.be
#	dsr8.konkuk.ac.kr tte2142.tte.vtt.fi c414b1.cs.hku.hk
#	polux.univ-reunion.fr DarkStar.astro.unibas.ch sapc42.estec.esa.nl
#	bogey.neurologie.uni-tuebingen.de user.bavaria-film.de
#	);
my @bad_hosts = qw( burana.teuto.de );

my $default_sleep = 120;
my $first_meta = 'lgserv1.cs.uit.no';
my $second_meta = 'meta2.xpilot.org';
my $meta_port  = 4401;



my %opts;		#comandline arguments

my %info_lines;		#complete hostinfo lines
my %counter;		#for domain.port. see below
my @splitted_line;	#the fields of one hostinfo line
my @full_names;		#player names on a server
my @splitted_name;	#nick, real, host of one player
my @splitted_host;	#host A.B.C.D

# flags:
my $bad = 0;		#skip that host, bad one
my $several = 0;	#skip that host, several entries on meta
my $far = 0;		#skip that host, too far
my $just_double = 0;		#skip that host, just a double


my ($host, $iaddr, $paddr, $proto);	#for asking meta server

  #get program name from absloute path name
my $program = $0;
$program =~ s#.*/##;

if ( ! getopts('a23qbd1fht:', \%opts) || $opts{"h"} ){
    die <<"    EOF";

    usage: ${program} [-2] [-3] [-a] [-b] [-q] [-t] [-d] [-h]
    no args	show visited xpilot servers, assumed to be near
    -2		ask meta2.xpilot.org instead of meta.xpilot.org
    -3		ask u2.isy.liu.se    instead of meta.xpilot.org
    -a		show far servers also
    -b		show only known bad servers (overrides a)
    -q		show only unvisited servers
    -t <time>	time to wait for ask meta again
    -1         ask nly once
    -d		additional debug output
    -f		feed with file $tmp_file,
                instead of meta info
    -h		this help

    EOF
}

printf "called with: "; foreach (keys(%opts)){printf"%s,", $_};

my ($meta2, $once, $showall, $showbad, $showquiet, $feed_file, $debug, $sleep);	#options

$meta2 = $opts{"2"};
$once  = $opts{"1"};
$showall = $opts{"a"};
$showbad = $opts{"b"};
$showquiet = $opts{"q"};
$debug = $opts{"d"};
$feed_file = $opts{"f"};
$sleep = $opts{"t"};
$sleep = ($sleep) ? $sleep : $default_sleep;


if ( $meta2 ){
    $host = $second_meta;
} else {
    $host = $first_meta;
}

print "\n";
printf ".....see $program -h...............\n", $host;
printf ".....asking %s....\n", $host if not $feed_file;

if ($debug and not $feed_file ){
    printf ".....initializing for conn: ...\n", $host
}

if (not $feed_file ){
    $iaddr = inet_aton($host) || die"error: unknown host: $host \n";
    $paddr = sockaddr_in($meta_port, $iaddr);
    $proto = getprotobyname('tcp') or die"error: no proto";

    if ($debug){printf ".............initialized.......\n", $host }
}


if ( $showall && !$showbad ){
	printf ".....show all servers..........\n";
}
if ( $showbad ){
	printf ".....show bad servers..........\n";
}
if ( $showquiet ){
	printf ".....show quiet servers........\n";
}



while (1) {

    if (not $feed_file ){
	if ($debug){ printf ".....connecting: ..............\n", $host }
	socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "error: socket: $!";
	if ($debug){ printf ".............socket. ..........\n", $host }

	connect(SOCK, $paddr) || die "error: connect: $!";
	if ($debug){ printf ".............connected. .......\n", $host }

	SOCK->autoflush(1);
	if ($debug){ printf ".............flushed. .........\n", $host }


	if ($debug){ printf ".....fetching information: ....\n", $host }

	open(FILE, ">$tmp_file") || warn "error: open $tmp_file .";
	printf "open $tmp_file\n" if $debug;
	while( <SOCK> ){

	    # 'backup'
	    print(FILE $_);

	    # fill hash, means: *count* the entries
	    $info_lines{$_}++;

	    # have seen two entries (same server and port), one crowded,
	    # one left like the just doubled entry they are non enterable (sic)
	    @splitted_line = split(/:/, $_);
	    $counter{ $splitted_line[1] . $splitted_line[2] }++;
	}
	close(SOCK);
	close(FILE);
    } else {
	open(FILE, "<$tmp_file") || die "error: open $tmp_file .";
	while( <FILE> ){
	    # fill hash, means: *count* the entries
	    $info_lines{$_}++;
	    @splitted_line = split(/:/, $_);
	    $counter{ $splitted_line[1] . $splitted_line[2] }++;
	}
	close FILE;
    }

    if ($debug and not $feed_file ){
	printf ".............fetched. .........\n", $host
    }
    printf "\n";

    # let's parse the hash

    foreach( keys(%info_lines)){

	$bad = 0;
	$far = 0;
	$just_double = 0;
	$several = 0;

	@splitted_line = split(/:/, $_);


	# skip, if server crowded but asked for silent one, or vice cersa

	if (   $showquiet  && $splitted_line[3] eq "0" 
	    || !$showquiet && $splitted_line[3] ne "0" ){

	    @splitted_host= split(/\./, $splitted_line[1] );
	    ${splitted_host}[-1] =~ tr/A-Z/a-z/;

	    if ( ${splitted_host[0]} eq "daedalus" ){
		    # system("tput smso");
		    #printf "";
	    }

	    # several entries?
	    if (  $counter{ $splitted_line[1] . $splitted_line[2] } > 1 
		|| $info_lines{$_} > 1  ){
		$several = 1;
	    }

	    # known bad host?
	    for ( @bad_hosts ){
		if ( $splitted_line[1] eq $_ ){
		    $bad = 1;
		}
	    }

	    # just numbers?? pah
	    if ( ${splitted_host}[-1] !~ /[a-z]/ ){
		$bad = 1;
	    }

	    # too laggy?
	    for ( @too_far_away ){
		if ( ${splitted_host}[-1] eq $_ ){ 
		    $far = 1;
		}
	    }

	    # hostname just 2 elements?
	    if ( $#splitted_host == 1 ){
		$just_double = 1;
	    }

	    # inconvenient host?
	    if (   ( $bad ||  $several || $just_double) && !$showbad
		||  !$bad && !$several  &&  $showbad
		||  $far  && !$showall  && !$showbad
	       ){
		if ($debug){ printf "  .... %s  skipped.\n\n", $splitted_line[1] }
		next;
	    }


	    # host and map, if wanted (depends on if visited):
	    if (    $showquiet && $splitted_line[3] eq "0" 
		|| !$showquiet && $splitted_line[3] ne "0" ){
		if ( $splitted_line[2] == 15345 ){
		    printf ">>> %2s  %-29s %s# %s\n",
			$splitted_line[3], $splitted_line[1], $splitted_line[4],
			$splitted_line[0] ;
		} else {
		    printf ">>> %2s  %-22s|%d  %s# %s\n",
			$splitted_line[3], $splitted_line[1], $splitted_line[2],
			$splitted_line[4], $splitted_line[0] ;
		}
	    }


	    # print the players themselves:
	    if ( !$showquiet && $splitted_line[3] ne "0" ){
		@full_names= split(/,/, $splitted_line[10]);
		for( @full_names){
		    @splitted_name = split(/=/, $_);
		    printf "   %15s = %-s\n", $splitted_name[0], $splitted_name[1];
		}
		printf "\n";
	    }
	    system("tput rmso");
	}
    } #foreach
    system("tput rmso");

    %info_lines = ();
    %counter = ();

    printf "...............................\n";

    if ($once){ exit };
    sleep($sleep);
}