#!/usr/bin/perl -w
use strict;
$|=1;

use EVEcommon;

my ($opt_d, $opt_u, $opt_p, $opt_s, $opt_a, $opt_m, $opt_H,);
my ($opt_l, $opt_L, $opt_A, $opt_V, $opt_t, $opt_T, $opt_F,);


use Getopt::Long qw(:config no_ignore_case bundling);
GetOptions(
	'd=s' => \$opt_d, # db name
	'u=s' => \$opt_u, # db user
	'p=s' => \$opt_p, # db pass
	'A=s' => \$opt_A, # age limit for scan
	'V=s' => \$opt_V, # additional versions to check for
	'm=i' => \$opt_m, # max-size (in MB) for downloading patches
	'a=i' => \$opt_a, # alarm timeout
	's=i' => \$opt_s, # sleep between http accesses
	't=s' => \$opt_t, # check for patches if there was a new version within this time
	'T=s' => \$opt_T, # check for patches between version that have been seen within this time
	'H'   => \$opt_H, # do NOT scan for links. NOT NOT NOT
	'F'   => \$opt_F, # fork off for link scan
	'l'   => \$opt_l, # check for links
	'L'   => \$opt_L, # only check for links
	);

$opt_m ||= 100;
$opt_a ||= 5;
$opt_s ||= 5;
$opt_t ||= "1 hour";
$opt_T ||= "1 week";

die "opt_H with opt_l" if $opt_H && $opt_l;
die "opt_H with opt_L" if $opt_H && $opt_L;
die "opt_H with opt_F" if $opt_H && $opt_F;

$SIG{ALRM} = sub { die "alarm\n" };	

my %serv = (
	Singularity => ["87.237.38.50:26000",],
	Multiplicity => ["87.237.38.51:26000",],
	Tranquility => ["87.237.38.200:26000",],

	Something15 => ["87.237.38.15:26000",],
#	UNICORN => ["87.237.38.10:26000",],

	Icelandi22 => ["87.237.32.22:26000",],
	Icelandi23 => ["87.237.32.23:26000",],
	Icelandi84 => ["87.237.32.84:26000",],

#	CHAOS   => ["213.167.138.82:26000",],
#	ENTROPY => ["213.167.138.83:26000",],
#	TRANSAM => ["213.167.138.84:26000",],

	);

$opt_l ||= $opt_L;
die "links only without db" if $opt_L && !($opt_d && $opt_u);

my $dbh;
if ($opt_d && $opt_u) {
	$dbh = &get_dbh();

	goto FINDLINKS if $opt_L;

	my $sth = $dbh->prepare(qq{
		select
			name,
			ip,
			port,
			id
		from 
			server
		where
			active = 1
		}) or die $dbh->errstr;
	$sth->execute() or die $sth->errstr;

	%serv = ();
	while (my $r = $sth->fetchrow_arrayref) {
		my ($n, $i, $p, $I,) = @$r;
		$serv{$n} = ["$i:$p", $I,];
#		printf "loaded %s\n", $n;
	}
	$sth->finish();
}


my @targ = ();
my %cand = ();
for my $pat (@ARGV) {
	if ($pat =~ /^\d+\.\d+\.\d+\.\d+(:\d+)?$/) {
		$pat .= ":26000" unless defined $1;
		$serv{$pat} = [$pat,];
	}
	my @cand = grep {/$pat/i} keys %serv;
	die "bad patt $pat" unless @cand;
	for (@cand) {
		$cand{$_}++;
	}
}
@targ = sort keys %cand;
@targ = sort keys %serv unless @targ;

