관리-도구

편집 파일: upload.cgi

#!/usr/bin/perl
### XUpload PRO3.1
### SibSoft.net (May 2009)
use strict;
use lib '.';
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:standard/;
use XUploadConfig;
use File::Copy;
use HTML::Template;
use Fcntl ':flock';
use Socket;
use MIME::Base64;

my $IP = &GetIP;
my $start_time = time;

my ($mode) = $ENV{QUERY_STRING}=~/xmode=(\d+)/;
$mode||=1;
$c->{$_}=$c->{modes}->{$mode}->{$_} for keys %{$c->{modes}->{$mode}};

if($ENV{QUERY_STRING} =~ /^settings/)
{
   $c->{pass_required} = $c->{upload_password}&&1;
   print"Content-type: text/html\n\n";
   print"$_='$c->{$_}';" for qw(ext_allowed ext_not_allowed max_upload_files max_upload_size enable_file_descr pass_required email_required);
   print qq[if(\$('x_max_files'))\$('x_max_files').innerHTML = '$c->{max_upload_files}';];
   print qq[if(\$('x_max_size'))\$('x_max_size').innerHTML='$c->{max_upload_size}';];
   print q[if($('x_password')){$('x_password').style.display='block';}] if $c->{pass_required};
   print q[if($('x_folder')){$('x_folder').style.display='block';}] if $c->{allow_ext_folder};
   exit;
}

&logit("Starting upload. Size: $ENV{'CONTENT_LENGTH'}");
my ($sid) = ($ENV{QUERY_STRING}=~/upload_id=(\d+)/); # get the random id for temp files
$sid ||= join '', map int rand 10, 1..7;         # if client has no javascript, generate server-side
unless($sid=~/^\d+$/) # Checking for invalid IDs (hacker proof)
{
   &lmsg("ERROR: Invalid Upload ID");
   &xmessage("ERROR: Invalid Upload ID");
}
my $temp_dir = "$c->{temp_dir}/$sid";
my $mode = 0777;
mkdir $temp_dir, $mode;
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
{
   &logit('Upload stopped');
   &DelData($temp_dir);
   exit(0);
}

# Works on some systems only
#$SIG{HUP} = 'IGNORE';
#local $SIG{__DIE__} = 'CleanUp';

if($c->{referer_allowed} && $ENV{HTTP_REFERER} !~ /^http?:\/\/($c->{referer_allowed})/i)
{
   &lmsg("ERROR: bad referer");
   sleep 5;
   &DelData($temp_dir);
   &xmessage("ERROR: bad referer");
}

if($c->{ip_allowed} && $IP!~/$c->{ip_allowed}/)
{
   &lmsg("ERROR: $c->{msg}->{ip_not_allowed}");
   sleep 5;
   &DelData($temp_dir);
   &xmessage("ERROR: $c->{msg}->{ip_not_allowed}");
}

my ($upload_password) = ($ENV{QUERY_STRING}=~/\&xpass=(.+?)(&|$)/i);
if($c->{upload_password})
{
   require Digest::Perl::MD5;
   if($upload_password ne Digest::Perl::MD5::md5_base64($c->{upload_password}))
   {
      &lmsg("ERROR: $c->{msg}->{wrong_password}");
      sleep 3;
      &DelData($temp_dir);
      &xmessage("ERROR: $c->{msg}->{wrong_password}");
   }
}

if($ENV{'CONTENT_LENGTH'} > 1048576*$c->{max_upload_size})
{
   &lmsg("ERROR: $c->{msg}->{upload_size_big}$c->{max_upload_size} Mb");
   sleep 5;
   &DelData($temp_dir);
   &xmessage("ERROR: $c->{msg}->{upload_size_big}$c->{max_upload_size} Mb");
}
elsif($c->{min_upload_size} && $ENV{'CONTENT_LENGTH'} < 1048576*$c->{min_upload_size})
{
   &lmsg("ERROR: $c->{msg}->{upload_size_small}$c->{min_upload_size} Mb");
   sleep 5;
   &DelData($temp_dir);
   &xmessage("ERROR: $c->{msg}->{upload_size_small}$c->{min_upload_size} Mb");
}
else
{
   open FILE,">$temp_dir/flength";
   print FILE $ENV{'CONTENT_LENGTH'}."\n";
   close FILE;
   my $mode = 0777; chmod $mode,"$temp_dir/flength";
}

