Reproducible test case for CVE-2011-2766

bug.pl

#!/usr/bin/perl

use strict;
use warnings;

use CGI::Fast              qw[];
use FCGI                   qw[];
use IO::Socket::INET       qw[];
use Net::FastCGI::Constant qw[:common :type :role];
use Net::FastCGI::IO       qw[ read_record
                               write_record ];
use Net::FastCGI::Protocol qw[ build_begin_request_body
                               build_params ];

printf <<EOF, $], CGI->VERSION, CGI::Fast->VERSION, FCGI->VERSION;
perl      = %s
CGI       = %s
CGI::Fast = %s
FCGI      = %s

EOF

my $socket = IO::Socket::INET->new(
   LocalHost => 'localhost',
   Listen    => 1,
) or die qq<Could not create a listener socket: '$@'>;

my $host = $socket->sockhost;
my $port = $socket->sockport;

defined(my $pid = fork) 
  or die qq<Could not fork(): '$!'>;

if (!$pid) {
    close STDIN;
    open STDIN, "<&", $socket
      or die qq<Could not dup socket to STDIN: '$!'>;

    close $socket;

    undef %ENV; # otherwise the bug wont trigger

    while (my $q = CGI::Fast->new) {
        print $q->header(-type => 'text/plain'),
              'foo: ', $q->param('foo'), "\n";
    }

    exit;
}

END {
    kill TERM => $pid;
}

close $socket;

my @requests = (
    'http://localhost/?foo=bar',
    'http://localhost/',
    'http://localhost/?foo=baz',
);

my $regexp = qr<\Ahttp://localhost/(?:\?([^#]*))?\z>x;

foreach my $uri (@requests) {
    my ($query) = $uri =~ $regexp
      or die qq<Could not math '$uri' with $regexp>;

    my %params = (
        GATEWAY_INTERFACE => 'CGI/1.1',
        HTTP_HOST         => 'localhost',
        HTTPS             => 'OFF',
        PATH_INFO         => '',
        REQUEST_METHOD    => 'GET',
        REQUEST_URI       => $uri,
        SCRIPT_NAME       => '',
        SERVER_NAME       => 'localhost',
        SERVER_PORT       => 80,
        SERVER_PROTOCOL   => 'HTTP/1.1',
    );

    $params{QUERY_STRING} = $query
      if $query;

    $socket = IO::Socket::INET->new(
       PeerHost => $host,
       PeerPort => $port,
    ) or die qq<Couldn connect to '$host:$port': '$@'>;

    use warnings FATAL => 'Net::FastCGI::IO';

    write_record($socket, FCGI_BEGIN_REQUEST, 1,
       build_begin_request_body(FCGI_RESPONDER, 0));

    write_record($socket, FCGI_PARAMS, 1,
       build_params(\%params));

    write_record($socket, FCGI_PARAMS, 1, '');
    write_record($socket, FCGI_STDIN, 1, '');

    my $done   = 0;
    my $stdout = '';
    while (!$done) {
        my ($type, $id, $content) = read_record($socket)
          or last;

        if ($type == FCGI_STDOUT) {
            $stdout .= $content;
        }
        elsif ($type == FCGI_STDERR) {
            print STDERR $content;
        }
        elsif ($type == FCGI_END_REQUEST) {
            $done = 1;
        }
        else {
            die qq<Unexpected FastCGI record type > . get_type_name($type);
        }
    }

    die q<Premature end of FastCGI request>
      unless $done;

    close $socket;

    $stdout =~ s/\A(?:[^\r\n]+\r?\n)*\r?\n//;
    print "<$uri>:\n$stdout\n";
}