my ($sth_insert, $sth_status_ok, $sth_status_bad,);
my %vers = ();
for my $sn (@targ) {
	my ($sa, $si,) = @{$serv{$sn}};
	$si ||= "";

	use POSIX qw(strftime);
	my $now_string = strftime "%Y-%m-%d %H:%M:%S", gmtime;
#	printf "%s SERV(%s): ", $now_string, $sn;

	alarm $opt_a;
	my ($users, $vers, $build, $proto, $branch,) = eval{&check_serv($sn,$sa);};
	alarm 0;

	$users ||= 0;

	if ($@) {
		if ($dbh) {
			my $sth = $sth_status_bad ||= $dbh->prepare(qq{
				update
					server
				set
					status = ?
				where
					id = ?
				}) or die $dbh->errstr;
			$sth->execute("absent", $si) or die $sth->errstr;
		}


		chomp $@;
		printf "%s SERV(%s): died: %s\n", $now_string, $sn, $@;
		&spam(sprintf("EVE-SERVER BAD %s %s",$sn, $@)); 
		next;
	}

	my $vstr = sprintf "%f", $vers;
	$vstr =~ s/0+$//g;

	if ($dbh) {
		my $sth = $sth_insert ||= $dbh->prepare(qq{
			insert into 
				version 
			set 
				first	= ?,
				last	= ?,
				server	= ?,
				version	= ?,
				build	= ?,
				macho	= ?,
				branch	= ?,
				seen	= 1 
			on duplicate key update 
				last = ?,
				seen = seen+1
			}) or die $dbh->errstr;
		$sth->execute($now_string, $now_string, $si, $vstr, $build, $proto, $branch,
					$now_string) or die $sth->errstr;
		$sth = $sth_status_ok ||= $dbh->prepare(qq{
				update
					server
				set
					status = ?,
					lastok = UTC_TIMESTAMP()
				where
					id = ?
				}) or die $dbh->errstr;
		$sth->execute("ok, $users users", $si) or die $sth->errstr;
	}

	printf "%s SERV(%s): %i users, %s version, %i build, %s protocol, %s branch\n",
			$now_string, $sn,
	       		$users, $vstr, $build, $proto, $branch;
	&spam(sprintf("EVE-SERVER OK ".join(" ",($sn, $users, $vstr, $build, $proto, $branch)))); 

	$vers{$sn} = {
		id => $si,
		name => $sn,
		users => $users,
		version => $vstr, 
		build => $build,
		macho => $proto,
		branch => $branch,
		};
}

# do we need to check for links?
if ($dbh && !$opt_l && !$opt_H) {
	my $sth = $dbh->prepare(qq{
			select
				count(distinct build)
			from 
				version
			where
				first > UTC_TIMESTAMP()- INTERVAL $opt_t
			}) or die $dbh->errstr;
	$sth->execute() or die $sth->errstr;
	my $b = $sth->fetchrow_arrayref();
	$sth->finish;
	my ($c,) = @$b;
	printf "DEB: %i new versions within '%s'\n", $c, $opt_t;
	$opt_l ||= $c;
}