my ($fname_old,$current_bytes,$speed,$speed_old,$buff_old,$time,$time_spent,$total_old);
my ($old_size,$old_time);
my $files_uploaded = 0;
my $time_start = $old_time = time;

my $cg = CGI->new(\&hook);

#########################
sub hook
{
  my ($fname, $buffer) = @_;

my $buff_size = length($buffer);
  $current_bytes+=$buff_size;
  $time = time;
  
  my $file_done;
  if($fname_old ne $fname || $buff_old<$buff_size)
  {
     $files_uploaded++ if $fname_old;
     $fname_old=$fname;
     my $fsize = $current_bytes-$total_old;
     $total_old=$current_bytes;
     $file_done="file_uploaded:$files_uploaded:$fsize\n";
  }
  $buff_old = $buff_size;

if($time>$old_time || $file_done)
  {
     my $speed_now = $time==$old_time ? 0 : ($current_bytes-$old_size)/($time-$old_time);
     $speed = sprintf("%.0f", $old_size ? ($speed_old + $speed_now)/2 : $speed_now );
     $speed_old = $speed_now;
     $old_size = $current_bytes;
     $old_time = $time;

open F,"$temp_dir/flength";
     my @arr = <F>;
     close F;
     push @arr, $file_done if $file_done;

$time_spent = $time - $time_start;
     $arr[0] = "$ENV{CONTENT_LENGTH}:$current_bytes:$time_spent:$speed:$files_uploaded\n";
   
     open F,"+< $temp_dir/flength" or die"Can't open flength";
     flock F, LOCK_EX or die"Can't lock flength";
     truncate F, 0;
     print F @arr;
     close F;
  }
}
#########################

$files_uploaded++;
my $fsize = $current_bytes-$total_old;
open F,">>$temp_dir/flength" or die"Can't open flength";
flock F, LOCK_EX or die"Can't lock flength";
print F "file_uploaded:$files_uploaded:$fsize\n";
close F;

my (@fileslots,@filenames,@file_status);
my $ext_folder = $cg->param('ext_folder');
$ext_folder='' if $ext_folder=~/\.\./;
$c->{target_dir}.= "/$ext_folder" if $ext_folder && $c->{allow_ext_folder};
unless(-d $c->{target_dir})
{
   my $mode = 0777;
   mkdir($c->{target_dir},$mode);
   chmod $mode,$c->{target_dir};
}

&lmsg("UPLOADED\n");
&lmsg("MSG: Upload complete. Saving files...");
select(undef, undef, undef,0.2);

my ($files_saved,@files);

for my $k ( $cg->param() )
{
   next unless my $u=$cg->upload($k);
   
   my ($filename)=$cg->uploadInfo($u)->{'Content-Disposition'}=~/filename="(.+?)"/i;
   $filename=~s/^.*\\([^\\]*)$/$1/;

my $fhash;
   $fhash->{field_name}=$k;
   $fhash->{file_name_orig} = $filename;
   $fhash->{file_descr} = $cg->param("$k\_descr");
   $fhash->{file_mime}  = $cg->uploadInfo($u)->{'Content-Type'};

if($c->{extract_zip_archives} && $filename=~/\.zip$/i)
   {
      require Archive::Zip;
      require File::Find;
      require File::Path;
      my $zip = Archive::Zip->new();
      my $zipName = $cg->tmpFileName($u);
      my $status = $zip->read( $zipName );
      die "Read of $zipName failed\n" if $status != $Archive::Zip::AZ_OK;
      my $mode = 0777;
      my $tdir = "$c->{temp_dir}/$sid/1/";
      mkdir $tdir, $mode;
      chmod $mode,$tdir;
      $zip->extractTree('',$tdir);
      File::Find::find(\&wanted, $tdir);
      my $ii;
      sub wanted
      {
         push @files, &SaveFile( $File::Find::name, $c->{target_dir}, {field_name=>"$fhash->{field_name}_".$ii++,file_name_orig=>$_} ) if -f $File::Find::name;
      }
      File::Path::rmtree( $tdir );
   }
   else
   {
      push @files, &SaveFile( $cg->tmpFileName($u), $c->{target_dir}, $fhash );
   }
      
}

