#!/usr/bin/perl
### XUpload PRO2.3
### SibSoft.net (1 Nov 2006)
use strict;
use lib '.';
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:standard/;
use File::Copy;
use XUploadConfig;
use HTML::Template;
use Digest::Perl::MD5 qw(md5_base64);

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

#$CGI::close_upload_files = $CGI::CLOSE_UPLOAD_FILES = 1; #works for 1 file only (prob:reusing file handler)

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

$CGI::POST_MAX = 1024 * $c->{max_upload_size};   # set max Total upload size

if($ENV{QUERY_STRING}=~/mode=settings/)
{
   print"Content-type: text/html\n\n";
   my $pass_required = 1 if $c->{upload_password};
   print"var ext_allowed='$c->{ext_allowed}';var max_upload_files=$c->{max_upload_files};var max_upload_size=".sprintf("%.1f",$c->{max_upload_size}/1024).";var descr_mode=$c->{enable_file_descr};var pass_required='$pass_required';var email_required='$c->{email_required}';";
   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
{
   &DelData($temp_dir);
   exit(0);
}
#$SIG{HUP} = 'IGNORE';
local $SIG{__DIE__} = 'CleanUp';

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

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

if($ENV{'CONTENT_LENGTH'} > 1024*$c->{max_upload_size})
{
   &lmsg("ERROR: $c->{msg}->{filesize_exceeded}$c->{max_upload_size} Kb");
   sleep 1;
   &DelData($temp_dir);
   &xmessage("ERROR: $c->{msg}->{filesize_exceeded}$c->{max_upload_size} Kb");
}
elsif($c->{min_upload_size} && $ENV{'CONTENT_LENGTH'} < 1024*$c->{min_upload_size})
{
   &lmsg("ERROR: $c->{msg}->{filesize_min_exceeded}$c->{min_upload_size} Kb");
   sleep 1;
   &DelData($temp_dir);
   &xmessage("ERROR: $c->{msg}->{filesize_min_exceeded}$c->{min_upload_size} Kb");
}
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;

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};
}

my ($files_saved,@files);
for my $k ( keys %{$cg->{'.tmpfiles'}} )
{
   my %fhash;
   $cg->{'.tmpfiles'}->{$k}->{info}->{'Content-Disposition'} =~ /name="(.+?)"; filename="(.+?)"/;
   my ($field_name,$filename) = ($1,$2);

   $filename =~ s/.*\\([^\\]*)$/$1/;
   
   $fhash{field_name}=$field_name;
   $fhash{file_name_orig}=$fhash{file_name}=$filename;
   $fhash{file_size} = -s ${$cg->{'.tmpfiles'}->{$k}->{name}};
   $fhash{file_descr} = $cg->param("$field_name\_descr");

   $filename=~ /(.+)\.(.+)/;
   my ($fn,$ext) = ($1,$2);
   $fn = substr($fn,0,$c->{max_name_length});

   if($fhash{file_size}==0)
   {
      &lmsg("MSG:$filename ".$c->{msg}->{null_filesize});
      $fhash{file_status}="null filesize or wrong file path";
      push @files, \%fhash;
      next;
   }

   if($c->{filaname_mask} && $fn !~ /$c->{filaname_mask}/)
   {
      &lmsg("MSG:$filename ".$c->{msg}->{bad_filename});
      $fhash{file_status}="unallowed filename";
      push @files, \%fhash;
      next;
   }

   $fn=~s/[^$c->{filename_rename_mask}]//ge if $c->{filename_rename_mask};

   if($ext !~ /^$c->{ext_allowed}$/i)
   {
      &lmsg("MSG:$filename ".$c->{msg}->{bad_extension});
      $fhash{file_status}="unallowed extension";
      push @files, \%fhash;
      next;
   }

   if($files_saved==$c->{max_upload_files})
   {
      &lmsg("MSG:$filename ".$c->{msg}->{too_many_files});
      $fhash{file_status}="too many files";
      push @files, \%fhash;
      next;
   }
   
   if(-e "$c->{target_dir}/$fn.$ext" && $c->{copy_mode} eq 'Rename')
   {
      my $i;
      $i++ while (-e "$c->{target_dir}/$fn$i.$ext" && $c->{copy_mode} eq 'Rename');
      $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}="";
      push @files, \%fhash;
      next;
   }

   &SaveFile( ${$cg->{'.tmpfiles'}->{$k}->{name}}, $c->{target_dir}, $fhash{file_name} );
   &lmsg("MSG:'$fn.$ext' ".$c->{msg}->{saved_ok});# unless $i;
   $files_saved++;
   $fhash{file_status}||='OK';
   push @files, \%fhash;
}

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