FINDLINKS:
if ($opt_l && !$opt_H) {
	my %builds = ();
	for (keys %vers) {
		my $b = $vers{$_}{build};
		$builds{$b}++;
	}

	my $sth;
	if ($dbh) {
		$sth = $dbh->prepare(qq{
			select
				distinct build
			from 
				version
			where
				last > UTC_TIMESTAMP()- INTERVAL $opt_T
			}) or die $dbh->errstr;
		$sth->execute() or die $sth->errstr;
		my $b = $sth->fetchall_arrayref();
		$sth->finish;

		for (@$b) {
			my ($B,) = @$_;
			$builds{$B}++;
		}
		printf "DEB: %i seen versions within '%s'\n", 
				scalar(@$b), $opt_T;

	}

	if ($opt_V) {
		$opt_V =~ s/\s//g;
		for (split /,/, $opt_V) {
		       $builds{$_}++;
	      	}
	}		

	my @b = sort {$a <=> $b} keys %builds;
#	printf "GOT BUILDS: %s\n", join " ", @b;

	if ($opt_F) {
		my $pid = fork();
		unless (defined $pid) {
			warn "failed to fork: $!";
		}
		if (defined $pid && $pid) {
			printf "DBG: forked PID %i to scan for patches between %i versions\n", $pid, scalar @b;
			exit 0;
		} else {
			if ($dbh) {
				$dbh = &get_dbh();
			}
		}
	}

	if ($dbh) {
		$sth = $dbh->prepare(qq{
			insert into
				patch
			set
				old = ?,
				new = ?,
				url = ?,
				bytes = ?,
				md5 = ?,
				sha1 = ?,
				first = UTC_TIMESTAMP(),
				last = UTC_TIMESTAMP()
			on duplicate key update
				url = ?,
				bytes = ?,
				md5 = ?,
				sha1 = ?,
				last = UTC_TIMESTAMP()
			}) or die $dbh->errstr;
	}

	my $patchdir = '/dada/tweb/root/zofu.no-ip.de/patches/';
	my $base1 = 'http://ccp.vo.llnwd.net/o2/';
	my $base2 = 'http://patch.gtgame.com.cn/';
	require LWP::Simple;
	while (@b) {
		my $f = shift @b;
		for my $t (@b) {
#			for ([$baseurl, 'evepatch%s-%s.exe',],
			for (
#				$base2.'eveclassicpatch%s-%s.exe',
				#$base1.'eveclassicpatch%s-%s.exe',
				#$base1.'test/eveclassicpatch%s-%s_test.exe',
				$base1.'evepremiumpatch%s-%s_m.exe',
				$base1.'evepremiumpatch%s-%s.exe',
				$base1.'test/evepremiumpatch%s-%s_test_m.exe',
				$base1.'test/evepremiumpatch%s-%s_test.exe',
			     ) {

				my $url = sprintf $_, $f, $t;
				my $file = $url;
				$file =~ s,.*/,,g;

				sleep $opt_s;
				printf "DBG: trying %s\n", $url;
				my @head = LWP::Simple::head($url);
				next unless @head;

				my $size = $head[1];


				if ($opt_m && 
				    $opt_m > 0 && 
				    ($opt_m*(2**20)) < $size) {
					# ITS TOO BIG!
					printf "too big: %.2f MB\n", $size/(2**20);
					if ($sth) {
						$sth->execute($f, $t, 
							$url, $size, undef, undef,
							$url, $size, undef, undef)
						or die $sth->errstr;
					}
					&spam(sprintf("EVE-PATCH %s %s", $url, $size));
					last;
				}

				my $rc = LWP::Simple::mirror($url, $patchdir.$file);
				if (200 == $rc ||
				    304 == $rc) {
				    	my ($bytes, $md5, $sha1,) = (0, "", "",);
#					if (200 == $rc) {
						my $afile = $patchdir.$file;
						$bytes = (stat($afile))[7];
						my $o = `md5sum "$afile"`;
						die "bad md5sum output: $o" unless
							$o =~ /^([0-9a-f]{32})\s/;
						$md5 = $1;
						$o = `sha1sum "$afile"`;
						die "bad sha1sum output: $o" unless
							$o =~ /^([0-9a-f]{40})\s/;
						$sha1 = $1;
						printf "PATCHSTAT: %s %s => %i byte, %s %s\n", 
								$rc, $file, $bytes, $md5, $sha1;
#					}

					if ($sth) {
						$sth->execute($f, $t, 
							$url, $bytes, $md5, $sha1,
							$url, $bytes, $md5, $sha1)
						or die $sth->errstr;
					}
					&spam(sprintf("EVE-PATCH %s %s %s %s %s", $url, $size, $rc, $md5, $sha1));
					last;
				} elsif (404 == $rc) {
					#ignore
				} else {
					printf "RC %s for %s\n", $rc, $url;
				}
			}
			#printf "try: %s-%s\n", $f, $t;
		}
#		exit 23;
	}
}

exit 0;

#######

my $sth_patches;
sub get_patchlinks ($) {
	my ($to,) = @_;
	return "" unless $dbh;

	my $sth = $sth_patches ||= $dbh->prepare(qq{
			select
				distinct old,
				url,
				bytes,
				date(last),
				md5,
				sha1
			from
				patch
			where
				new = ?
			order by old asc
			}) or die $dbh->errstr;
	$sth->execute($to) or die $sth->errstr;
	my $p = $sth->fetchall_arrayref();
	$sth->finish();

	my @links = ();
	for (@$p) {
		my ($from, $url, $bytes, $date, $md5, $sha1,) = @$_;
		my $title = sprintf "lastseen %s, size %s, md5 %s", 
				$date, &prettybyte($bytes), $md5;
		my $lnk = a({href=>$url,title=>$title,}, $from);
		push @links, $lnk;
	}

	return join " ", @links;
}





