From 4af80f26ce46d4a31c5577c946aa9ffe8e782839 Mon Sep 17 00:00:00 2001 From: Gunter Labes Date: Tue, 16 Jun 2009 01:50:42 +0000 Subject: [PATCH] cleaned the utils dir of some obsolete and/or non-functional scripts --- utils/README | 4 +- utils/SConstruct | 103 ----------- utils/mp-lobby-logger.pl | 387 --------------------------------------- utils/slacknoth | 51 ------ utils/unit.pl | 291 ----------------------------- utils/update_unit_tree | 63 ------- utils/weblist.pl | 272 --------------------------- utils/webtgz.pl | 348 ----------------------------------- 8 files changed, 2 insertions(+), 1517 deletions(-) delete mode 100644 utils/SConstruct delete mode 100755 utils/mp-lobby-logger.pl delete mode 100755 utils/slacknoth delete mode 100755 utils/unit.pl delete mode 100755 utils/update_unit_tree delete mode 100755 utils/weblist.pl delete mode 100755 utils/webtgz.pl diff --git a/utils/README b/utils/README index 94afe062404..45a064b257b 100644 --- a/utils/README +++ b/utils/README @@ -1,6 +1,6 @@ -This is a directory of miscellaneous developer tools for Battle Of Wesnoth, +This is a directory of miscellaneous developer tools for Battle for Wesnoth, mostly to support packaging, code integrity checks, and control of the -Wesnoth campaign server. +Wesnoth servers. Tools that work on data (WML, maps, images, sounds) no longer belong here. Go to data/tools for those. diff --git a/utils/SConstruct b/utils/SConstruct deleted file mode 100644 index 8c0168766d1..00000000000 --- a/utils/SConstruct +++ /dev/null @@ -1,103 +0,0 @@ -# vi: syntax=python -import glob - -""" -Runs this as: - -scons -f utils/SConstruct [editor=1] [server=1] - -from within the wesnoth toplevel directory. It expects to have all kinds of -windows dependencies in the parent directory, like this: - -../wesnoth/(you are here) -../win-deps/... - -and it will create/use a build directory in the parent folder as well: - -../build/... - -For details see the cross-compiling instructions on the Wiki. - -""" -editor = ARGUMENTS.get("editor", "") -wesnothd = ARGUMENTS.get("server", "") - -#sources = glob.glob("src/*.cpp") +\ -# glob.glob("src/widgets/*.cpp") +\ -# glob.glob("src/serialization/*.cpp") +\ -# glob.glob("src/sdl_ttf/*.c") -#sources.remove("src/loadscreen_empty.cpp") -#sources.remove("src/animated_editor.cpp") - -def parse_automake(filename, variable): - """Crude helper function to parse an automake file.""" - sources = [] - am = file(filename).read() - x = am.find(variable) - while 1: - done = False - while am[x] != '\\': - if am[x] == '\n': - done = True - break - x += 1 - if done: break - x += 1 - while am[x].isspace(): x += 1 - name = "" - while not am[x].isspace(): - name += am[x] - x += 1 - sources.append("src/" + name) - return sources - -# read the sources from the automake file -sources = parse_automake("src/Makefile.am", "libwesnoth_core_a_SOURCES") -sources += parse_automake("src/Makefile.am", "wesnoth_SOURCES") -# there shouldn't be doubles, but well, let's remove them :) -sources = list(set(sources)) - -# read editor sources from automake file -editor_sources = parse_automake("src/Makefile.am", "libwesnoth_core_a_SOURCES") -editor_sources += parse_automake("src/Makefile.am", "wesnoth_editor_SOURCES") -editor_sources = list(set(editor_sources)) - -# read the server sources from the automake file -wesnothd_sources = parse_automake("src/Makefile.am", "libwesnoth_core_a_SOURCES") -wesnothd_sources += parse_automake("src/Makefile.am", "wesnothd_SOURCES") -wesnothd_sources = list(set(wesnothd_sources)) - -env = Environment() - -# The cross compiler to use -env["CC"] = "i586-mingw32msvc-gcc" -env["CXX"] = "i586-mingw32msvc-g++" - -# Dependencies: SDL, SDL_net, SDL_mixer, SDL_image, freetype, libintl -# This is where I put the dependency headers -env.Append(CPPPATH = ["../win-deps/include"]) - -# This is where I put the dependency libs -env.Append(LIBPATH = ["../win-deps/lib"]) - -# Compilation settings -env.Append(CCFLAGS = ["-O2", "-mthreads", "-DHAVE_PYTHON"]) -env.Append(LINKFLAGS = ["-s", "-mwindows", "-lmingwthrd"]) -env.Append(CPPPATH = ["src", "src/widgets"]) -env.Append(LIBS = ["mingw32", "SDLmain", "SDL", "SDL_net", "SDL_mixer", "SDL_image", - "intl", "wsock32", "freetype", "boost-iostreams", "z"]) - -# Scons stuff -env.BuildDir("../build", "src") -env.SConsignFile("sconsign") - -# Windows stuff -env["PROGSUFFIX"] = ".exe" - -# Compile it! -env.Program("wesnoth", ["../build/" + x[4:] for x in sources]) -if editor: - env.Program("wesnoth_editor", ["../build/" + x[4:] for x in editor_sources]) -if wesnothd: - env.Program("wesnothd", ["../build/" + x[4:] for x in wesnothd_sources]) - diff --git a/utils/mp-lobby-logger.pl b/utils/mp-lobby-logger.pl deleted file mode 100755 index e0ae1b79a6d..00000000000 --- a/utils/mp-lobby-logger.pl +++ /dev/null @@ -1,387 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use wml; -use IO::Socket; -use POSIX qw(strftime); -use Getopt::Std; -use Data::Dumper; - -#my $usage = "Usage: $0 [-dgjnqs] [-e count] [-l logfile] [-h [host]] [-p [port]] [-t [timestampformat]] [-u username]"; - -my %opts = (); -getopts('dgjqsl:ne:h:p:t:u:',\%opts); - -my $USERNAME = 'log'; -$USERNAME = $opts{'u'} if $opts{'u'}; -my $HOST = '127.0.0.1'; -$HOST = 'server.wesnoth.org' if exists $opts{'h'}; -$HOST = $opts{'h'} if $opts{'h'}; -my $PORT = '15000'; -$PORT = '14999' if exists $opts{'p'}; -$PORT = $opts{'p'} if $opts{'p'}; -my $logtimestamp = "%Y%m%d %T "; -my $timestamp = "%Y%m%d %T "; -$timestamp = $opts{'t'} if $opts{'t'}; -$timestamp = '' unless exists $opts{'t'}; -my $writestats = $opts{'s'}; -my $statsfile = "/tmp/wesnoth.stats_" . $HOST . "_" . $PORT; -my $showjoins = $opts{'j'}; -my $showgames = $opts{'g'}; -my $showturns = $opts{'n'}; -my $dumpunknown = $opts{'d'}; -my $quiet = $opts{'q'}; -my $logfile = $opts{'l'}; -if (exists $opts{'l'}) {open(LOG, ">> $logfile") or die "can't open $logfile: $!";} -select LOG; $| = 1; - -my $LOGIN_RESPONSE = "[login]\nusername=\"$USERNAME\"\n[/login]"; -my $VERSION_RESPONSE = "[version]\nversion=\"test\"\n[/version]"; -my @users = (); -my @games = (); -my %outgoing_schemas = (); -my %incoming_schemas = (); - - -sub connect($$) { - my ($host,$port) = @_; - my $sock = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp', Type => SOCK_STREAM) - or die "Could not connect to $host:$port: $@\n"; - print $sock pack('N',0) or die "Could not send initial handshake"; - - my $connection_num = ""; - read $sock, $connection_num, 4; - die "Could not read connection number" if length($connection_num) != 4; - - $outgoing_schemas{$sock} = []; - $incoming_schemas{$sock} = []; - return $sock; -} - -sub disconnect($) { - my ($sock) = @_; - delete($outgoing_schemas{$sock}); - delete($incoming_schemas{$sock}); - close $sock; -} - -sub read_packet($) { - my ($sock) = @_; - my $buf = ''; - read $sock, $buf, 4; - die "Could not read length" if length($buf) != 4; - - my $len = unpack('N',$buf); - - my $res = "\0"; - my $count = 0; - while($len > $count) { - $buf = ''; - my $bytes = $len - $count; - read $sock, $buf, $bytes or die "Error reading socket: $!"; - substr($res, $count, length $buf) = $buf; - $count += length $buf; - } - - $res = substr($res,0,$len-1); - - return &wml::read_binary($incoming_schemas{$sock},$res); -} - -sub write_packet($$) { - my ($sock,$doc) = @_; - my $data = &wml::write_binary($outgoing_schemas{$sock},$doc); - $data .= chr 0; - my $header = pack('N',length $data); - print $sock "$header$data" or die "Error writing to socket: $!"; -} - -sub write_bad_packet($$) { - my ($sock, $doc) = @_; - my $data = &wml::write_binary($outgoing_schemas{$sock},$doc); - $data .= chr 0; - my $header = pack('N', (length $data) * 2); - print $sock "$header$data" or die "Error writing to socket: $!"; -} - - -sub timestamp { - return strftime($timestamp, localtime()); -} - -sub logtimestamp { - return strftime($logtimestamp, localtime()); -} - -sub login($) { - my $sock = shift; - my $response; - my $tries = 0; - my $logged_in = 'no'; - until($logged_in eq 'yes') { - $tries++; - $response = &read_packet($sock); - #print STDERR Dumper($response); - # server asks for the version string - if (&wml::has_child($response, 'version')) { - $logged_in = 'version'; - $tries = 0; - &write_packet($sock, &wml::read_text($VERSION_RESPONSE)); - # server asks for a login name - } elsif (&wml::has_child($response, 'mustlogin')) { - $logged_in = 'mustlogin'; - $tries = 0; - &write_packet($sock, &wml::read_text($LOGIN_RESPONSE)); - # server sends the join lobby response - } elsif (&wml::has_child($response, 'join_lobby')) { - $logged_in = 'join_lobby'; - $tries = 0; - # server sends the initial list of games and players - } elsif (&wml::has_child($response, 'gamelist')) { - $logged_in = 'yes'; - foreach (@ {$response->{'children'}}) { - if ($_->{'name'} eq 'gamelist') { - @games = @ {$_->{'children'}}; - } elsif ($_->{'name'} eq 'user') { - $users[@users] = $_; - } - } - } elsif (my $error = &wml::has_child($response, 'error')) { - print STDERR "Error: $error->{'attr'}->{'message'}.\n" and die; - } else { - if ($logged_in eq 'no') { - print STDERR "Warning: Server didn't ask for version or login yet and gave no error. ($tries)\n" . Dumper($response); - } elsif ($logged_in eq 'version') { - print STDERR "Warning: Server didn't ask us to log in yet and gave no error. ($tries)\n" . Dumper($response); - } elsif ($logged_in eq 'mustlogin') { - print STDERR "Warning: Server didn't ask us to join the lobby yet and gave no error. ($tries)\n" . Dumper($response); - } elsif ($logged_in eq 'join_lobby') { - print STDERR "Warning: Server didn't send the initial gamelist yet and gave no error. ($tries)\n" . Dumper($response); - } - # give up after 10 unknown packets - print STDERR "Giving up...\n" if $tries == 10 and die; - } - } - my $userlist = @users . " users:"; - foreach (@users) { - $userlist .= " " . $_->{'attr'}->{'name'}; - } - $userlist .= "\n"; - print STDERR $userlist if $showjoins; - print LOG $userlist if $logfile; - my $gamelist = @games . " games:"; - foreach (@games) { - $gamelist .= " \"" . $_->{'attr'}->{'name'} . "\""; - } - $gamelist .= "\n"; - print STDERR $gamelist if $showgames; - print LOG $gamelist if $logfile; -} - -sub serverstats() { - open STATS, ">" . $statsfile; - print STATS "users: " . ($#users + 1) . "\ngames: " . ($#games + 1) . "\n"; - close STATS; -} - -# make several connections and send packets with a wrong length then sleep indefinitely -if (my $count = $opts{'e'}) { - for (1..$count) { - my $socket = &connect($HOST,$PORT); - &write_bad_packet($socket, &wml::read_text($VERSION_RESPONSE)); - } - sleep(); -} - - - -print STDERR "Connecting to $HOST:$PORT as $USERNAME.\n" unless $quiet; -print LOG "Connecting to $HOST:$PORT as $USERNAME.\n" if $logfile; -my $socket = &connect($HOST,$PORT); -defined($socket) or die "Error: Can't connect to the server."; - -&login($socket); -&serverstats() if $writestats; - -while (1) { - my $response = &read_packet($socket); - foreach (@ {$response->{'children'}}) { - if ($_->{'name'} eq 'message') { - my $sender = $_->{'attr'}->{'sender'}; - my $message = $_->{'attr'}->{'message'}; - if ($message =~ s,^/me,,) { - print STDERR ×tamp . "* $sender$message\n" unless $quiet; - print LOG &logtimestamp . "* $sender$message\n" if $logfile; - } else { - print STDERR ×tamp . "<$sender> $message\n" unless $quiet; - print LOG &logtimestamp . "<$sender> $message\n" if $logfile; - } - } elsif ($_->{'name'} eq 'whisper') { - my $sender = $_->{'attr'}->{'sender'}; - my $message = $_->{'attr'}->{'message'}; - if ($message =~ s,^/me,,) { - print STDERR ×tamp . "*$sender$message*\n" unless $quiet; - print LOG &logtimestamp . "*$sender$message*\n" if $logfile; - } else { - print STDERR ×tamp . "*$sender* $message\n" unless $quiet; - print LOG &logtimestamp . "*$sender* $message\n" if $logfile; - } - } elsif ($_->{'name'} eq 'gamelist_diff') { - foreach (@ {$_->{'children'}}) { - my $userindex = $_->{'attr'}->{'index'}; - if ($_->{'name'} eq 'insert_child') { - if (my $user = &wml::has_child($_, 'user')) { - my $username = $user->{'attr'}->{'name'}; - print STDERR ×tamp . "--> $username has logged on. ($userindex)\n" if $showjoins; - print LOG &logtimestamp . "--> $username has logged on. ($userindex)\n" if $logfile; - my $index = @users; - print STDERR "Warning: userlist out of sync: local index = $index vs remote index = $userindex\n" if $userindex != $index; - $users[$index] = $user; - &serverstats() if $writestats; - } else { - print STDERR "[gamelist_diff]:" . Dumper($_) if $dumpunknown; - } - } elsif ($_->{'name'} eq 'delete_child') { - if (my $user = &wml::has_child($_, 'user')) { - my $username = $users[$userindex]->{'attr'}->{'name'}; - print STDERR ×tamp . "<-- $username has logged off. ($userindex)\n" if $showjoins; - print LOG &logtimestamp . "<-- $username has logged off. ($userindex)\n" if $logfile; - splice(@users,$userindex,1); - &serverstats() if $writestats; - } else { - print STDERR "[gamelist_diff]:" . Dumper($_) if $dumpunknown; - } - } elsif ($_->{'name'} eq 'change_child') { - if (my $user = &wml::has_child($_, 'user')) { - foreach (@ {$user->{'children'}}) { - if ($_->{'name'} eq 'insert' and $userindex < @users) { - my $username = $users[$userindex]->{'attr'}->{'name'}; - if ($_->{'attr'}->{'available'} eq "yes") { - my $game_id = $users[$userindex]->{'attr'}->{'game_id'}; - my $location = $users[$userindex]->{'attr'}->{'location'}; - $users[$userindex]->{'attr'}->{'game_id'} = ""; - $users[$userindex]->{'attr'}->{'location'} = ""; - print STDERR ×tamp . "++> $username has left a game: \"$location\" ($game_id)\n" if $showjoins and $showgames; - print LOG &logtimestamp . "++> $username has left a game: \"$location\" ($game_id)\n" if $logfile; - } elsif ($_->{'attr'}->{'available'} eq "no") { - my $game_id = $_->{'attr'}->{'game_id'}; - my $location = $_->{'attr'}->{'location'}; - $users[$userindex]->{'attr'}->{'game_id'} = $game_id; - $users[$userindex]->{'attr'}->{'location'} = $location; - print STDERR ×tamp . "<++ $username has joined a game: \"$location\" ($game_id)\n" if $showjoins and $showgames; - print LOG &logtimestamp . "<++ $username has joined a game: \"$location\" ($game_id)\n" if $logfile; - } - } elsif ($_->{'name'} eq 'delete') { - } else { - print STDERR "[gamelist_diff][change_child][user]:" . Dumper($_) if $dumpunknown; - } - } - #print STDERR "[gamelist_diff][change_child]:" . Dumper($user) if $dumpunknown; - } elsif (my $gamelist = &wml::has_child($_, 'gamelist')) { - foreach (@ {$gamelist->{'children'}}) { - my $gamelistindex = $_->{'attr'}->{'index'}; - if ($_->{'name'} eq 'insert_child') { - if (my $game = &wml::has_child($_, 'game')) { - my $gamename = $game->{'attr'}->{'name'}; - my $gameid = $game->{'attr'}->{'id'}; - my $era = "unknown"; # some eras don't set the id - $era = $game->{'attr'}->{'mp_era'} if $game->{'attr'}->{'mp_era'}; - my $scenario = "unknown"; # some scenarios don't set the id - $scenario = $game->{'attr'}->{'mp_scenario'} if $game->{'attr'}->{'mp_scenario'}; - my $xp = "100%"; # scenarios might not set XP - $xp = $game->{'attr'}->{'experience_modifier'} if $game->{'attr'}->{'experience_modifier'}; - my $gpv = $game->{'attr'}->{'mp_village_gold'}; - my $fog = $game->{'attr'}->{'mp_fog'}; - my $shroud = $game->{'attr'}->{'mp_shroud'}; - my $timer = "none"; # reloads may not set the timer - $timer = $game->{'attr'}->{'mp_countdown'} if $game->{'attr'}->{'mp_countdown'}; - my $observer = $game->{'attr'}->{'observer'}; - print STDERR ×tamp . "+++ A new game has been created: \"$gamename\" ($gamelistindex, $gameid).\n" if $showgames; - print LOG &logtimestamp . "+++ A new game has been created: \"$gamename\" ($gamelistindex, $gameid).\n" if $logfile; - my $settings = "Settings: map: \"$scenario\" era: \"$era\" XP: $xp GPV: $gpv fog: $fog shroud: $shroud observers: $observer timer: $timer"; - if ($timer =~ "yes") { - my $treservoir = "-"; - $treservoir = $game->{'attr'}->{'mp_countdown_reservoir_time'} if $game->{'attr'}->{'mp_countdown_reservoir_time'}; - my $tinit = "-"; - $tinit = $game->{'attr'}->{'mp_countdown_init_time'} if $game->{'attr'}->{'mp_countdown_init_time'}; - my $taction = "-"; - $taction = $game->{'attr'}->{'mp_countdown_action_bonus'} if $game->{'attr'}->{'mp_countdown_action_bonus'}; - my $tturn = "-"; - $tturn = $game->{'attr'}->{'mp_countdown_turn_bonus'} if $game->{'attr'}->{'mp_countdown_turn_bonus'}; - $settings .= " reservoir time: $treservoir init time: $tinit action bonus: $taction turn bonus: $tturn"; - } - print STDERR ×tamp . $settings . "\n" if $showgames; - print LOG &logtimestamp . $settings . "\n" if $logfile; - $games[@games] = $game; - &serverstats() if $writestats; - } else { - print "[gamelist_diff][change_child][gamelist]:" . Dumper($_) if $dumpunknown; - } - } elsif ($_->{'name'} eq 'delete_child') { - if (my $game = &wml::has_child($_, 'game')) { - my $gamename = $games[$gamelistindex]->{'attr'}->{'name'}; - my $gameid = $games[$gamelistindex]->{'attr'}->{'id'}; - my $turn = $games[$gamelistindex]->{'attr'}->{'turn'}; - if (defined($turn)) { - print STDERR ×tamp . "--- A game ended at turn $turn: \"$gamename\". ($gamelistindex, $gameid)\n" if $showgames; - print LOG &logtimestamp . "--- A game ended at turn $turn: \"$gamename\". ($gamelistindex, $gameid)\n" if $logfile; - } else { - print STDERR ×tamp . "--- A game was aborted: \"$gamename\". ($gamelistindex, $gameid)\n" if $showgames; - print LOG &logtimestamp . "--- A game was aborted: \"$gamename\". ($gamelistindex, $gameid)\n" if $logfile; - } - splice(@games,$gamelistindex,1); - &serverstats() if $writestats; - } else { - print STDERR "[gamelist_diff][change_child][gamelist]:" . Dumper($_) if $dumpunknown; - } - } elsif ($_->{'name'} eq 'change_child') { - if (my $game = &wml::has_child($_, 'game')) { - foreach (@ {$game->{'children'}}) { - if ($_->{'name'} eq 'insert' and $gamelistindex < @games) { - if (my $turn = $_->{'attr'}->{'turn'}) { - my $gamename = $games[$gamelistindex]->{'attr'}->{'name'}; - my $gameid = $games[$gamelistindex]->{'attr'}->{'id'}; - if ($turn =~ /^1\//) { - print STDERR ×tamp . "*** A game has started: \"$gamename\". ($gamelistindex, $gameid)\n" if $showgames; - print LOG &logtimestamp . "*** A game has started: \"$gamename\". ($gamelistindex, $gameid)\n" if $logfile; - } else { - print STDERR ×tamp . "Turn changed to $turn in game: \"$gamename\". ($gamelistindex, $gameid)\n" if $showgames and $showturns; - print LOG &logtimestamp . "Turn changed to $turn in game: \"$gamename\". ($gamelistindex, $gameid)\n" if $logfile; - } - $games[$gamelistindex]->{'attr'}->{'turn'} = $turn; - } - } elsif ($_->{'name'} eq 'delete') { - } else { - print "[gamelist_diff][change_child][gamelist][change_child][game]:" . Dumper($_) if $dumpunknown; - } - } - } else { - print STDERR "[gamelist_diff][change_child][gamelist]:" . Dumper($_) if $dumpunknown; - } - } else { - print STDERR "[gamelist_diff][change_child][gamelist]:" . Dumper($_) if $dumpunknown; - } - } - } else { - print STDERR "[gamelist_diff]:" . Dumper($_) if $dumpunknown; - } - } else { - print STDERR "[gamelist_diff]:" . Dumper($_) if $dumpunknown; - } - } - # [observer] and [observer_quit] should be deprecated they are redundant to parts of [gamelist_diff] - } elsif ($_->{'name'} eq 'observer') { -# my $username = $_->{'attr'}->{'name'}; -# print ×tamp . "++> $username has joined the lobby.\n"; - } elsif ($_->{'name'} eq 'observer_quit') { -# my $username = $_->{'attr'}->{'name'}; -# print ×tamp . "<++ $username has left the lobby.\n"; - } else { - print STDERR Dumper($_) if $dumpunknown; - } - } - -} -print "Connection closed.\n\n" unless $quiet; -close(LOG); diff --git a/utils/slacknoth b/utils/slacknoth deleted file mode 100755 index 789addee5e5..00000000000 --- a/utils/slacknoth +++ /dev/null @@ -1,51 +0,0 @@ -#!/bin/sh -if [ "$3" = "" ] -then -echo "slacknoth v0.2 - Creates a Wesnoth package for Slackware Linux" -echo "- by Skovbaer (Mark Michelsen)" -echo "" -echo "Usage: slacknoth [version tag] [architecture e.g. i386 or athlon]" -echo " [wesnoth root e.g. /usr/games/src/wesnoth]" -echo "" -exit 0; -fi -cd $3 -mkdir -p /wesnothpack/wesnoth-$1 -echo "Configuring..." -./autogen.sh -./configure --prefix=/usr --enable-server --enable-tools -make clean -echo "Compiling and gathering package contents..." -make DESTDIR=/wesnothpack/wesnoth-$1 CXXFLAGS="-g -O2 -fno-omit-frame-pointer -march=$2" install -i -k -mkdir -p /wesnothpack/wesnoth-$1/usr/doc/wesnoth-$1 -cp -Rf changelog COPYING copyright INSTALL MANUAL* README /wesnothpack/wesnoth-$1/usr/doc/wesnoth-$1 -echo "Cleaning up source..." -make clean -cd /wesnothpack/wesnoth-$1 -echo "Stripping binaries..." -strip usr/bin/* -echo "Adding package info..." -mkdir install -echo wesnoth: Battle for Wesnoth $1 > install/slack-desc -echo wesnoth: Copyright \(C\) 2003-`date +%Y` by David White \ >> install/slack-desc -echo wesnoth: http://www.wesnoth.org/ >> install/slack-desc -echo wesnoth: Made with Slacknoth: Mark Michelsen \ >> install/slack-desc -echo wesnoth: >> install/slack-desc -echo wesnoth: Battle for Wesnoth is a fantasy turn-based strategy game. >> install/slack-desc -echo wesnoth: Battle for control of villages, using a variety of units which have >> install/slack-desc -echo wesnoth: advantages and disadvantages in different types of terrains and >> install/slack-desc -echo wesnoth: against different types of attacks. Units gain experience and advance >> install/slack-desc -echo wesnoth: levels, and are carried over from one scenario to the next campaign. >> install/slack-desc -echo wesnoth: >> install/slack-desc -echo "Building package..." -tar cf wesnoth-$1-$2-1.tar . -gzip -9 wesnoth-$1-$2-1.tar -mv -f wesnoth-$1-$2-1.tar.gz wesnoth-$1-$2-1.tgz -echo "Moving package to $3 ..." -mv -f wesnoth-$1-$2-1.tgz $3 -cd $3 -echo "Removing temporary directory..." -rm -Rf /wesnothpack -echo "And that's it, we're done!" -echo "If everything went all right, you should have the package" -echo "$3/wesnoth-$1-$2-1.tgz" diff --git a/utils/unit.pl b/utils/unit.pl deleted file mode 100755 index 3ef65f2b1a8..00000000000 --- a/utils/unit.pl +++ /dev/null @@ -1,291 +0,0 @@ -use wml; - -#helper functions we want eval to be able to see -sub decimal($) -{ - sprintf "%.2f", $_[0]; -} - -my $expression = ''; -my @sortby = (); -my @filter = (); -my @where = (); -my @heading = (); -my @fold = (); - -while(my $arg = shift @ARGV) { - if($arg eq '--sortby') { - my $sortby = shift @ARGV or die "need argument to --sortby option"; - unshift @sortby, $sortby; - } elsif($arg eq '--filter') { - my $filter = shift @ARGV or die "need argument to --filter option"; - push @filter, $filter; - } elsif($arg eq '--where') { - my $where = shift @ARGV or die "need argument to --where option"; - push @where, $where; - } elsif($arg eq '--prelude') { - my $prelude = shift @ARGV or die "need argument to --prelude option"; - open PRELUDE, "<$prelude" or die "could not open prelude '$prelude'"; - my @prelude = ; - close PRELUDE; - - push @where, (join '',@prelude); - } elsif($arg eq '--heading') { - my $heading = shift @ARGV or die "need argument to --heading option"; - @heading = split ',', $heading or die "could not evaluate heading: $!"; - } elsif($arg eq '--fold') { - my $fold = shift @ARGV or die "need argument to --fold option"; - push @fold, $fold; - } elsif($arg eq '--help') { - print "Wesnoth Unit Analysis Tool. Usage: $0 [options] - is a Perl expression which will be evaluated for each unit with the results output. There is a set of parentheses assumed around , so a comma-separated list of expressions is valid. -A valid Wesnoth cache must be provided on stdin. - Options: - --sortby: sort by the given expression - --filter: evaluates the given expression, and will only display results for the unit if the filter evaluates to true - --where: executes the given code before executing any other expression for each unit - --prelude: like --where, but opens up a given file and runs the script in it. -"; - } else { - die "unrecognized argument '$arg'. Use --help for help." if $expression; - $expression = $arg; - } -} - -die "must give an expression to evaluate" unless $expression; - -my $text = ''; -read STDIN, $text, 10000000; -my $doc = &wml::read_binary([],$text) or die "could not read document"; -$text = ''; - -my $units = 0; -foreach my $item (@{$doc->{'children'}}) { - if($item->{'name'} eq 'units') { - $units = $item; - last; - } -} - -die "could not find [units] section" unless $units; - -my %movetypes = (); -my @units = (); -my @results = (); -my $columns = 0; - -foreach my $item (@{$units->{'children'}}) { - if($item->{'name'} eq 'unit') { - push @units, $item; - } elsif($item->{'name'} eq 'movetype') { - $movetypes{$item->{'attr'}->{'name'}} = $item; - } -} - -foreach my $unit (@units) { - my $unitname = $unit->{'attr'}->{'id'}; - my $movetype = $unit->{'attr'}->{'movement_type'}; - $movetype = $movetypes{$movetype}; - - if($movetype) { - foreach my $item (@{$movetype->{'children'}}) { - &apply_unit_movetype($unit,$item); - } - } - - foreach my $item (@{$unit->{'children'}}) { - &apply_unit_movetype($unit,$item); - } -} - -sub apply_unit_movetype -{ - my ($unit,$mod) = @_; - my %attr = %{$mod->{'attr'}}; - if($mod->{'name'} eq 'movement_costs') { - while(my ($name,$value) = each(%attr)) { - $unit->{'attr'}->{'move_' . $name} = $value; - } - } elsif($mod->{'name'} eq 'defense') { - while(my ($name,$value) = each(%attr)) { - $unit->{'attr'}->{'defense_' . $name} = $value; - } - } elsif($mod->{'name'} eq 'resistance') { - while(my ($name,$value) = each(%attr)) { - $unit->{'attr'}->{'resist_' . $name} = $value; - } - } -} - -foreach my $filter (@filter) { - my @new_units = (); - foreach my $unit (@units) { - my $res = &evaluate_expression($unit,$filter); - next unless $res; - my $pass = 1; - foreach my $item (@$res) { - unless($item) { - $pass = 0; - last; - } - } - - push @new_units, $unit if $pass; - } - - @units = @new_units; -} - -foreach my $sortby (@sortby) { - @units = sort { -my ($resa,$resb) = (&evaluate_expression($a,$sortby), - &evaluate_expression($b,$sortby)); -return 0 unless $resa or $resb; -return -1 unless $resa; -return 1 unless $resb; -while(@$resa or @$resb) { - my ($itema,$itemb) = (shift @$resa,shift @$resb); - my $res = &compare_values($itema,$itemb); - return $res if $res; -} -return 0; -} @units; -} - -my $nfields = 0; -foreach my $unit (@units) { - my $res = &evaluate_expression($unit,"$expression"); - push @results, $res; - $nfields = scalar(@$res) if scalar(@$res) > $nfields; -} - -foreach my $fold (@fold) { - my @row = (); - for my $index ( 0 .. $nfields) { - my @items = (); - foreach my $res (@results) { - if($index < scalar(@$res)) { - push @items, $res->[$index]; - } else { - push @items, ''; - } - } - - push @row, eval "$fold"; - } - - push @results, \@row; -} - -unshift @results, \@heading if @heading; - -my @cols = (0) x $columns; - -foreach my $result (@results) { - next unless $result; - my @items = @$result; - for(my $col = 0; $col != @items; ++$col) { - my $len = length $items[$col]; - $cols[$col] = $len if $len > $cols[$col]; - } -} - -while(@results) { - my $res = shift @results; - my $col = 0; - foreach my $field (@$res) { - print $field; - my $whitespace = ' ' x (2 + $cols[$col] - (length $field)); - print $whitespace; - ++$col; - } - - print "\n"; -} - -sub evaluate_expression -{ - my ($unit,$expression) = @_; - - my @attacks = (); - my @melee = (); - my @ranged = (); - - my ($attack_name,$attack_damage,$attack_strikes,$attack_type,$attack_range,$attack_special) = ('',0,0,'','',''); - my ($melee_name,$melee_damage,$melee_strikes,$melee_type,$melee_special) = ('',0,0,'','',''); - my ($ranged_name,$ranged_damage,$ranged_strikes,$ranged_type,$ranged_special) = ('',0,0,'',''); - - foreach my $attack (@{$unit->{'children'}}) { - next unless $attack->{'name'} eq 'attack'; - my %attr = %{$attack->{'attr'}}; - push @attacks, \%attr; - - my $power = $attr{'damage'}*$attr{'number'}; - - if($attr{'range'} eq 'short') { - if($power > $melee_damage*$melee_strikes) { - $melee_name = $attr{'name'}; - $melee_damage = $attr{'damage'}; - $melee_strikes = $attr{'number'}; - $melee_type = $attr{'type'}; - $melee_special = $attr{'special'}; - } - - push @melee, \%attr; - } else { - if($power > $ranged_damage*$ranged_strikes) { - $ranged_name = $attr{'name'}; - $ranged_damage = $attr{'damage'}; - $ranged_strikes = $attr{'number'}; - $ranged_type = $attr{'type'}; - $ranged_special = $attr{'special'}; - } - push @ranged, \%attr; - } - - if($power > $attack_damage*$attack_strikes) { - $attack_name = $attr{'name'}; - $attack_damage = $attr{'damage'}; - $attack_strikes = $attr{'number'}; - $attack_type = $attr{'type'}; - $attack_range = $attr{'range'}; - $attack_special = $attr{'special'}; - } - } - - my ($secondary_name,$secondary_damage,$secondary_strikes,$secondary_type,$secondary_special) = - ($melee_name,$melee_damage,$melee_strikes,$melee_type,$melee_special); - - - ($secondary_name,$secondary_damage,$secondary_strikes,$secondary_type,$secondary_special) = - ($ranged_name,$ranged_damage,$ranged_strikes,$ranged_type,$ranged_special) - if $attack_range eq 'short'; - - my $script = '{'; - - my %attr = %{$unit->{'attr'}}; - while(my ($key,$value) = each(%attr)) { - $value =~ s/[^\s\w\.\,\-\:\;]//g; - $$key = $value; - } - - foreach my $where (@where) { - $script .= "$where;"; - } - - $script .= "\[$expression\]\}"; - - my $result = eval($script); - while(my ($key,$value) = each(%attr)) { - $$key = ''; - } - - return $result; -} - -sub compare_values -{ - my ($a,$b) = @_; - return $a <=> $b if $a =~ /^[-\d\.]+$/ and $b =~ /^[-\d\.]+$/; - return $a cmp $b; -} diff --git a/utils/update_unit_tree b/utils/update_unit_tree deleted file mode 100755 index 9713b5dc23d..00000000000 --- a/utils/update_unit_tree +++ /dev/null @@ -1,63 +0,0 @@ -#!/bin/sh -# -# Make a local copy of the HTML unit tree. -# Meant to be run on the wesnoth server site. - -if [ $# -ne 1 ]; then - echo "Syntax: $0 " - exit 1 -fi - -VERSION=$1 -SITE=$HOME/html/units -SOURCE=$HOME/source - -if ! [ -d $SOURCE ]; then - echo "'$SOURCE' not found." - exit 1 -fi - -BRANCH=Development -case $VERSION in - 1.2 ) cd $SOURCE/1.2 || exit 1 - BRANCH=Stable - ;; - 1.3.* ) cd $SOURCE/trunk || exit 1 - ;; - 1.4 ) cd $SOURCE/1.4 || exit 1 - BRANCH=Stable - ;; - trunk ) cd $SOURCE/trunk || exit 1 - ;; - * ) echo "Unknown version." - exit 1 - ;; -esac -if [ -d $SITE/$VERSION ] && [ "$BRANCH" != "Stable" ] && [ "$VERSION" != "trunk" ]; then - echo "'$SITE/$VERSION' already exists." - exit 1 -fi -#echo 'svn update...' -#svn update -#svn status -if [ "$VERSION" = "trunk"]; then - data/tools/wmlunits -d data/ -o $SITE/temp || exit 1 - rm -rf $SITE/$VERSION - # move the generated files to their proper place - mv $SITE/temp $SITE/$VERSION -else - cd data/tools/unit_tree/ || exit 1 - # make sure we update with the right version - sed -i -e "s/\(my \$version = '\).*\(';\)/\1$VERSION\2/" units.pl - ./units.pl || exit 1 - rm -rf $SITE/$VERSION - # move the generated files to their proper place - mv files $SITE/$VERSION - cp -p templates/units.css $SITE/$VERSION - # revert to prevent future conflicts if $version changed - svn revert units.pl -fi -if [ "$VERSION" != "trunk" ] && ! [ $(grep "

