How do I access the content data that's being uploaded in a multipart/form-data POST?

Question

I have the following Perl code that I found on this SO Q&A titled: Perl HTTP server. Specifically this answer. Here's my modified code:

httpserver.pl

#!/usr/bin/perl

use strict;
use warnings;

use CGI qw/ :standard /;
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Response;
use HTTP::Status;
use POSIX qw/ WNOHANG /;

use constant HOSTNAME => qx{hostname};

my %O = (
    'listen-host' => '127.0.0.1',
    'listen-port' => 8080,
    'listen-clients' => 30,
    'listen-max-req-per-child' => 100,
);

my $d = HTTP::Daemon->new(
    LocalAddr => $O{'listen-host'},
    LocalPort => $O{'listen-port'},
    Reuse => 1,
) or die "Can't start http listener at $O{'listen-host'}:$O{'listen-port'}";

print "Started HTTP listener at " . $d->url . "\n";

my %chld;

if ($O{'listen-clients'}) {
    $SIG{CHLD} = sub {
        # checkout finished children
        while ((my $kid = waitpid(-1, WNOHANG)) > 0) {
            delete $chld{$kid};
        }
    };
}

while (1) {
    if ($O{'listen-clients'}) {
        # prefork all at once
        for (scalar(keys %chld) .. $O{'listen-clients'} - 1 ) {
            my $pid = fork;

            if (!defined $pid) { # error
                die "Can't fork for http child $_: $!";
            }
            if ($pid) { # parent
                $chld{$pid} = 1;
            }
            else { # child
                $_ = 'DEFAULT' for @SIG{qw/ INT TERM CHLD /};
                http_child($d);
                exit;
            }
        }

        sleep 1;
    }
    else {
        http_child($d);
    }

}

sub http_child {
    my $d = shift;

    my $i;
    my $css = <<CSS;
        form { display: inline; }
CSS

    while (++$i < $O{'listen-max-req-per-child'}) {
        my $c = $d->accept or last;
        my $r = $c->get_request(1) or last;
        $c->autoflush(1);

        print sprintf("[%s] %s %s\n", $c->peerhost, $r->method, $r->uri->as_string);

        my %FORM = $r->uri->query_form();

        if ($r->uri->path eq '/') {
            _http_response($c, { content_type => 'text/html' },
                start_html(
                    -title => HOSTNAME,
                    -encoding => 'utf-8',
                    -style => { -code => $css },
                ),
                p('Here are all input parameters:'),
                pre(Data::Dumper->Dump([\%FORM],['FORM'])),
                (map { p(a({ href => $_->[0] }, $_->[1])) }
                    ['/', 'Home'],
                    ['/ping', 'Ping the simple text/plain content'],
                    ['/error', 'Sample error page'],
                    ['/other', 'Sample not found page'],
                ),
                end_html(),
            )
        }
        elsif ($r->uri->path eq '/ping') {
            _http_response($c, { content_type => 'text/plain' }, 1);
        }
        elsif ($r->uri->path eq '/error') {a
            my $error = 'AAAAAAAAA! My server error!';
            _http_error($c, RC_INTERNAL_SERVER_ERROR, $error);
            die $error;
        }
        elsif ($r->method eq 'POST' and $r->uri->path eq '/formdata') {
                        #_http_response($c, { content_type => 'text/plain' }, 1);
                        print "--> begin form data <--\n";
                        _http_response($c, { content_type => 'text/html' },
                            start_html(
                                -title => HOSTNAME,
                                -encoding => 'utf-8',
                                -style => { -code => $css },
                            ),
                            p('Here are all the input parameters:'),
                            pre(Data::Dumper->Dump([\%FORM],['FORM'])),
                            end_html(),
                        );
                        print Data::Dumper->Dump([$r], [qw(r)]);
                        print "--> end form data <--\n";
        }
        else {
            _http_error($c, RC_NOT_FOUND);
        }

        $c->close();
        undef $c;
    }
}

sub _http_error {
    my ($c, $code, $msg) = @_;

    $c->send_error($code, $msg);
}

sub _http_response {
    my $c = shift;
    my $options = shift;

    $c->send_response(
        HTTP::Response->new(
            RC_OK,
            undef,
            [
                'Content-Type' => $options->{content_type},
                'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0',
                'Pragma' => 'no-cache',
                'Expires' => 'Thu, 01 Dec 1994 16:00:00 GMT',
            ],
            join("\n", @_),
        )
    );
}

curl command

I'm using this curl command to connect to the server.

$ curl -X POST -H "Content-Type: multipart/form-data;  \
    boundary=----------------------------4ebf00fbcf09" \
    --data-binary @test.txt                            \
    http://localhost:8080/formdata?arg1=blah1\&arg2=blah2

test.txt data file

Along with this test file.

$ cat test.txt 
This is some test text in a file.

Which returns the following when I run it:

<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>greeneggs.bubba.net
</title>
<style type="text/css">
<!--/* <![CDATA[ */
        form { display: inline; }


/* ]]> */-->
</style>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
</head>
<body>

<p>Here are all the input parameters:</p>
<pre>$FORM = {
          'arg2' => 'blah2',
          'arg1' => 'blah1'
        };
</pre>

</body>
</html>

My Question

How do I process the data from the multi-data form on the server side? I thought the data would be accessible through the request ($r) but when I use Data::Dumper to analyze it I don't see anything resembling the data.

Output from the http server after connecting to it via curl command:

[127.0.0.1] POST /formdata?arg1=blah1&arg2=blah2
--> begin form data <--
$r = bless( {
              '_protocol' => 'HTTP/1.1',
              '_content' => '',
              '_uri' => bless( do{\(my $o = '/formdata?arg1=blah1&arg2=blah2')}, 'URI::http' ),
              '_headers' => bless( {
                                     'user-agent' => 'curl/7.29.0',
                                     'content-type' => 'multipart/form-data; boundary=----------------------------4ebf00fbcf09',
                                     'accept' => '*/*',
                                     'content-length' => '34',
                                     'host' => 'localhost:8080'
                                   }, 'HTTP::Headers' ),
              '_method' => 'POST'
            }, 'HTTP::Request' );
--> end form data <--

What am I missing?

Answer 1

$c->get_request( $headers_only )

The get_request() method will normally not return until the whole request has been received from the client. This might not be what you want if the request is an upload of a large file (and with chunked transfer encoding HTTP can even support infinite request messages - uploading live audio for instance). If you pass a TRUE value as the $headers_only argument, then get_request() will return immediately after parsing the request headers and you are responsible for reading the rest of the request content. If you are going to call $c->get_request again on the same connection you better read the correct number of bytes.

try changing (inside httpsserver.pl above),

my $r = $c->get_request(1) or last;

to

my $r = $c->get_request() or last;