Upload with Perl

#!C:\Perl\bin\perl.exe
use CGI;
use Fcntl qw(:DEFAULT :flock);
use File::Temp qw/ tempfile tempdir /;
use File::Copy;
use File::Basename;
use CGI::Carp qw(fatalsToBrowser);
use DBI;

# Include config local variable
# require("config.inc");

# Output header content type
print "Content-type:text/html\n\n";

# GET or POST
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
    print <<END_HTML;
<form name="frmUpload" id="frmUpload" enctype="multipart/form-data" method="post" target="iframeUpload">
<input type="file" name="ufile" />
<input type="submit" value="Upload" />
</form>

<iframe name="iframeUpload" id="iframeUpload" width="100%" heigth="45" frameborder="0"></iframe>

<!--<iframe name="iframeUpload2" id="iframeUpload2" width="100%" heigth="45" frameborder="0" src="status.cgi"></iframe>-->

END_HTML
;
    exit;
}

# Kich thuoc nhan xu ly toi da
use constant MAX_FILE_SIZE => 400 * 1024 * 1024; #bytes
use constant EXTENSION_LIST => '.doc,.txt,.xls,.gif,.exe,.jpg';

# Chu y writeable: chmod +777
use constant LOG_DIR    => 'C:/';
use constant TMP_DIR    => 'C:/';
use constant UPLOAD_DIR    => 'D:/';

my $FILE_EXT = '', $FILE_NAME = '';

# Kich thuoc goi tin CLIENT gui len
$len = $ENV{'CONTENT_LENGTH'};
# Kiem tra do lon du lieu day len
if ($len > MAX_FILE_SIZE) {
    error('Kich thuoc file qua lon');
}

# Ghi du lieu day len ra 1 file (theo doi toc do day len)
open(HANDLE,'>','C:/cgi_postdata') or error('Receive data failed');
binmode HANDLE; HANDLE->autoflush(1);
my $bRead = 0;
use constant SMALL_FILE_SIZE => 2048;#Kich thuoc du de parse header
my $gotHeader = 0; my $header = '';

while (read(STDIN ,$LINE, 1024) && ($bRead < $len)) {
    $bRead += length $LINE;
    print HANDLE $LINE;
    $header = $header . $LINE;
   
    if ($bRead >= SMALL_FILE_SIZE && !$gotHeader) {
        $gotHeader = 1;
        checkHeader($header);
    }
   
   
}
close(HANDLE);

# Validate extension (for small upload file)
if (!$gotHeader) {
    checkHeader($header, 1);
}

# Do lai du lieu doc duoc vao STDIN
open(STDIN, TMP_DIR . 'cgi_postdata') or error('Read post data from temp file failed');
$cg = new CGI();

# Luu file upload ra file tam


my $tmpFile, $fh;

$fh = $cg->upload('ufile'); #Sinh rac o day! C:\Windows\Temp\CGItemp*
$cgiTMPFile = $cg->tmpFileName($fh);

print $cgiTMPFile;
if(not defined $fh) {
    error('Missing upload file');
}
close($fh);

$tmpFile = $cgiTMPFile;

#($tmp_fh, $tmpFile) = tempfile(DIR => TMP_DIR);
#binmode $tmp_fh;
#while(<$fh>) {
#    print $tmp_fh $_;
#}
#close($tmp_fh);
#chmod 0644, $tmpFile;#???

close (STDIN);


# Chuyen file tam sang noi chinh thuc can luu UPLOAD
# $destFile = 'ok.txt';
$destFile = $FILE_NAME . $FILE_EXT;
move($tmpFile, UPLOAD_DIR . $destFile) or error('Couldn\'t copy file' . $tmpFile . ' to data dir (' . UPLOAD_DIR . $destFile. ')');



my $result = 'Finish upload ' . $FILE_NAME . $FILE_EXT . '[' . $len . ' bytes]';
print $result;
writelog('access', 'Finish upload ' . $FILE_NAME . $FILE_EXT . '[' . $len . ' bytes]');


sub checkHeader {
    my $header = shift;
    my $checkSmallFile = shift;
    if (not defined $checkSmallFile) {
        print 'Check header. ';
    } else {
        print 'Data post len nho! Check all. ';
    }
    my $pos1 = 0, $pos2 = 0, $filename = '', $extension = '';
   
    $pos1 = index($header, '"; filename="');
    if ($pos1 == -1) {
        if (not defined $checkSmallFile) {
            #print 'Ko truyen tham so a';
        } else {
            error('Missing uploaded file');
        }  
        return;
    }
    $pos1 = $pos1 + length '"; filename="';
    $pos2 = index($header, '"', $pos1 + 1);
   
    if ($pos2 == -1) {
        if (not defined $checkSmallFile) {
            #print 'Ko truyen tham so a';
        } else {
            error('Missing uploaded file');
        }  
        return;
    }
    $filename = substr($header, $pos1, $pos2 - $pos1);
   
    if (!$filename) {
        error('Missing uploaded file (?)');
    }
   
    writelog('access', 'Start upload ' . $filename);
    # validate type
    $extension = getExtension($filename);
   
    if (length $extension eq 0) { error('Missing extension'); }
    if (!in_string(EXTENSION_LIST, $extension)) {
        error('Invalid extension: ' . $extension . ' [' . EXTENSION_LIST . ']');
    }
   
    $FILE_EXT = $extension; #global variable
}

sub error {
    my $message = shift;
    print $message;
    writelog('error', $message);
    exit;
}

sub writelog {
    $file = shift; #access,error
    $line = shift;
    open(FILE_LOG,'>>', LOG_DIR . 'cgi_' . $file . '_log');
    print FILE_LOG $line . "\n";
    close(FILE_LOG);
}

sub getExtension {
    $file = shift;
    my ($name,$dir,$type) = fileparse($file, qr{\.[^\.]*});
    $FILE_NAME = $name;
    return $type;
}

sub in_string {
     my ($str, $fileExt) = @_;
     my @ext_arr = split(',', $str);
    
     foreach $ext (@ext_arr) {
        if($fileExt eq $ext) {
            #print $fileExt . '=' . $ext;
            return 1;
        } else {
            #print $fileExt . '-' . $ext;
        }
    }
    return 0;
}