perl CGI 利用socket上传文件功能

客户端：send_socket.pl
注意的是
    1. 回车符\r\n 的运用。还有boundary的分隔符。
     2. post参数可以加多个，文件也一样可以加多个。
    3. filename 是存在本地的文件名，可以不要自己定义名字。
   4. 如果用CGI.pm接收，name="Submit"  和 name="file" 必须写死，是需要的，否则服务器会一直等待超时！

命令：perl send_socket.pl 123.99.86.60 80

#!/usr/bin/perl -w
# tcp_socket_cli.pl
use strict;
use Socket;

my $addr = $ARGV[0] || '127.0.0.1';
my $port = $ARGV[1] || '80';
my $dest = sockaddr_in($port, inet_aton($addr));
my $buf = undef;

socket(SOCK,PF_INET,SOCK_STREAM,6) or die "Can't create socket: $!";
connect(SOCK,$dest) or die "Can't connect: $!";

my $pData = qq|------WebKitFormBoundary7MrX39PdxTZCRcIu\r\n| .
qq|Content-Disposition: form-data; name="file"; filename="ss.txt"\r\n| .
qq|Content-Type: text/plain\r\n\r\n| .
qq|2\r\n| .
qq|------WebKitFormBoundary7MrX39PdxTZCRcIu\r\n| .
qq|Content-Disposition: form-data; name="filenewname"\r\n\r\n| .
qq|x1111\r\n| .
qq|------WebKitFormBoundary7MrX39PdxTZCRcIu\r\n| .
qq|Content-Disposition: form-data; name="Submit"\r\n\r\n| .

qq|Submit Form\r\n| .
qq|------WebKitFormBoundary7MrX39PdxTZCRcIu--\r\n|
;

my $len = length($pData);

my $write_buf = qq|POST /clientupload/upload.cgi HTTP/1.1
Host: logreport.xx.com.cn
Connection: keep-alive
Content-Length: 385
Cache-Control: max-age=0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
Origin: http://logreport.xx.com.cn
User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.63 Safari/537.36
Content-Type: multipart/form-data; boundary=----WebKitFormBoundary7MrX39PdxTZCRcIu
Referer: http://logreport.xx.com.cn/clientupload/uploadFile.pl
Accept-Encoding: gzip,deflate,sdch
Accept-Language: zh-CN,zh;q=0.8
Cookie: _ga=GA1.3.2023535787.1437720833; __mtxud=26b02f269a3ac0c5.1437645511795.1438754742974.1438998340908.4; Hm_lvt_9e451c4b637507c34863250b1987332a=1440655977,1440656112,1441524498,1441766300; Hm_lpvt_9e451c4b637507c34863250b1987332a=1441766321\r\n\r\n
$pData
|;

print "$write_buf";
syswrite(SOCK, $write_buf);


my $bs = sysread(SOCK, $buf, 2048); # try to read 2048
print "Received $bs bytes, content $buf\n"; # actually get $bs bytes
close SOCK;

服务器端，接收端：upload.cgi

#!/usr/bin/perl

use strict;
use CGI;
use Fcntl qw( :DEFAULT :flock );

use constant UPLOAD_DIR => "/data/clientLog/";
use constant BUFFER_SIZE => 16_384;
use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to 1 MB

use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads to 100 MB

use constant MAX_OPEN_TRIES => 100;

$CGI::DISABLE_UPLOADS = 0;
$CGI::POST_MAX = MAX_FILE_SIZE;

my $q = new CGI;
$q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error );
print $q->header( -type=>'text/html', -charset=>'UTF=8');


my $file = $q->param( "file" ) || error( $q, "No file received." );
my $filename = $q->param( "filenewname" ) || error( $q, "No filename entered." );
#my $fh = $q->upload( $file ) || die ( "No file uploaded. $file. $!" ); #程序在此处退出。
my $fh = $q->upload( "file" ) || die ( "No file uploaded. $file. $!" ); #程序在此处退出。

my $postData = $q->param( "postData" );
my $TimeUpdate = $q->param( "TimeUpdate" );
my $Account = $q->param( "Account" );
my $ServerName = $q->param( "ServerName" );

$q->print( "postData: $postData<br>" );
$q->print( "postData: $TimeUpdate<br>" );
$q->print( "postData: $Account<br>" );
$q->print( "postData: $ServerName<br>" );

my $io_handle;
if( defined $fh ) {
        $io_handle = $fh->handle;
}

#$q->print( "file: $file<br>filename: $filename<br>" );
#$q->print( "UPLOAD_DIR: " . UPLOAD_DIR . " <br> BUFFER_SIZE: " .BUFFER_SIZE . "<br>" );
#$q->print( "MAX_FILE_SIZE: " . MAX_FILE_SIZE . "<br>MAX_DIR_SIZE: " . MAX_DIR_SIZE . "<br>" );

#my $type = $q->uploadInfo($filename)->{'Content-Type'};
#$q->print( "type: $type<br>" );

my $buffer = "";

if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
   error( $q, "Upload directory is full." );
}

# Allow letters, digits, periods, underscores, dashes

# Convert anything else to an underscore

$filename =~ s/[^\w.-]/_/g;
if ( $filename =~ /^(\w[\w.-]*)/ ) {
   $filename = $1;
}
else {
   error( $q, "Invalid file name; files must start with a letter or number." );
}

# Open output file, making sure the name is unique
#until ( sysopen OUTPUT, UPLOAD_DIR . $filename, O_CREAT | O_EXCL ) {
unless ( sysopen OUTPUT, UPLOAD_DIR . $filename, O_RDWR | O_CREAT | O_EXCL ) {
   $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;

   $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." );
}

# This is necessary for non-Unix systems; does nothing on Unix
binmode $fh;
binmode OUTPUT;

# Write contents to output file
#while ( read( $fh, $buffer, BUFFER_SIZE ) ) {
#   print OUTPUT $buffer;
#
#}
#
while ( my $bytesread = $io_handle->read( $buffer, BUFFER_SIZE ) ) {
   print OUTPUT $buffer;
}

close OUTPUT;
$io_handle->close;

print   $q->start_html( "success upload" ),
        $q->h1("Success"),
        $q->p( "upload $filename");

print   $q->end_html;

exit ;

# -------- FUNCTION ----------
sub dir_size {
   my $dir = shift;

   my $dir_size = 0;

   # Loop through files and sum the sizes; doesn