mirror of
https://github.com/wesnoth/wesnoth
synced 2025-04-25 20:19:49 +00:00
62a11d4754
...instead of campaigns.wesnoth.org it will point to the same machine, just make it clear that there is more than only campaigns on the machine
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) = ("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, "<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});
|
|
}
|
|
}
|