#!/usr/bin/perl
use warnings;
use strict;
use Socket;

my $buffersize = 2 * 1024 * 1024;

my $host = "127.0.0.1";
my $path = "/debug.php";
my $url  = "http://".$host.$path;
my $local_file = "testfile.rar";
my $local_path = "F:\\skript\\";

my $user = "cardman";
my $pass = "yvan eht nioj";
my $serverid = 666;

my $upfile = shift || $local_path.$local_file;

system("cls");
print STDOUT "Starting upload to ".$url."\r\n\r\n";

$| = 1;

my ($iaddr, $paddr, $proto);
$iaddr = inet_aton($host);
$paddr = sockaddr_in(80, $iaddr);
$proto = getprotobyname('tcp');
unless(socket(SOCK, PF_INET, SOCK_STREAM, $proto)) { die "Couldn't init socket: $!"; }
unless(connect(SOCK, $paddr)) { die "Couldn't connect: $!\r\n"; }

my $boundary = "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz";

my @data = (
	"--".$boundary."",
	"Content-Disposition: form-data; name=\"username\"",
	"",
	"".$user."",
	"--".$boundary."",
	"Content-Disposition: form-data; name=\"password\"",
	"",
	"".$pass."",
	"--".$boundary."",
	"Content-Disposition: form-data; name=\"serverid\"",
	"",
	"".$serverid."",
	"--".$boundary."",
	"Content-Disposition: form-data; name=\"file\"; filename=\"".$local_file."\"",
	"Content-Type: application/octet-stream",
	"",
	"",
);

open (FILE,"< $upfile") or die "$!\n";
binmode FILE;

my $data = join("\r\n", @data);
my $length = 0;
$length += length($data);		# length of the data to be POST'ed
$length += -s FILE;				# filesize
$length += length($boundary);	# boundary is added once more at the end of all the file-chunks
$length += 4;					# adding 4 bytes (no idea as to why, but it works -- tested with 4 rng-files: 5 byte, 2mb, 15mb and 100mb)

my @head = (
	"POST ".$path." HTTP/1.1",
	"Host: ".$host."",
	"Content-Length: $length",
	"Connection: close",
	"Content-Type: multipart/form-data; boundary=".$boundary."",
	"",
	"",
);
my $header = join("\r\n", @head).$data;

# FOR DEBUGGING
# open (FILE2,"< $upfile") or die "$!\n";	binmode FILE;
# open(LOG, ">".$local_path."headers.txt"); binmode LOG;
# print LOG $header;
# while(sysread(FILE2, my $buf, 8)) { print LOG $buf; }
# print LOG "\r\n--".$boundary."--";
# close LOG; close FILE2;

select SOCK;
$| = 1;
binmode SOCK;

print SOCK $header;

while(sysread(FILE, my $buf, $buffersize))
{
    if(length($buf) < $buffersize) {
        $buf = $buf."\r\n--".$boundary."--";
        syswrite SOCK, $buf, length($buf);
 	} else {
		syswrite SOCK, $buf, $buffersize;
	}
 }
close FILE;

my @response = (<SOCK>);
shutdown SOCK, 1;

print STDOUT "Result:\n-------\n @response";
close SOCK;