### Small pause to sync messages with pop-up
sleep 1;
&DelData($temp_dir);
&DeleteExpiredFiles( $c->{temp_dir}, $c->{temp_files_lifetime} );
&DeleteExpiredFiles( $c->{target_dir}, 86400*$c->{uploaded_files_lifetime} );

# Generate parameters array for E-mail/POST
my @har;
my $style=1;
for my $f (@files)
{
   $style^=1;
   $f->{file_descr}=substr($f->{file_descr},0,32);
   $f->{file_descr}=~s/>/&gt;/g;$f->{file_descr}=~s/</&lt;/g;
   push @har, { name=>"$f->{field_name}",          'value'=>$f->{file_name},     'style'=>$style };
   push @har, { name=>"$f->{field_name}_original", 'value'=>$f->{file_name_orig},'style'=>$style };
   push @har, { name=>"$f->{field_name}_status",   'value'=>$f->{file_status},   'style'=>$style };
   push @har, { name=>"$f->{field_name}_size",     'value'=>$f->{file_size},     'style'=>$style, value2=>sprintf("%d",$f->{file_size}/1048576)." Mbytes ($f->{file_size} bytes)" };
   push @har, { name=>"$f->{field_name}_description", 'value'=>$f->{file_descr},    'style'=>$style } if $c->{enable_file_descr};
}

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|ref|js_on|upload_id|css_name|tmpl_name|inline|upload_password|popup|file_\d)/i;
      push @har, { name=>$k, value=>$p, 'style'=>2 };
   }
}

push @har, { name=>'target_dir',      value=>$c->{target_dir}, 'style'=>2 };
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, 'style'=>2 };

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

### Send E-mail to Uploader
if($cg->param('email_notification') && $c->{email_required})
{
   my @t = &getTime;
   my @har2 = grep{$_->{style}!=2}@har;
   my $tmpl = HTML::Template->new( filename => "Templates/confirm_email_user.html", die_on_bad_params => 0 );
   $tmpl->param('params'    => \@har2,
                'time'      => "$t[0]-$t[1]-$t[2] $t[3]:$t[4]",
                'total_size'=> "$ENV{CONTENT_LENGTH} bytes",);
   my $subject = $c->{email_subject} || "XUpload: File upload confirmation";
   &SendMail( $cg->param('email_notification'), $c->{confirm_email_from}, $subject, $tmpl->output() );
}
#my ($ex) = $ENV{QUERY_STRING}=~/ex=(.+?)(&|$)/;
#die $ex;
### Sending data with POST request if need
my ($ref) = $ENV{'QUERY_STRING'}=~/ref=(.+?)(&|$)/;
my $url_post = $c->{url_post} || $ref || $ENV{HTTP_REFERER};
if($url_post)
{
   if($ENV{QUERY_STRING}!~/js_on=1/)
   {
     $url_post.='?';
     $url_post.="\&$_->{name}=$_->{value}" for @har;
     print $cg->redirect( $url_post );
     exit;
   }
   print"Content-type: text/html\n\n";
   print"<HTML><BODY><Form name='F1' action='$url_post' target='_parent' method='POST'>";
   print"<textarea name='$_->{name}'>$_->{value}</textarea>" for @har;
   print"</Form><Script>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;
   my @ff;
   opendir(DIR, $dir) || &xmessage("Can't opendir temporary folder: $!");
   @ff = readdir(DIR);
   closedir(DIR);
   foreach my $fn (@ff)
   {
      next if $fn =~ /^\.{1,2}$/;
      my $file = $dir.'/'.$fn;
      my $ftime = (lstat($file))[9];
      my $diff = time() - $ftime;
      next if $diff < $lifetime;
      -d $file ? &DelData($file) : unlink($file);
   }
}

sub SaveFile
{
   my ($temp,$dir,$fname) = @_;
   move($temp,"$dir/$fname") || copy($temp,"$dir/$fname") || die"Can't copy file from temp dir";
   my $mode = 0777;
   chmod $mode,"$dir/$fname";
}

sub DelData
{
   my ($dir) = @_;
   $cg->DESTROY if $cg; # WIN: unlock all files
   return unless -d $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) = @_;
   $msg=~s/'/\\'/g;
   $msg=~s/<br>/\\n/g;
   print"Content-type: text/html\n\n";
   print"<HTML><HEAD><Script languaage='JavaScript'>alert('$msg');</Script></HEAD></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,">>logs.txt");
   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
{
   my $ip = shift;
   return $ENV{'REMOTE_HOST'} if $ENV{'REMOTE_HOST'};
   use Socket;
   return gethostbyaddr(inet_aton($ip), AF_INET);
}

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

sub SendMail
{
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


$body
.
EOM
;
close OUTMAIL;
}