#!/usr/local/bin/perl -w
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Cookies;
use HTTP::Headers;
use File::Find;
use File::stat;
use Fcntl qw/:flock :DEFAULT/;
$ENV{'SERVER_ADMIN'} = "dennis100\@webtv.net";
print "Content-type: text/html\n\n";
BEGIN {
$ENV{PATH} = "/usr/bin:/bin:/usr/local/bin";
use CGI::Carp qw(carpout);
sysopen(LOG, "zipper-log.txt", O_WRONLY | O_APPEND);
flock(LOG, LOCK_EX) or die "Cannot get a LOCK on data file: $!";
carpout(*LOG);
}
my $dir = "zipped";
opendir(DIR, $dir) || die "can't opendir $dir: $!";
my @dirs = grep { /^(\d{4})$/
&& -d "$dir/$_" } readdir(DIR); closedir DIR;
foreach my $f (@dirs) {
$f =~ /^(\d{4})$/ or die "$f is tainted: $! \n";
$f = $1;
my $age = time() - 48*3600;
my $stats = stat("$dir/$f") or die "Can't stat: $!";
if ( $stats->mtime < $age ) {
system("rm", "-r", "$dir/$f");
};
};
if ($ENV{REQUEST_METHOD} ne "POST")
{
print <WebZip Z I P P E R
EOL
### Check Directory Size before allowing file
## If this DIRECTORY is over 20 Megs, disallow and abort
use File::Find;
my $dirsize = 0;
my $path = '/home/public_html/';
find (sub {$dirsize += -s ;}, $path);
if ($dirsize > 20*1024*1000)
{ print "
Sorry, but the Work Directory is FULL right
now. Please try using WebZip's ZIPPER again later. Thank You.
Copyright 12-1-2001 by
whataman\@home.com /
dennis100\@webtv.net
Type or Paste one or more URLs that you want to zip into the box below. Separate each URL with a space. Do not end any URL with a slash or .zip. This will not zip directories, unless you put each absolute (full) URL into the box.
";
print $q->end_form;
my $counter = 'zip-counter.txt';
sysopen(COUNT, $counter, O_RDWR|O_CREAT)
or die "Can't OPEN data file for READING and WRITING: $!";
flock(COUNT, LOCK_EX) or die "Cannot get
an EXCLUSIVE LOCK on data file: $!";
my $num = || 0;
chomp $num;
$num++;
seek(COUNT, 0, 0) or die "can't REWIND to
beginning of data file: $!";
truncate(COUNT, 0) or die "can't TRUNCATE data file: $!";
print COUNT "$num\n";
## Take out the line below if you don't
## want commas in your numbers.
1 while $num =~ s/(.*\d)(\d\d\d)/$1,$2/;
close COUNT or warn $!;
print <$num
EOL
} else {
print <ZIP RESULTS
EOL
### Define the variables
$url = param('url');
@url = split(" ", $url);
$rand = int(rand(9000) + 1000);
$dir = "zipped";
$tmpdir = "zipped/$rand";
$zipname = $rand . ".zip";
if ($url) { print STDERR "$url\n" }
else {die "ERROR: No URL's were entered.\n";
};
if ($url =~ /bomb|nude|whore|sex|porn|slut|puss|XXX/) { die "File Not allowed!\n";};
if ($url =~ /\.zip/) { die "File names cannot end in .zip. This tool is for zipping, NOT for unzipping .zip files\n"; };
if ($url =~ /^\.|$ENV{HTTP_HOST}/) { die "Oops! You can't do that\n"; };
### Check types and allowable chars in URLs
while (<@url>) {
if ( ($_ =~ /\/$/) || ($_ !~ /^(ftp|http)/) )
{ die "ERROR: $_ is an Illegal URL. Filenames must start with either http:// or ftp:/\n"; }
}
### Check the File SIZES before allowing
### If all of the FILES are over 500K, disallow and abort
$ua = new LWP::UserAgent;
foreach $url(@url) {
my $expected_length;
$bytes_received++;
$ua->request(HTTP::Request->new('GET', $url),
sub {
my($chunk, $res) = @_;
$bytes_received += length($chunk);
unless (defined $expected_length) {
$expected_length = $res->content_length || 0;
}
});
}
if ($bytes_received > 500*1000) {
die "Your URLs add up to $bytes_received bytes. Sorry, but only a Total Size of 500K is allowed for all files.\n";
};
mkdir $tmpdir, 0755 or die "Cant make $tmpdir: $!\n";
### This is where we grab the URLs and store them in $file
while(<@url>) {
$url = $_;
($file = $url) =~ s/^.*?\/([^\/]*?)$/$1/;
## This is where we grab all of the URLs and
## store all the files into the tmpdir directory
my ($err_msg, $data) = &bypass($url);
if ($err_msg) {
print "$err_msg
$url \n"; exit;
}
elsif (open(TFILE, ">$tmpdir/$file")) {
print TFILE $data;
close(TFILE); }
else {print "Error: could not saved retrieved data - $!.\n";
exit }
sub bypass {
my ($url) = @_;
my $data = '';
my $err_msg = '';
Err: {
my $url_data = $url;
my $url_html = $url;
my $request = ();
my $response = ();
# Make initial request to the first page. This makes things
# "look good" to any smart observers on the far side. We also
# catch the first cookie and persist it:
my $ua = new LWP::UserAgent;
my $headers = new HTTP::Headers;
my $cookie_jar = new HTTP::Cookies;
# Simulate IE 5.5 browser:
$ua->agent( 'Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)' );
$headers->header(
'HTTP_ACCEPT' => 'text/html', '*/*',
'HTTP_CONNECTION' => 'close',
);
$headers->referer($url);
# Request initial HTML page:
$request = new HTTP::Request( 'GET' => $url_html, $headers );
$response = $ua->request( $request);
$cookie_jar->extract_cookies( $response );
unless ($response->is_success()) {
$err_msg = $response->error_as_HTML();
next Err;
}
# Request follow-up page, using simulated REFERER and cookies:
$headers->header('HTTP_REFERER' => $url_html );
$request = new HTTP::Request('GET' => $url_data, $headers );
$cookie_jar->add_cookie_header( $request );
$response = $ua->request( $request );
$cookie_jar->extract_cookies( $response );
unless ($response->is_success()) {
$err_msg = $response->error_as_HTML();
next Err;
}
$data = $response->content();
last Err;
}
return ($err_msg, $data);
}
}
### Now we do the ZIPPING
$| = 1;
chdir $dir or die "cant change to 'zipped' directory: $!\n";
open(STDERR, ">/dev/null");
system(
"zip", "-qD9jr", "$zipname", "$rand",
"-x", "*.htaccess*",
"*.htpasswd*",
"*..*",
"*\.\.*",
"*.\.*",
"*.exe*",
"*~/*",
"*/home*",
"*/public_html*",
);
close STDERR;
chdir ".." or die "cant change back to HOME directory: $!\n";
&done;
print "";
}
### Completion message
sub done {
print <
WebZip has it's own transloader. Want to move your zipfile?
NOTE: A zip file must be transferred in BINARY mode. If you use the transloader below, it will be transferred correctly.
EOL
print <
EOL
}
END {
if (defined($zipname)) {
$now = time+7200;
utime $now, $now, "logs/zipper.txt";
utime $now, $now, "zipped/$zipname";
utime $now, $now, "zipper-log.txt";
utime $now, $now, "zip-counter.txt";
}
open STDERR, ">/dev/null";
if ( defined($tmpdir)) {
system("rm", "-r", $tmpdir),
}
close STDERR;
print LOG "\n";
close LOG;
open STDERR, ">/dev/null";
system("cp", "zipper-log.txt", "logs/zipper.txt");
close STDERR;
}