$VERSION ($BRANCH)

" $SITE/index.html) ]; then - # insert a link for the new version - sed -i -e "s,\(

Trunk

\),\1\n

$VERSION ($BRANCH)

," $SITE/index.html -fi diff --git a/utils/weblist.pl b/utils/weblist.pl deleted file mode 100755 index 8b8ad66af65..00000000000 --- a/utils/weblist.pl +++ /dev/null @@ -1,272 +0,0 @@ -#!/usr/bin/perl - -use wml; -use wml_net; -use CGI qw/:standard -no_xhtml/; -use Time::gmtime; -use strict; - -my ($host,$port) = ('add-ons.wesnoth.org', 15002); - -my $style = 'http://www.wesnoth.org/mw/skins/glamdrol/main.css'; - -my $socket = eval {&wml_net::connect($host,$port)}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -if (!defined($socket)) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error connecting to the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Error connecting to the campaign server.'), end_html; - exit; -} - -eval { - &wml_net::write_packet($socket,&wml::read_text(' -[request_campaign_list] -[/request_campaign_list]')); -}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -my $response = eval {&wml_net::read_packet($socket)}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -if (!defined($response)) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Error accessing the campaign server.'), end_html; - exit; -} - -if (my $error = &wml::has_child($response, 'error')) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p($error->{'attr'}->{'message'}), end_html; - exit; -} - -my $campaign_list = &wml::has_child($response, 'campaigns'); -if (!$campaign_list) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error retrieving campaign list.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('No', em('campaigns'), 'data returned.'), end_html; - exit; -} - -print header, start_html(-style=>{'src'=>$style}, - -title=>'Wesnoth campaigns available for download.'); - -print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - -my @campaigns = &wml::get_children($campaign_list,'campaign'); - -my $myurl = url(-relative=>1); - -my $sort = 'timestamp_down'; -if (defined(param('sort'))) { - if (scalar(@{[param('sort')]}) != 1) { - print p('Mutplie sort columns ignored.'); - } - else { - $sort = param('sort'); - } -} - -my $title_sort = 'title_up'; -my $version_sort = 'version_down'; -my $author_sort = 'author_up'; -my $timestamp_sort = 'timestamp_down'; -my $size_sort = 'size_up'; -my $downloads_sort = 'downloads_down'; -$title_sort = 'title_down' if $sort eq 'title_up'; -$version_sort = 'version_up' if $sort eq 'version_down'; -$author_sort = 'author_down' if $sort eq 'author_up'; -$timestamp_sort = 'timestamp_up' if $sort eq 'timestamp_down'; -$size_sort = 'size_down' if $sort eq 'size_up'; -$downloads_sort = 'downloads_up' if $sort eq 'downloads_down'; - -print p('Windows users may want to install', - a({href=>'http://www.7-zip.org/'}, '7-zip'), - "to handle tar gzipped archives (campaign downloads are in this format).", - 'This is a', a({href=>'http://www.debian.org/intro/free'}, 'free'), - 'and zero cost program that will handle a variety of archive formats.'); -print p('Column headings are linked to alternate sort orders.'); -print p('Campaign titles are linked to tar gzipped archives of the respective campaigns.'); -print p('The downloaded campaign archives should be extracted in ~/.wesnoth/data/campaigns/ on *nix systems.', - a({href=>'mailto:bruno@wolff.to'}, 'I'), - 'would appreciate people telling me what the corresponding directory is for other operating systems.'); - -my @rows = (); -foreach my $campaign (@campaigns) { - foreach my $field ('icon', 'name', 'title', 'version', 'author', 'timestamp', - 'description', 'size', 'downloads') { - $campaign->{'attr'}->{$field} =~ s/\001[^\003]*\003//g; - $campaign->{'attr'}->{$field} =~ s/[\001-\037\177-\237]/ /g; - } - $campaign->{'attr'}->{'name'} =~ s;\s|/|\\;;g; - my $title = $campaign->{'attr'}->{'name'}; - $title =~ s/_/ /g; - $campaign->{'attr'}->{'title'} = $title - if $campaign->{'attr'}->{'title'} =~ m/^\s*$/; -} - -my @sorted = (); -if ($sort eq 'title_down') { - @sorted = sort {uc($b->{'attr'}->{'title'}) cmp uc($a->{'attr'}->{'title'})} - @campaigns; -} -elsif ($sort eq 'title_up') { - @sorted = sort {uc($a->{'attr'}->{'title'}) cmp uc($b->{'attr'}->{'title'})} - @campaigns; -} -elsif ($sort eq 'version_down') { - @sorted = sort {uc($b->{'attr'}->{'version'}) cmp uc($a->{'attr'}->{'version'})} - @campaigns; -} -elsif ($sort eq 'version_up') { - @sorted = sort {uc($a->{'attr'}->{'version'}) cmp uc($b->{'attr'}->{'version'})} - @campaigns; -} -elsif ($sort eq 'author_down') { - @sorted = sort {uc($b->{'attr'}->{'author'}) cmp uc($a->{'attr'}->{'author'})} - @campaigns; -} -elsif ($sort eq 'author_up') { - @sorted = sort {uc($a->{'attr'}->{'author'}) cmp uc($b->{'attr'}->{'author'})} - @campaigns; -} -elsif ($sort eq 'timestamp_down') { - @sorted = sort {$b->{'attr'}->{'timestamp'} <=> $a->{'attr'}->{'timestamp'}} - @campaigns; -} -elsif ($sort eq 'timestamp_up') { - @sorted = sort {$a->{'attr'}->{'timestamp'} <=> $b->{'attr'}->{'timestamp'}} - @campaigns; -} -elsif ($sort eq 'size_down') { - @sorted = sort {$b->{'attr'}->{'size'} <=> $a->{'attr'}->{'size'}} - @campaigns; -} -elsif ($sort eq 'size_up') { - @sorted = sort {$a->{'attr'}->{'size'} <=> $b->{'attr'}->{'size'}} - @campaigns; -} -elsif ($sort eq 'downloads_down') { - @sorted = sort {$b->{'attr'}->{'downloads'} <=> $a->{'attr'}->{'downloads'}} - @campaigns; -} -elsif ($sort eq 'downloads_up') { - @sorted = sort {$a->{'attr'}->{'downloads'} <=> $b->{'attr'}->{'downloads'}} - @campaigns; -} -else { - @sorted = @campaigns; -} - -foreach my $campaign (@sorted) { - my @row = (); - my $iname = $campaign->{'attr'}->{'icon'}; - if ($iname !~ m/^\s*$/) { - $iname =~ s;^.*(/|\\);;; - $iname =~ s/\..*$//; - $iname =~ s/-|_/ /g; - push @row, img({src=>'images/'.$campaign->{'attr'}->{'icon'}, - alt=>$iname}); - } - else { - push @row, 'No icon provided'; - } - push @row, a({href=>($campaign->{'attr'}->{'name'}).'.tgz'}, - escapeHTML($campaign->{'attr'}->{'title'})); - push @row, escapeHTML($campaign->{'attr'}->{'version'}); - my $trans = ''; - my $first = 1; - my $last = ''; - my @lang = &wml::get_children($campaign,'translation'); - foreach my $lang (sort {$a->{'attr'}->{'language'} cmp - $b->{'attr'}->{'language'}} @lang) { - if (!$first) { - $first = 0; - $trans = $lang->{'attr'}->{'language'}; - $last = $trans; - } - else { - $trans .= ' '; - if ($last ne $lang->{'attr'}->{'language'}) { - $trans .= $lang->{'attr'}->{'language'}; - $last = $lang->{'attr'}->{'language'}; - } - } - } - $trans =~ s/\001[^\003]*\003//g; - $trans =~ s/[\001-\037\177-\237]/ /g; - push @row, escapeHTML($trans); - push @row, escapeHTML($campaign->{'attr'}->{'author'}); - if ($campaign->{'attr'}->{'timestamp'} =~ m/^\d+$/) { - push @row, escapeHTML(gmctime($campaign->{'attr'}->{'timestamp'}) . ' GMT'); - } - else { - push @row, 'Unknown'; - } - push @row, escapeHTML($campaign->{'attr'}->{'description'}); - my $size = $campaign->{'attr'}->{'size'}; - $size += 512; - $size -= $size % 1024; - $size /= 1024; - push @row, escapeHTML("$size KiB"); - push @row, escapeHTML($campaign->{'attr'}->{'downloads'}); - push @rows, td(\@row); -} - -print table({frame=>'border',rules=>'all'}, - col, col({align=>'char'}), col, col, - thead(Tr(th(['Icon', - a({href=>$myurl . '?sort=' . $title_sort}, 'Title'), - a({href=>$myurl . '?sort=' . $version_sort}, 'Version'), - 'Translations', - a({href=>$myurl . '?sort=' . $author_sort}, 'Author'), - a({href=>$myurl . '?sort=' . $timestamp_sort}, 'Last Updated'), - 'Description', - a({href=>$myurl . '?sort=' . $size_sort}, 'Size'), - a({href=>$myurl . '?sort=' . $downloads_sort}, 'Downloads')]))), - tbody(Tr(\@rows)) - ); - -print end_html; diff --git a/utils/webtgz.pl b/utils/webtgz.pl deleted file mode 100755 index 66beb16a982..00000000000 --- a/utils/webtgz.pl +++ /dev/null @@ -1,348 +0,0 @@ -#!/usr/bin/perl - -use wml; -use wml_net; -use Archive::Tar; -use CGI qw/:standard -no_xhtml/; -use strict; - -my ($host, $port) = ("add-ons.wesnoth.org", 15002); - -my $style = 'http://www.wesnoth.org/mw/skins/glamdrol/main.css'; - -my $socket = eval {&wml_net::connect($host,$port)}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -if (!defined($socket)) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error connecting to the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Error connecting to the campaign server.'), end_html; - exit; -} - -my $name = url(-relative=>1); -if ($name =~ m/^(.*)\.tgz$/) { - $name = $1; -} -else { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Invalid campaign name URL.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Campaigns are only available as gzipped tar archives (.tgz files).'), - end_html; - exit; -} - -if ($name =~ m/^\./) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Invalid campaign name.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(em($name), - 'is an invalid campaign name because it begins with a period.'), - end_html; - exit; -} - -if ($name =~ m;/;) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Invalid campaign name.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(em($name), - 'is an invalid campaign name because it contains a forward slash (/).'), - end_html; - exit; -} - -if ($name =~ m/^$/) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Invalid campaign name.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(em($name), - 'is an invalid campaign name because it is the empty string.'), - end_html; - exit; -} - -eval { - &wml_net::write_packet($socket,&wml::read_text(" -[request_campaign_list] -name=\"$name\" -[/request_campaign_list]")); -}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -my $response = eval {&wml_net::read_packet($socket)}; -if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; -} - -if (!defined($response)) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Error accessing the campaign server.'), end_html; - exit; -} - -if (my $error = &wml::has_child($response, 'error')) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($error->{'attr'}->{'message'})), end_html; - exit; -} - -my $campaign_list = &wml::has_child($response, 'campaigns'); -if (!$campaign_list) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error retrieving campaign list.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('No', em('campaigns'), 'data returned.'), end_html; - exit; -} - -my @campaigns = &wml::get_children($campaign_list,'campaign'); - -my $version = undef; -my $timestamp = ''; - -foreach my $campaign (@campaigns) { - foreach my $field ('name', 'version', 'timestamp') { - $campaign->{'attr'}->{$field} = '' - unless defined($campaign->{'attr'}->{$field}); - $campaign->{'attr'}->{$field} =~ s/\001[^\003]*\003//g; - $campaign->{'attr'}->{$field} =~ s/[\001-\037\177-\237]/ /g; - } - $campaign->{'attr'}->{'name'} =~ s;\s|/|\\;;g; - if ($name eq $campaign->{'attr'}->{'name'}) { - $version = $campaign->{'attr'}->{'version'}; - $timestamp = $campaign->{'attr'}->{'timestamp'}; - last; - } -} -undef @campaigns; -if (!defined($version)) { - unlink("version/$name.ver"); - unlink("tgz/$name.tgz"); - unlink("timestamp/$name.ver"); - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error retrieving campaign information.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('No information was retrievable for the campaign', em($name) . '.'), - end_html; - exit; -} - -my $cached = 1; -if (open(VERS, "; - $cached = 0 unless $vers eq $version; - close VERS; -} -else { - $cached = 0; -} -if (open(VERS, "; - $cached = 0 unless $ts eq $timestamp; - close VERS; -} -else { - $cached = 0; -} - -if (!$cached) { - unlink("version/$name.ver"); - unlink("tgz/$name.tgz"); - unlink("timestamp/$name.ver"); - - my $archive = Archive::Tar->new(); - - eval { - &wml_net::write_packet($socket, &wml::read_text(" -[request_campaign] -name=\"$name\" -[/request_campaign]")); - }; - if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; - } - - my $response = eval {&wml_net::read_packet($socket)}; - if ($@ ne '') { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Error accessing the campaign server.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($@)), end_html; - exit; - } - - if (!defined($response)) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Campaign server error while attempting to retrieve campaign.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Campaign server error while attempting to retrieve campaign.'), - end_html; - exit; - } - if (my $error = &wml::has_child($response, 'error')) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Campaign server error while attempting to retrieve campaign.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p(escapeHTML($error->{'attr'}->{'message'})), end_html; - exit; - } - $version = $response->{'attr'}->{'version'} - if defined($response->{'attr'}->{'version'}); - $timestamp = $response->{'attr'}->{'timestamp'} - if defined($response->{'attr'}->{'timestamp'}); - &archive_dir($archive, $response, ''); - $archive->write("tgz/$name.$$", 1); - if (!open(VERS, ">version/$name.$$")) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Unable to cache campaign.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Unable to cache campaign.'), - end_html; - exit; - } - print VERS $version; - close VERS; - if (!open(VERS, ">timestamp/$name.$$")) { - print header, start_html(-style=>{'src'=>$style}, - -title=>'Unable to cache campaign.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Unable to cache campaign.'), - end_html; - exit; - } - print VERS $timestamp; - close VERS; - rename "tgz/$name.$$", "tgz/$name.tgz"; - rename "version/$name.$$", "version/$name.ver"; - rename "timestamp/$name.$$", "timestamp/$name.ver"; - undef $archive; - undef $response; -} - -if (!open(TGZ, "{'src'=>$style}, - -title=>'Unable to read cached copy of the campaign.'); - print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'}, - img({alt=>'Wesnoth logo', - src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'})))); - print p('Unable to read cached copy of the campaign.'), - end_html; - exit; -} - -print "Content-Type: application/x-gzip\r\n", - "Content-disposition: attachment; filename=\"$name.tgz\"\r\n\r\n"; - -my $buf; -while (read(TGZ, $buf, 16384)) { - print $buf; -} - -exit; - -sub archive_dir -{ - my ($archive, $doc, $dest) = @_; - my $name = $doc->{'attr'}->{'name'}; - my $path; - if ($name ne '') { - if ($dest eq '') { - $path = $name; - } - else { - $path = "$dest/$name"; - } - } - else { - $path = $dest; - } - - foreach my $dir (&wml::get_children($doc, 'dir')) { - &archive_dir($archive, $dir, $path); - } - - foreach my $file (&wml::get_children($doc, 'file')) { - my $filename; - if ($path eq '') { - $filename = $file->{'attr'}->{'name'}; - } - else { - $filename = "$path/" . $file->{'attr'}->{'name'}; - } - my @contents = split(//, $file->{'attr'}->{'contents'}); - my $contents = ''; - while(@contents) { - my $char = shift @contents; - if (1 == ord $char) { - $char = chr(ord(shift @contents) - 1); - } - $contents .= $char; - } - - $archive->add_data($filename, $contents, - {'uname'=>'root', 'gname'=>'root', 'uid'=>0, 'gid'=>0, 'mode'=>0644}); - } -}