Новичок
Профиль
Группа: Участник
Сообщений: 40
Регистрация: 23.5.2005
Репутация: нет
Всего: 1
|
файл upload.cgi | Код |
#!/usr/bin/perl
use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:standard/;
use XUploadConfig;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $cont = $ua->get("http://test.com/test.php")->content; #тут все работает и файл читается
if ($cont eq '12345') #условие тоже выполняется
{
print redirect('http://ya.ru'); # а вот это и НЕ РАБОТАЕТ
exit;
}
$CGI::POST_MAX = 1024 * $c->{max_upload_size}; # set max Total upload size
my $sid = (split(/[&=]/,$ENV{QUERY_STRING}))[1]; # get the random id for temp files
$sid ||= join '', map int rand 10, 1..7; # if client has no javascript, generate server-side
&xmessage("Invalid Upload ID") unless $sid=~/^\d+$/; # Checking for invalid IDs
my $temp_dir = "$c->{temp_dir}/$sid";
mkdir $temp_dir;
my $mode = 0777;
chmod $mode,$temp_dir;
# Tell CGI.pm to use our directory based on sid
$CGITempFile::TMPDIRECTORY = $TempFile::TMPDIRECTORY = $temp_dir;
# Remove all files if user presses stop
sub CleanUp
{
&DelData($temp_dir);
exit(0);
}
$SIG{HUP} = 'IGNORE';
local $SIG{__DIE__} = 'CleanUp';
if($ENV{'CONTENT_LENGTH'} > 1024*$c->{max_upload_size})
{
&lmsg('ERROR: Maximum upload size exceeded<br>You should stop transfer right now');
sleep 1;
&DelData($temp_dir);
&xmessage("Maximum upload size exceeded");
}
else
{
open FILE,">$temp_dir/flength";
print FILE $ENV{'CONTENT_LENGTH'}."\n";
close FILE;
my $mode = 0777; chmod $mode,"$temp_dir/flength";
}
my $cg = new CGI;
if( $cg->cgi_error() )
{
&DelData($temp_dir);
&xmessage("ERROR: Maximum upload size exceeded");
}
my (@fileslots,@filenames,@file_status);
my @params = $cg->param;
for my $k ( keys %{$cg->{'.tmpfiles'}} )
{
$cg->{'.tmpfiles'}->{$k}->{info}->{'Content-Disposition'} =~ /name="(.+?)"; filename="(.+?)"/;
my ($field_name,$filename) = ($1,$2);
$filename =~ s/.*\\([^\\]*)$/$1/;
push @fileslots, $field_name;
push @filenames, $filename;
$filename=~ /(.+)\.(.+)/;
my ($fn,$ext) = ($1,$2);
if($ext !~ /^$c->{ext_allowed}$/i)
{
&lmsg("MSG:File $filename have unallowed extension!");
push @file_status, "unallowed extension";
next;
}
$fn = substr($fn,0,$c->{max_name_length});
my $i;
$i++ while (-e "$c->{target_dir}/$fn$i.$ext" && $c->{copy_mode} eq 'Rename');
$filename="$fn$i.$ext";
push @file_status, "OK. renamed to:$fn$i.$ext" if $i;
&lmsg("MSG:File '$fn.$ext' already exist!<br>New file saved as '$filename'.") if $i;
if(-e "$c->{target_dir}/$filename" && $c->{copy_mode} eq 'Warn')
{
&lmsg("MSG:File $filename already exist! New file wasn't saved.");
push @file_status, "error:filename already exist";
next;
}
&SaveFile2( ${$cg->{'.tmpfiles'}->{$k}->{name}}, $c->{target_dir}, $filename );
push @file_status, "OK" unless $i;
}
### Small pause to sync messages with pop-up
select(undef, undef, undef,0.1);
&DelData($temp_dir);
&DeleteOldTempFiles;
print"Content-type: text/html\n\n";
### Sending data with POST request if required
my $url_post = $cg->param('url_post');
$url_post ||= $c->{url_post};
if($url_post)
{
my ($str,@har);
for (0..$#fileslots)
{
push @har, { name=>$fileslots[$_], 'value'=>$filenames[$_] };
push @har, { name=>"$fileslots[$_]_status", 'value'=>$file_status[$_] };
}
for my $k (@params)
{
my @arr = $cg->param($k);
for my $p (@arr)
{
next if ref $p eq 'Fh'; #&& $p !~ /\.$c->{ext_allowed}$/i; # Skip unallowed files
$p =~ s/.*\\([^\\]*)$/$1/;
push @har, { name=>$k, value=>$p };
}
}
push @har, { name=>'target_dir', value=>$c->{target_dir} };
print"<HTML><BODY onLoad='document.F1.submit();'><Form name='F1' action='$url_post' target='_parent' method='POST'>";
print"<textarea name='$_->{name}'>$_->{value}</textarea>" for @har;
print"</Form></BODY></HTML>";
exit;
}
### Upload finished, redirecting
my $redirect_link = $cg->param('redirect_link');
$redirect_link ||= $c->{redirect_link};
print"<HTML><script>parent.document.location='$redirect_link';</Script></HTML>";
#############################################
sub DeleteOldTempFiles
{
my @ff;
opendir(DIR, $c->{temp_dir}) || &xmessage("Can't opendir temporary folder: $!");
@ff = readdir(DIR);
closedir(DIR);
foreach my $fn (@ff)
{
next if $fn =~ /^\.{1,2}$/;
my $file = $c->{temp_dir}.'/'.$fn;
my $ftime = (lstat($file))[9];
my $diff = time() - $ftime;
next if $diff < $c->{temp_files_lifetime};
-d $file ? &DelData($file) : unlink($file);
}
}
sub SaveFile2
{
my ($temp,$dir,$fname) = @_;
rename($temp,"$dir/$fname");
}
sub DelData
{
my ($dir) = @_;
opendir(DIR, $dir) || die"Error2";
my @ff = readdir(DIR);
closedir(DIR);
for my $fn(@ff)
{
unlink("$dir/$fn");
}
rmdir("$dir");
}
sub xmessage
{
my ($msg) = @_;
print"Content-type: text/html\n\n";
print"<HTML><BODY><b>$msg</b><br><input type='button' value='< Back' onclick='javascript:history.go(-1);'></BODY></HTML>";
exit;
}
sub lmsg
{
my ($msg) = @_;
open(FILE,">>$temp_dir/flength");
print FILE $msg."\n";
close FILE;
}
|
XUploadConfig | Код |
package XUploadConfig;
BEGIN
{
use Exporter;
@XUploadConfig::ISA = qw( Exporter );
@XUploadConfig::EXPORT = qw( $c );
}
our $c=
{
temp_dir => '/home/httpd/vhosts/sexyuni.com/cgi-bin/temp',
target_dir => '/home/httpd/vhosts/sexyuni.com/cgi-bin/uploads',
templates_dir => '/home/httpd/vhosts/sexyuni.com/httpdocs/Templates',
ext_allowed => 'jpg|jpeg|gif|png|rar|zip|mp3|avi|txt|csv|pdf',
url_post => 'http://www.test.com/cgi-bin/post.cgi',
redirect_link => 'http://www.test.com/upload_form.html',
max_name_length => 64,
copy_mode => 'Rename',
max_upload_size => 7000000000,
temp_files_lifetime => 86400,
};
1;
|
|
интересный вопрос: LWP! 
Загрузка ...
