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

my $url  = "http://zentara.zentara.net/~zentara/cgi-bin/up1.cgi";

my $upfile = shift || 'ztest.png';

my $host = "zentara.zentara.net";
$| = 1;

my $start = times;
my ( $iaddr, $paddr, $proto );
$iaddr = inet_aton($host);
#$iaddr = ( gethostbyname($host) )[4]; 
$paddr = sockaddr_in( 80, $iaddr );
$proto = getprotobyname('tcp');
unless ( socket( SOCK, PF_INET, SOCK_STREAM, $proto ) ) {
    die "ERROR : init socket: $!";
}
unless ( connect( SOCK, $paddr ) ) { die "no connect: $!\n"; }

my $length = 0;

open (UH,"+< $upfile") or warn "$!\n";
$length +=  -s UH;

my @head = (
"POST /~zentara/cgi-bin/up1.cgi HTTP/1.1",
"Host: zentara.zentara.net",
"User-Agent: z-uploader",
"Content-Length: $length",
"Content-Type: multipart/form-data; boundary=zzzzzzzzzzzzzzzzzzz",
"",
"--zzzzzzzzzzzzzzzzzzz",
"Content-Disposition: form-data; name=\"file\"; filename=\"$upfile\"",
"Content-Type: application/octet-stream",
"",
"",
);
#try to get total length 
my $header = join( "\r\n", @head );
$length += length($header);
$head[3] = "Content-Length: $length";
$header = join( "\r\n", @head );
#recompute
$length =  -s UH
$length += length($header);

select SOCK;
$| = 1;
binmode SOCK;

print SOCK $header;

while( sysread(UH, my $buf, 8196 ) ){

    if( length($buf) < 8196 ){
           $buf = $buf."\r\n--zzzzzzzzzzzzzzzzzzz--\r\n";
           syswrite SOCK, $buf, length($buf);
         }else{ syswrite SOCK, $buf, 8196 }
    print STDOUT '.',
 }
close UH;
select STDOUT;

# here is where I think the EOT should be sent
# so I could read the results page, but it hangs
# the socket
#my $data = (<SOCK>); 
#print "result->$data\n"; 

close SOCK;