if($#files==-1)
{
   &lmsg("ERROR: No files uploaded");
   sleep 2;
   &DelData($temp_dir);
   &xmessage("ERROR: No files uploaded");
}

##########################################
sub SaveFile
{
   my ($temp,$dir,$fhash) = @_;

$fhash->{file_size} = -s $temp;
   $fhash->{file_size2} = sprintf("%.2f",$fhash->{file_size}/1048576)." Mbytes ($fhash->{file_size} bytes)";
   my ($fn,$ext) = $fhash->{file_name_orig}=~/^(.+)\.(.+)$/;
   $fn=$fhash->{file_name_orig} unless $fhash->{file_name_orig}=~/\./;
   $fn=~s/[^$c->{filename_rename_mask}]//ge if $c->{filename_rename_mask};
   $fn = substr($fn,0,$c->{max_name_length});

if($c->{randon_filename})
   {
   	$fn=randchar(12);
   	$fn=randchar(12) while (-e "$c->{target_dir}/$fn.$ext");
   }

if($fhash->{file_size}==0)
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{null_filesize});
      $fhash->{file_status}="null filesize or wrong file path";
      return $fhash;
   }

if($fhash->{file_size} < $c->{min_upload_filesize}*1048576)
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{file_size_small});
      $fhash->{file_status}="filesize too small";
      return $fhash;
   }

if($fhash->{file_size} > $c->{max_upload_filesize}*1048576)
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{file_size_big});
      $fhash->{file_status}="filesize too big";
      return $fhash;
   }

if($c->{filaname_mask} && $fn !~ /$c->{filaname_mask}/)
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{bad_filename});
      $fhash->{file_status}="unallowed filename";
      return $fhash;
   }

if( ($c->{ext_allowed} && $ext!~/^$c->{ext_allowed}$/i) || ($c->{ext_not_allowed} && $ext=~/^$c->{ext_not_allowed}$/i) )
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{bad_extension});
      $fhash->{file_status}="unallowed extension";
      return $fhash;
   }

if($files_saved==$c->{max_upload_files})
   {
      &lmsg("MSG:$fhash->{file_name_orig} ".$c->{msg}->{too_many_files});
      $fhash->{file_status}="too many files";
      return $fhash;
   }

$ext=".$ext" if $ext;
   if(-e "$c->{target_dir}/$fn$ext" && $c->{copy_mode} eq 'Rename')
   {
      my $i;
      $i++ while -e "$c->{target_dir}/$fn$i$ext";
      $fhash->{file_status}="renamed";
      &lmsg("MSG:'$fn$ext' ".$c->{msg}->{already_exist}." '$fn$i$ext'.");
      $fn.=$i;
   }

$fhash->{file_name}="$fn$ext";

if(-e "$c->{target_dir}/$fhash->{file_name}" && $c->{copy_mode} eq 'Warn')
   {
      &lmsg("MSG:File $fhash->{file_name} already exist! New file wasn't saved.");
      $fhash->{file_status}="error:filename already exist";
      $fhash->{file_name}="";
      return $fhash;
   }

move($temp,"$dir/$fhash->{file_name}") || copy($temp,"$dir/$fhash->{file_name}") || xmessage("Fatal Error: Can't copy file from temp dir ($!)");
   my $mode = 0666;
   chmod $mode,"$dir/$fhash->{file_name}";

&lmsg("MSG:'$fhash->{file_name}' ".$c->{msg}->{saved_ok});
   $files_saved++;
   $fhash->{file_status}||='OK';

return $fhash;
}
##########################################

&lmsg("MSG:".$c->{msg}->{transfer_complete});

