simulating LWP's "results" with pure sockets

zentara has asked for the wisdom of the Perl Monks concerning the following question:

Hi, this really isn't a problem, because LWP works fine. I was toying around with tk-http-file-upload-w-progress and I thought..."how could I do this with pure sockets?". So I traced the headers and tcp transfers and put them into a script to do an http upload to a cgi script. It all works except for 1 thing. The sockets script will not return the results, like LWP or a browser would.

In the LWP script, the file uploads, and then the cgi returns a "thank you for uploading message", which LWP will display with

my $res = $ua->request($req);
if ($res->is_success){print $res->as_string;
}else{print $res->status_line;
}
[download]

Now this is my pure Sockets version, and it works only if I close the socket after the file upload. The cgi script still sends out the "thankyou", but my sockets script can't read it. If I put in some code to read the socket for the "thank you", it just hangs, because the server still is in "read" and so is my script. So is there a command or some hex codes, which I can send after the file transfer finishes, which tells the apache server, to finish sending? Something like "End of Send", which signals a mode switch but dosn't close the socket?". How does LWP do it? In simple terms :-)?

#!/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;
[download]

In case anyone wants to play with it, here is the cgi script:

#!/usr/bin/perl
use warnings;
use strict;
use CGI;
use CGI::Carp 'fatalsToBrowser';

#my $maxsize = 1024 * 100; #max 100K 
my $maxsize = 1024 * 20000; #max 20M 

#$CGI::POST_MAX= $maxsize;  # max 100K posts !not working right? 
#$CGI::DISABLE_UPLOADS = 1;  # no uploads 

my $query = new CGI;
my $upload_dir = "uploads";  #permissions for dir are set 

print $query->header();

if($ENV{CONTENT_LENGTH} > $maxsize){
 print "file too large - must be less than $maxsize bytes";
 exit;
 }

my $file = $query->param("file");
my $filename = $file;
$filename =~s/.*[\/\\](.*)/$1/;


open (UPLOADFILE, ">$upload_dir/$filename");

$/= \8192;  # sets 8192 byte buffer chunks, perldoc perlvar 
while ( <$file> ){
        print UPLOADFILE $_;
#select(undef,undef,undef,.05); #for testing 
        }
        close UPLOADFILE;


print <<END_HTML;
<HTML>
<HEAD> <TITLE>Thanks!</TITLE> </HEAD>
<BODY bgcolor="#ffffff"><br>
<P>Thanks for uploading file : $filename!</P>
</BODY>
</HTML>
END_HTML
[download]

I'm not really a human, but I play one on earth. flash japh

Comment on simulating LWP's "results" with pure sockets Select or Download Code

Replies are listed 'Best First'.
Re: simulating LWP's "results" with pure sockets by beauregard (Monk) on Mar 08, 2005 at 22:14 UTC
You need to tell the server that you're done sending. It's going to be sitting there waiting for an EOF so it'll never send an answer back. The way you do this is with the shutdown call. Something like: `shutdown SOCK, 1; my $data = (<SOCK>); print "result->$data\n";` [download] This shuts down the writing side of the socket, dropping it into half-duplex mode, while leaving the read side open. The server catches an EOF on its end and is able to write back the status response. Pretty much classic HTTP. The other way to do this (assuming a proper HTTP server) is to write the length of the file in the Content-Length header. The server can then know to stop reading once it gets that many bytes. However, your CGI doesn't use Content-Length to determin when it's done reading so... c.	[reply] [d/l]
Re^2: simulating LWP's "results" with pure sockets by zentara (Cardinal) on Mar 08, 2005 at 23:28 UTC
Thanks, that did it. After all this time messing around with sockets, I was unaware of "shutdown", exactly what I was looking for. I'm not really a human, but I play one on earth. flash japh	[reply]