Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Re: Re: using CGI on HTTP::Request from HTTP::Daemon

by PodMaster (Abbot)
on May 25, 2004 at 20:14 UTC ( [id://356356]=note: print w/replies, xml ) Need Help??


in reply to Re: using CGI on HTTP::Request from HTTP::Daemon
in thread using CGI on HTTP::Request from HTTP::Daemon

I was trying to get multipart/form-data (file uploads) working with CGI::Simple when I noticed that it's looking for the boundary in $ENV{CONTENT_TYPE}, which is there in the request. This will get it working with CGI, but not CGI::Simple (it hangs). You can omit all your HTTP::Daemon::ClientConn->overload stuff
sub serve_everything { my ($conn, $req) = @_; ... $ENV{CONTENT_TYPE} = join('; ', $req->content_type) || ''; ... local *main::STDIN = $conn; use CGI; my $cgi = CGI->new();

MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
** The third rule of perl club is a statement of fact: pod is sexy.

Replies are listed 'Best First'.
Re: Re: Re: using CGI on HTTP::Request from HTTP::Daemon
by tachyon (Chancellor) on May 26, 2004 at 00:55 UTC

    This snippet of code:

    my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;

    Is common to both CGI and CGI::Simple. Do you have a complete test case that generates the hang? That would make it easier to debug.....

    cheers

    tachyon

      Just fire this up and point your browser to localhost. Then submit one of the last two forms and watch the hang
      #!/usr/bin/perl -w use strict; use Cwd qw( cwd ); use File::Spec; $ENV{DOCUMENT_ROOT} = cwd(); chdir $ENV{DOCUMENT_ROOT}; use Data::Dumper; use HTTP::Daemon; use HTTP::Status; use CGI::Simple(); use CGI(); my $port = shift || 80; my $docroot = shift || $ENV{DOCUMENT_ROOT}; my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => $port, ) or die "No daemon: $!\n"; warn "Ready to go!\n"; while (my $conn = $d->accept()) { handle_uri( $conn, $conn->get_request( 1 )); } sub handle_uri { my ($conn, $req) = @_; my $uri = $req->uri(); if ($uri =~ /images/) { serve_image( $conn, $req, $uri ); } else { serve_everything( $conn, $req, $uri ); } } sub serve_everything { my ($conn, $req) = @_; my $uri = $req->uri; $ENV{REQUEST_METHOD} = $req->method; $ENV{CONTENT_TYPE} = join('; ', $req->content_type ) || ''; $ENV{CONTENT_LENGTH} = $req->content_length || ''; $ENV{HTTP_USER_AGENT} = join('; ', $req->user_agent ) || ''; $ENV{SCRIPT_NAME} = $uri->path || 1; $ENV{QUERY_STRING} = $uri->query || ''; $ENV{HTTP_HOST} = $req->header('host'); $ENV{REMOTE_ADDR} = $conn->peerhost(); $ENV{REMOTE_PORT} = $conn->peerport(); foreach my $c (qw( cookie cookies )) { $ENV{uc $c} = join(';', $req->header( $c ) ) || ''; } my $cgi; { # warn '$ENV{CONTENT_LENGTH} = ',$ENV{CONTENT_LENGTH},$/; # local $_; # warn "read ", sysread($conn, $_, $ENV{CONTENT_LENGTH}, 0); # warn $_,$/,$/; local *main::STDIN = $conn; $cgi = CGI::Simple->new(); # $cgi = CGI->new(); # CGI works, CGI::Simple hangs :( } $conn->send_response( HTTP::Response->new( 200, 'OK', HTTP::Headers->new( Set_Cookie => $cgi->cookie( -name =>'sessionID', -value =>'xyzzy', -expires =>'+1y', -path =>'', -domain => $ENV{HTTP_HOST}, -secure => 0 ), Content_Type => "text/html"), "<font size=2><pre>". CGI::Simple->escapeHTML( scalar Dumper( $conn, $req, \%ENV, $cgi ) ). qq| </font></pre> <hr> <FORM METHOD="GET" ACTION="$ENV{SCRIPT_NAME}" ENCTYPE="application/x-www-form-urlencoded"> <input type="text" name"f"> <input type="reset" name=".reset" /> <input type="submit" name=".submit" /> </form> <FORM METHOD="POST" ACTION="$ENV{SCRIPT_NAME}" ENCTYPE="application/x-www-form-urlencoded"> <input type="text" name"f"> <input type="reset" name=".reset" /> <input type="submit" name=".submit" /> </form> <FORM METHOD="POST" ACTION="$ENV{SCRIPT_NAME}" ENCTYPE="multipart/form-data"> <INPUT TYPE="file" NAME="upload_file1" SIZE="42"> <INPUT TYPE="file" NAME="upload_file2" SIZE="42"> <input type="reset" name=".reset" /> <input type="submit"> </FORM> | ) ); $conn->print( 'nope', $@ ) if $@; } sub serve_image { my ($conn, $req, $uri) = @_; my $file = File::Spec->catfile( $docroot, $uri ); $conn->send_status_line( (-e $file ? 200 : 404 ) ); $conn->send_file_response( $file ); }

      MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
      I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
      ** The third rule of perl club is a statement of fact: pod is sexy.

        The problem per se is that there is no eof reaching CGI::Simple. As a result it blocks (hangs) on the read here:

        sub _read_data { read ( STDIN, my $buffer, 16 ); # nb changed buf size for testing return $buffer; }

        In essence the difference between the way CGI.pm reads data and what I did in this module is that CGI stops when it gets what it expects, thus it is not eof dependent.

        It is actually quite interesting what happens. If you increase the buffer size on the read so it can slurp the data in one pass it works fine. It is only if you read bytewise that read (or sysread) fails to recognise the end of the data stream.

        cheers

        tachyon

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://356356]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (6)
As of 2024-04-25 08:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found