campaign server updated to keep track of upload time and to store overview...

...attributes in the campaign WML as well as the config WML, so that
when campaigns are downloaded the overview information is sure to
match the campaign.  The two web interface perl scripts have been
added to utils as weblist.pl and webtgz.pl.
This commit is contained in:
Bruno Wolff III 2005-10-07 18:26:28 +00:00
parent 74c3a827e0
commit 6cb07b52da
4 changed files with 512 additions and 2 deletions

View file

@ -30,6 +30,10 @@ SVN trunk:
* multiplayer game with "empty" as side no longer causes OOS (#4464)
* random map generator now uses island_size (#4458)
* various bug fixes and code cleanups
* campaign server
* Support new "timestamp" attribute
* Save persistent attributes in the campaign data
* utils: added weblist.pl and webtgz.pl web interface programs
Version 1.0rc1:
* language and i18n:

View file

@ -118,7 +118,7 @@ void campaign_server::run()
} else if(data.child("request_terms") != NULL) {
network::send_data(construct_message("All campaigns uploaded to this server must be licensed under the terms of the GNU General Public License (GPL). By uploading content to this server, you certify that you have the right to place the content under the conditions of the GPL, and choose to do so."),sock);
} else if(const config* upload = data.child("upload")) {
} else if(config* upload = data.child("upload")) {
config* campaign = campaigns().find_child("campaign","name",(*upload)["name"]);
if(campaign != NULL && (*campaign)["passphrase"] != (*upload)["passphrase"]) {
network::send_data(construct_error("The campaign already exists, and your passphrase was incorrect."),sock);
@ -141,10 +141,19 @@ void campaign_server::run()
if((*campaign)["downloads"].empty()) {
(*campaign)["downloads"] = "0";
}
(*campaign)["timestamp"] = lexical_cast<std::string>(time(NULL));
const config* const data = upload->child("data");
config* data = upload->child("data");
if(data != NULL) {
std::string filename = (*campaign)["filename"];
(*data)["title"] = (*campaign)["title"];
(*data)["name"] = (*campaign)["name"];
(*data)["filename"] = (*campaign)["name"];
(*data)["author"] = (*campaign)["author"];
(*data)["description"] = (*campaign)["description"];
(*data)["version"] = (*campaign)["version"];
(*data)["timestamp"] = (*campaign)["timestamp"];
(*data)["icon"] = (*campaign)["icon"];
{
scoped_ostream campaign_file = ostream_file(filename);
write_compressed(*campaign_file, *data);

220
utils/weblist.pl Executable file
View file

@ -0,0 +1,220 @@
#!/usr/bin/perl
use wml;
use wml_net;
use CGI qw/:standard -no_xhtml/;
use Time::gmtime;
use strict;
my ($host,$port) = ('campaigns.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.'),
p(escapeHTML($@)), end_html;
exit;
}
if (!defined($socket)) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Error connecting to the campaign server.'),
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.'),
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.'),
p(escapeHTML($@)), end_html;
exit;
}
if (!defined($response)) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Error accessing the campaign server.'),
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.'),
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.'),
p('No', em('campaigns'), 'data returned.'), end_html;
exit;
}
print header, start_html(-style=>{'src'=>$style},
-title=>'Wesnoth campaigns available for download.');
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'});
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'});
push @row, escapeHTML($campaign->{'attr'}->{'size'});
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'),
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;

277
utils/webtgz.pl Executable file
View file

@ -0,0 +1,277 @@
#!/usr/bin/perl
use wml;
use wml_net;
use Archive::Tar;
use CGI qw/:standard -no_xhtml/;
use strict;
my ($host, $port) = ("campaigns.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.'),
p(escapeHTML($@)), end_html;
exit;
}
if (!defined($socket)) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Error connecting to the campaign server.'),
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.'),
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.'),
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.'),
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.'),
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]
[/request_campaign_list]'));
};
if ($@ ne '') {
print header, start_html(-style=>{'src'=>$style},
-title=>'Error accessing the campaign server.'),
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.'),
p(escapeHTML($@)), end_html;
exit;
}
if (!defined($response)) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Error accessing the campaign server.'),
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.'),
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.'),
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;
}
}
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.'),
p('No information was retrievable for the campaign', em($name) . '.'),
end_html;
exit;
}
my $cached = 1;
if (open(VERS, "<version/$name.ver")) {
my $vers = <VERS>;
$cached = 0 unless $vers eq $version;
close VERS;
}
else {
$cached = 0;
}
if (open(VERS, "<timestamp/$name.ver")) {
my $ts = <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.'),
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.'),
p(escapeHTML($@)), end_html;
exit;
}
if (!defined($response)) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Campaign server error while attempting to retrieve campaign.'),
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.'),
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.'),
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.'),
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";
}
if (!open(TGZ, "<tgz/$name.tgz")) {
print header, start_html(-style=>{'src'=>$style},
-title=>'Unable to read cached copy of the campaign.'),
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'};
}
$archive->add_data($filename, $file->{'attr'}->{'contents'},
{'uname'=>'root', 'gname'=>'root', 'uid'=>0, 'gid'=>0, 'mode'=>0644});
}
}