Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

cannot do a POST with proxy

by majinbis (Initiate)
on Sep 13, 2009 at 23:31 UTC ( #795039=perlquestion: print w/replies, xml ) Need Help??
majinbis has asked for the wisdom of the Perl Monks concerning the following question:

Hello monks, I have this code that's driving me nuts... I have a code that works well with most sites but as soon as I try to POST, it just waits and would eventually timeout. Please help!
#!c:\bin\perl -w use URI; use IO::Socket; #use threads('yield', 'stack_size' => 64*4096); use threads; use strict; my $debug = 1; #suppress PIPE signal $SIG{PIPE} = 'IGNORE'; # command-line arguments my $proxy_port=shift(@ARGV); $proxy_port=8080 unless $proxy_port =~ /\d+/; # create socket connection for proxy my $proxy = IO::Socket::INET->new ( LocalPort => $proxy_port, Type => SOCK_STREAM, proto => 'tcp', Reuse => 1, Listen => 10); binmode $proxy; # create thread for each browser request while (my $browser_request = $proxy->accept()) { binmode $browser_request; my $t = threads->new(\&fetch, $browser_request); $t->detach; } # sub routine called by each thread sub fetch{ my $browser = $_[0]; my $method =""; my $content_length = 0; my $content = 0; my $accu_content_length = 0; my $host; my $hostAddr; my $httpVer; #my $count; #my $request; while (my $browser_line = <$browser>) { # check method from browser request unless ($method) { ($method, $hostAddr, $httpVer) = $browser_line =~ /^(\w+) +(\S+) +(\S+ +)/; # get host name and port from browser and create new socket connection + to host my $uri = URI->new($hostAddr); $host = IO::Socket::INET->new ( PeerAddr=> $uri->host, PeerPort=> $uri->port ); die "couldn’t open $hostAddr" unless $host; binmode $host; print $host "$method ".$uri->path_query." $httpVer\n"; print "METJHOD: $method ".$uri->path_query." $httpVer\n"; next; } $content_length = $1 if $browser_line=~/Content-length: +(\d+)/i; $accu_content_length+=length $browser_line; if ($debug == 1){ print "[$count] $browser_line \n"; $count++ } print $host $browser_line; # check if last line last if $browser_line =~ /^\s*$/ and $method ne "POST"; if ($browser_line =~ /^\s*$/ and $method eq "POST") { $content = 1; last unless $content_length; next; } #print "COUNTER POST: $count\n"; #$request .= $browser_line; if ($content) { $accu_content_length+=length $browser_line; last if $accu_content_length >= $content_length; } } #print "\n\n\n REQUEST: $request"; $content_length = 0; $content = 0; $accu_content_length = 0; while (my $host_line = <$host>) { if ($debug == 2){ print $host_line; } print $browser $host_line; $content_length = $1 if $host_line=~/Content-length: +(\d+)/i; if ($host_line =~ m/^\s*$/ and not $content) { $content = 1; #last unless $content_length; next; } if ($content) { if ($content_length) { $accu_content_length+=length $host_line; #print "\nContent Length: $content_length, accu: $accu_content_length\ +n"; last if $accu_content_length >= $content_length; } } } $browser-> close; $host -> close; }

Replies are listed 'Best First'.
Re: cannot do a POST with proxy
by snoopy (Deacon) on Sep 14, 2009 at 01:29 UTC
    Rather than "working well", this code happens to work when there is no buffering or true bidirectional communication between the client and the server at any stage. This is breaking down when you try a POST.

    You'll need to restructure your two while loops in your fetch method, to ensure you only read from the client or server when they are ready to write. perlipc shows an example, using select(), however, IO::Select should work here.

      Hi. Thanks for your response. I tried implementing IO::Select but it still did the same thing (unless I implemented it the wrong way). Tried a few tweaks and it worked on the latest IE but I'm still having the same problems with FF/Chrome and older versions of IE. it seems to be doing the following: 1. When I do a POST, it send the request with the right headers as per RFC1945 (i'm only implementing HTTP/1.0) gets the headers but stops at the blank line before the body so I think what happens is that the remote host is still waiting for the body

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://795039]
Approved by broomduster
Front-paged by tye
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (8)
As of 2018-07-17 23:22 GMT
Find Nodes?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?

    Results (380 votes). Check out past polls.