# Generate parameters array for E-mail/POST
my @har;
push @har, { name=>'number_of_files', value=>scalar(@files),   'style'=>2 };
push @har, { name=>'ip',              value=>$IP,              'style'=>2 };
push @har, { name=>'host',            value=>&getRemoteHost($IP),'style'=>2 };
push @har, { name=>'duration',        value=>(time-$start_time).' seconds', 'style'=>2 };

for my $k ($cg->param)
{
   next unless $k;
   for my $p ($cg->param($k))
   {
      next if ref $p eq 'Fh';
      next if $k =~ /(xmode|xpass|pbmode|ref|js_on|upload_id|css_name|tmpl_name|inline|upload_password|popup|file_\d)/i;
      push @har, { name=>$k, value=>$p, 'style'=>2 };
   }
}

### Send E-mail to Admin
if($c->{confirm_email})
{
   my @t = &getTime;
   my $tmpl = HTML::Template->new( filename => "Templates/confirm_email.html", die_on_bad_params => 0 );
   $tmpl->param('files'     => \@files,
                'params'    => \@har,
                'time'      => "$t[0]-$t[1]-$t[2] $t[3]:$t[4]:$t[5]",
                'total_size'=> "$ENV{CONTENT_LENGTH} bytes",
                'total_size_mb' => sprintf("%.1f",$ENV{CONTENT_LENGTH}/1048576)." Mb",
               );
   my $subject = $c->{email_subject} || "XUpload: New file(s) uploaded";
   #&SendMail( $c->{confirm_email}, $c->{confirm_email_from}, $subject, $tmpl->output() );

require MIME::Lite;
   my $msg = MIME::Lite->new ( 
     From => $c->{confirm_email_from}, 
     To => $c->{confirm_email}, 
     Subject => $subject, 
     Type =>'multipart/mixed' 
   ) or die "Error creating multipart container: $!\n"; 
   $msg->attr("content-type.charset" => "UTF-8");
   
   $msg->attach(Type => 'text/html', Data => $tmpl->output ); 
   
   for(@files)
   {
      $msg->attach ( 
         Type => 'application/octet-stream', 
         Path => "$c->{target_dir}/$_->{file_name}", 
         Filename => $_->{file_name}, 
         Disposition => 'attachment' 
      ) if $c->{email_file_attach};
   }
   $msg->send;
}

### Send E-mail to Uploader
if($cg->param('email_notification'))
{
   &lmsg("MSG: ".$c->{msg}->{send_email_note});
   my @t = &getTime;
   my $tmpl = HTML::Template->new( filename => "Templates/confirm_email_user.html", die_on_bad_params => 0 );
   $tmpl->param('files'        => \@files,
                'time'          => "$t[0]-$t[1]-$t[2] $t[3]:$t[4]:$t[5]",
                'total_size'    => "$ENV{CONTENT_LENGTH} bytes",
                'total_size_mb' => sprintf("%.1f",$ENV{CONTENT_LENGTH}/1048576)." Mb",
               );
   my $subject = $c->{email_subject} || "XUpload: File upload confirmation";
   &SendMail( $cg->param('email_notification'), $c->{confirm_email_from}, $subject, $tmpl->output );
}

&DeleteExpiredFiles( $c->{temp_dir}, 86400 );
&DeleteExpiredFiles( $c->{target_dir}, 86400*$c->{uploaded_files_lifetime} );

&lmsg("DONE\n");
sleep 1; # Small pause to sync messages with pop-up

&DelData($temp_dir);

### Sending data with POST request if need
my $url_post = $c->{url_post} || $ENV{HTTP_REFERER};
if($url_post)
{
   if($url_post=~/\.htm(l|)$/i)
   {
      print"Content-type: text/html\n\n";
      print"<HTML><HEAD><Script>parent.document.location='$url_post'</Script></HEAD></HTML>";
      exit;
   }
   my @file_fields = qw(file_name file_name_orig file_status file_size file_descr file_mime);
   if($ENV{QUERY_STRING}!~/js_on=1/)
   {
     $url_post.='?';
     $url_post.="\&$_->{name}=$_->{value}" for @har;
     for my $f (@files)
     {
        $url_post.="\&$_\[]=$f->{$_}" for @file_fields;
        #print"<textarea name='$_\[]'>$f->{$_}</textarea>" for @file_fields;
     }
     print $cg->redirect( $url_post );
     exit;
   }
   print"Content-type: text/html; charset=UTF-8\n\n";
   print qq{<HTML><HEAD><meta http-equiv="Content-Type" content="text/html;charset=UTF-8"></HEAD><BODY><Form name='F1' action='$url_post' target='_parent' method='POST'>};
   for my $f (@files)
   {
       print"<textarea name='$_\[]'>$f->{$_}</textarea>" for @file_fields;
   }
   print"<textarea name='$_->{name}'>$_->{value}</textarea>" for @har;
   print"</Form><Script>document.location='javascript:false';document.F1.submit();</Script></BODY></HTML>";
   exit;
}

