#!/usr/bin/perl
# This program is free software. You can redistribute it and/or modify it under
# the same terms as perl itself.
# Copyright © 2009-2011 M. Kristall

# This will generate a valid admin.dat file for testing purposes
# If arguments are passed and there is a file with the same name as the first
# argument, that will be used for the word list; /usr/share/dict/words is used
# otherwise
# All other arguments (including the first if there is no file with that name)
# are treated as extra default flags
use strict;

##TODO
# IP addresses in CIDR notation
# :: in IPv6 addresses
# Optimize flags generation to use as little space as possible

# Maximum file size (should be something less than 1MB)
my $maxlen		= 900 * 1024;

# Various settings
my $enableipv6		= 0;		# IPv6 addresses are up to 40 bytes long

# Some "reasonable" defaults—old defaults were 32, 1024, 1024, 64
my $maxlevels		= 5;
my $maxadmins		= 100;
my $maxbans		= 2000;
my $maxcommands		= 10;

# $minlevels should be at least 2 if $maxadmins > 0
my $minlevels		= 5;
my $minadmins		= 10;
my $minbans		= 50;
my $mincommands		= 0;

# These should be one less than the corresponding Tremulous macros
my $maxflaglen		= 19;
my $maxflagslen		= 1023;
my $maxcmdlen		= 19;
my $maxreasonlen	= 49;
my $maxexeclen		= 63;
my $maxdesclen		= 49;
my $maxnamelen		= 31;
###
foreach ([\$maxlevels, \$minlevels],
	[\$maxadmins, \$minadmins],
	[\$maxbans, \$minbans],
	[\$maxcommands, \$mincommands]) {
	if ($$_[1] > $$_[0]) {
		$$_[1] = 0;
		next;
	}
	$$_[1] -= $$_[0];
}

my $words = @ARGV && -f ($ARGV[0]) ? shift : '/usr/share/dict/words';
die ("$0: $words - $!\n") unless (open (DICT, '<', $words));
chomp (my @words = <DICT>);
close (DICT);
@words = grep { length ($_) <= $maxflaglen } @words;
sub word (;$) {
	my $word;
	do {
		$word = $words[rand (@words)];
	} while (@_ ? length ($word) > $_[0] : 0);
	return $word;
}

sub flag () { return word ($maxflaglen); }
sub name () { return word ($maxnamelen); }
sub command () { return word ($maxcmdlen); }

my @hex = ('0' .. '9', 'A' .. 'F');
sub guid () {
	my $guid = '';
	for (my $i = 0; $i < 32; $i++) {
		$guid .= $hex[rand (@hex)];
	}
	return $guid;
}

# now ± 10a
my $base = 10 * 365.2425 * 24 * 60 * 60;
sub expires () { return int (rand ($base) + 0.5 + $^T); }

my @flags = (qw/ban admintest denybuild allready cancelvote adminhelp kick
	listadmins listlayouts listplayers lock changemap mute namelog passvote
	putteam readconfig rename restart setlevel showbans spec999 time
	IMMUNITY NOCENSORFLOOD SPECALLCHAT RESTRICTED FORCETEAMCHANGE
	UNACCOUNTABLE NOVOTELIMIT CANPERMBAN ACTIVITY IMMUTABLE	INCOGNITO
	ADMINCHAT/, @ARGV);
my @cflags;
{
	my $c = rand ($maxcommands) + $mincommands;
	for (my $i = 0; $i < $c; $i++) {
		push (@cflags, flag);
	}
}
push (@flags, @cflags);
sub flags () {
	my $flags = '';
	my ($m, $f);
	for (my $i = 0, my $ubound = rand (@flags); $i < $ubound; $i++) {
		$m = (' ', ' -', ' +')[rand (3)];
		$f = $m . $flags[rand (@flags)];
		last if (length ($flags) + length ($f) >= $maxflagslen);
		$flags .= $f;
	}
	return $flags;
}

my $levels = int (rand ($maxlevels)) + $minlevels;
sub level () { return 1 + int (rand ($levels - 1)); }

# doesn't bother with :: in IPv6 addresses
sub ip () {
	# IPv4
	return join ('.', map { int (rand (256)) } 1 .. 4)
		if (!$enableipv6 || rand >= 0.5);
	# IPv6
	return join (':', map { sprintf ('%x', int (rand (65536))) } 1 .. 8);
}

sub made () {
	my ($sec, $min, $hr, $day, $mo, $yr) = localtime (expires - $base);
	return sprintf ('%02d/%02d/%02d %02d:%02d:%02d',
		$mo + 1, $day, $yr % 100, $hr, $min, $sec);
}

sub reason () {
	my $r = '';
	my $w;
	for (my $i = 0, my $ubound = rand (5); $i < $ubound; $i++) {
		$w = ' ' . word;
		last if (length ($r) >= $maxreasonlen);
		$r .= $w;
	}
	return $r;
}

my $ubound = rand ($maxadmins) + $minadmins;
my @admins = ('console');
my $str;
my $len = 0;
for (my $i = 0; $i < $ubound && $len < $maxlen; $i++, $len += length ($str)) {
	push (@admins, name);
	$str = "[admin]\n" .
		'level   = ' . level . "\n" .
		'flags   =' . flags . "\n" .
		'name    = ' . $admins[-1] . "\n" .
		'guid    = ' . guid . "\n\n";
	print $str if ($len + length ($str) < $maxlen);
}
for (my $i = 0; $i < $levels && $len < $maxlen; $i++, $len += length ($str)) {
	$str = "[level]\n" .
		'level   = ' . $i . "\n" .
		'flags   =' . flags . "\n" .
		'name    = ' . name . "\n\n";
	print $str if ($len + length ($str) < $maxlen);
}
$ubound = rand ($maxbans) + $minbans;
for (my $i = 0; $i < $ubound && $len < $maxlen; $i++, $len += length ($str)) {
	$str = "[ban]\n" .
		'made    = ' . made . "\n" .
		'banner  = ' . $admins[rand (@admins)] . "\n" .
		'ip      = ' . ip . "\n" .
		'name    = ' . name . "\n" .
		'reason  =' . reason . "\n" .
		'guid    = ' . guid . "\n" .
		'expires = ' . expires . "\n\n";
	print $str if ($len + length ($str) < $maxlen);
}
for (my $i = 0; $i < @cflags && $len < $maxlen; $i++, $len += length ($str)) {
	$str = "[command]\n" .
		'desc    =' . reason . "\n" .
		'flag    = ' . $cflags[$i] . "\n" .
		'command = ' . command . "\n" .
		'exec    =' . reason . "\n\n";
	print $str if ($len + length ($str) < $maxlen);
}