sub check_serv($$) {
	my ($sn, $sa,) = @_;


#	printf "addr %s ... ", $sn, $sa;

	use IO::Socket::INET;
	my $sock = IO::Socket::INET->new(
				PeerAddr => $sa,
				Timeout => 23,
				);
	die "cant connect to $sa: $!" unless $sock;

	print $sock "\n\n\n";
	my $data = "";
	$sock->recv($data, 1024);

	die "no data" unless $data;


	my $dd = $data;
	my $Ps = unpack "L", substr $dd, 0, 4, "";
	unless ($Ps == length($dd)) {
		printf "size mismatch, expected %i, have %i\n", $Ps, length($dd);
		&dumpme($data);
	}

	my $dunno = pack "H*", "7e00000000";
	unless ($dunno eq substr $dd, 0, length($dunno), "") {
		printf "dunno1 mismatch\n";
		&dumpme($data);
	}

  my ($machodata, $sizeconsumed,) = &demacho_old($dd);
  unless ($sizeconsumed == length($dd)) {
    printf "used up $sizeconsumed of ".length($dd)." bytes";
		&dumpme($data);
  }
  unless (ref $machodata eq 'ARRAY') {
    printf "expected ARRAY, got $machodata";
		&dumpme($data);
  }
  unless (scalar @$machodata == 6) {
    printf "ARRAY has wrong size: ".scalar @$machodata;
		&dumpme($data);
  }

  my ($magic, $proto, $users, $vers, $build, $branch,) = @$machodata;
#  14:45 <%Veritech> the 170472 bit?
#  14:46 <%Veritech> it's papasmurf's birthday
#  14:46 <%Veritech> he wrote machonet
  unless ($magic == 170472) {
    printf "bad magic: $magic";
		&dumpme($data);
  }

	return ($users, $vers, $build, $proto, $branch,);

}


sub demacho_old {
  my ($dd,) = @_;

  my $type = unpack "C", $dd;

  my ($data, $typename, $size,);
	if ($type == 4) {
		$data = unpack "L", substr $dd, 1, 4;
    $typename = "32bit signed integer";
    $size = 4;
	} elsif ($type == 5) {
		$data = unpack "S", substr $dd, 1, 2;
    $typename = "16bit signed integer";
    $size = 2;
	} elsif ($type == 6) {
		$data = unpack "C", substr $dd, 1, 1;
    $typename = "8bit signed integer";
    $size = 1;
	} elsif ($type == 9) {
		$data = 1;
		$typename = "0bit 1 integer";
		$size = 0;
	} elsif ($type == 8) {
		$data = 0;
		$typename = "0bit 0 integer";
		$size = 0;
	} elsif ($type == 1) {
		$data = undef;
		$typename = "0bit NULL";
		$size = 0;
	} elsif ($type == 10) {
	  $data = unpack "d", substr $dd, 1, 8;
    $typename = "64bit float";
    $size = 8;
	} elsif (0x10 == $type || 0x13 == $type) {
	  my $len = unpack "C", substr $dd, 1, 1;
	  $data = substr $dd, 2, $len;
    $typename = "string max 255 byte";
    $size = $len+1;
  } elsif ($type == 20) { # now things get complicated
	  my $len = unpack "C", substr $dd, 1, 1;
    $typename = "array ($len)";
    $size = 1;
    $data = [];
    while ($dd && scalar @$data < $len) {
      my ($sd, $sc,) = &demacho_old(substr $dd, $size+1);
      push @$data, $sd;
      $size += $sc;
    }
  } else {
    printf "unknown type $type\n";
    &dumpme($dd);
  }
  return ($data, $size+1,);
}

sub dumpme {
	my ($data,) = @_;
  	&hexdump($data);
	die "emergency dump triggered";
}

sub get_dbh {
	require DBI;
	my $dbh = DBI->connect("DBI:mysql:database=$opt_d", $opt_u, $opt_p);
	die "cant connect to db: ".DBI->errstr unless $dbh;
	return $dbh;
}

sub spam ($) {
	my ($msg,) = @_;

	eval {
		require TMA::Spammer;
		TMA::Spammer::spam($msg);
		};
}