mirror of
https://github.com/wesnoth/wesnoth
synced 2024-09-22 21:10:02 +00:00
349 lines
11 KiB
Perl
Executable File
349 lines
11 KiB
Perl
Executable File
#!/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.');
|
|
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, "<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.');
|
|
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, "<tgz/$name.tgz")) {
|
|
print header, start_html(-style=>{'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});
|
|
}
|
|
}
|