print"Content-type: text/html\n\n";
print"Upload complete.";

exit;

#############################################

sub DeleteExpiredFiles
{
   my ($dir,$lifetime) = @_;
   return unless $lifetime;
   opendir(DIR, $dir) || &xmessage("Fatal Error: Can't opendir temporary folder ($!)");
   foreach my $fn (readdir(DIR))
   {
      next if $fn =~ /^\./;
      my $file = $dir.'/'.$fn;
      my $ftime = (lstat($file))[9];
      next if (time - $ftime) < $lifetime;
      -d $file ? &DelData($file) : unlink($file);
   }
   closedir(DIR);
}

sub DelData
{
   my ($dir) = @_;
   $cg->DESTROY if $cg; # WIN: unlock all files
   return unless -d $dir;
   opendir(DIR, $dir) || return;
   unlink("$dir/$_") for readdir(DIR);
   closedir(DIR);
   rmdir("$dir");
}

sub xmessage
{
   my ($msg) = @_;
   $msg=~s/'/\\'/g;
   $msg=~s/<br>/\\n/g;
   print"Content-type: text/html\n\n";
   print"<HTML><HEAD><Script>alert('$msg');</Script></HEAD><BODY><b>$msg</b></BODY></HTML>";
   exit;
}

sub lmsg
{
   my $msg = shift;
   open(FILE,">>$temp_dir/flength");
   print FILE $msg."\n";
   close FILE;
   &logit($msg);
}

sub logit
{
   my $msg = shift;
   return unless $c->{uploads_log};
   my @t = &getTime;
   open(FILE,">>$c->{uploads_log}") || xmessage("Fatal Error: Can't open log file");
   print FILE $IP." $t[0]-$t[1]-$t[2] $t[3]:$t[4]:$t[5] $msg\n";
   close FILE;
}

sub getTime
{
    my @t = localtime();
    return ( sprintf("%04d",$t[5]+1900),
             sprintf("%02d",$t[4]+1), 
             sprintf("%02d",$t[3]), 
             sprintf("%02d",$t[2]), 
             sprintf("%02d",$t[1]), 
             sprintf("%02d",$t[0]) 
           );
}

sub getRemoteHost
{
   return $ENV{'REMOTE_HOST'} || gethostbyaddr(inet_aton(shift), AF_INET);
}

sub GetIP
{
   return $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR};
}

sub randchar
{ 
   my @range = ('0'..'9');
   my $x = int scalar @range;
   join '', map $range[rand $x], 1..shift||1;
}

sub SendMail
{
my ($mail_to, $mail_from, $subject, $body) = @_;

open (OUTMAIL,"|".$c->{sendmail_path} ." -t") || return;
$subject = '=?UTF-8?B?'.encode_base64($subject);
chomp($subject);
$subject.='?=';
print OUTMAIL <<EOM;
To:   $mail_to
From: $mail_from
Subject: $subject
Content-Type: text/html; charset=UTF-8

$body
.
EOM
;
close OUTMAIL;
}

sub SendMail1
{
my ($mail_to, $mail_from, $subject, $body) = @_;  
open (OUTMAIL,"|".$c->{sendmail_path} ." -t") || return "Can't open Unix Sendmail:".$!;
print OUTMAIL <<EOM;
To:   $mail_to
From: $mail_from
Subject: $subject
Content-Type: text/html; charset=utf-8

$body
.
EOM
;
close OUTMAIL;
}