#!/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 = "smallishtestfile.tar.gz";

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

my $upfile = shift || 'F:\\skript\\'.$local_file;

system("cls");
print STDOUT "Starting upload to ".$url."\n\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: $!\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 (FH,"< $upfile") or die "$!\n";
binmode FH;

my $data = join("\r\n", @data);
my $length = 0;
$length += length($data);		# length of the data to be POST'ed
$length += -s FH;				# filesize
$length += length($boundary);	# boundary is added once more at the end of all the file-chunks

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

select SOCK;
$| = 1;
binmode SOCK;

print SOCK $header;

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

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

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