X-Forwarded-For results from the CPAN

Perlbal
    $res->header("Server", "Perlbal") if $self->{service}{server_tokens};
    $res->header("Last-Modified", $lastmod);
    $res->header("Content-Type",   $mime);
    # has to happen after content-length is set to work:
    $self->setup_keepalive($res);
    return if $self->{service}->run_hook('modify_response_headers', $self);

    if ($hd->request_method eq "HEAD" || $not_mod) {
        # we can return already, since we know the size
        $self->tcp_cork(1);
        $self->state('xfer_resp');
        $self->write($res->to_string_ref);
        $self->write(sub { $self->http_response_sent; });
        return;
    }

    $self->tcp_cork(1);  # cork writes to self
    $self->write($res->to_string_ref);
    $self->state('wait_open');

    # gotta send all files, one by one...
    my @remain = @$filelist;
    $self->{post_sendfile_cb} = sub {
        unless (@remain) {
            $self->write(sub { $self->http_response_sent; });
            return;
        }

        my $file     = shift @remain;
        my $fullfile = "$basedir$file";
        my $size     = $stats->{$file}[7];

        Perlbal::AIO::aio_open($fullfile, 0, 0, sub {
            my $rp_fh = shift;

            # if client's gone, just close filehandle and abort
            if ($self->{closed}) {
                CORE::close($rp_fh) if $rp_fh;
                  return;
              }

            # handle errors
            if (! $rp_fh) {
                # couldn't open the file we had already successfully stat'ed.
                # FIXME: do 500 vs. 404 vs whatever based on $!
                return $self->close('aio_open_failure');
            }

            $self->{reproxy_file}     = $file;
            $self->reproxy_fh($rp_fh, $size);
        });
    };
    $self->{post_sendfile_cb}->();
}

sub check_req_headers {
    my Perlbal::ClientHTTPBase $self = shift;
    my Perlbal::HTTPHeaders $hds = $self->{req_headers};

    if ($self->{service}->trusted_ip($self->peer_ip_string)) {
        my @ips = split /,\s*/, ($hds->header("X-Forwarded-For") || '');

        # This list may be empty, and that's OK, in that case we should unset the
        # observed_ip_string, so no matter what we'll use the 0th element, whether
        # it happens to be an ip string, or undef.
        $self->observed_ip_string($ips[0]);
    }

    return;
}

sub try_index_files {
    my Perlbal::ClientHTTPBase $self = shift;
    my ($hd, $res, $uri, $filepos) = @_;

    # make sure this starts at 0 initially, and fail if it's past the end
    $filepos ||= 0;
    if ($filepos >= scalar(@{$self->{service}->{index_files} || []})) {
        unless ($self->{service}->{dirindexing}) {
            # just inform them that listing is disabled
            $self->_simple_response(200, "Directory listing disabled");
            return;
        }

        # ensure uri has one and only one trailing slash for better URLs
        $uri =~ s!/*$!/!;

        # open the directory and create an index
        my $body = "<html><body>";
        my $file = $self->{service}->{docroot} . $uri;

        $res->header("Content-Type", "text/html");
        opendir(D, $file);
        foreach my $de (sort readdir(D)) {
            if (-d "$file/$de") {
                $body .= "<b><a href='$uri$de/'>$de</a></b><br />\n";
            } else {
                $body .= "<a href='$uri$de'>$de</a><br />\n";
            }
        }
        closedir(D);

        $body .= "</body></html>";
        $res->header("Content-Length", length($body));
        $self->setup_keepalive($res);

        $self->state('xfer_resp');
        $self->tcp_cork(1);  # cork writes to self
        $self->write($res->to_string_ref);
        $self->write(\$body);
        $self->write(sub { $self->http_response_sent; });
        return;
    }

    # construct the file path we need to check
    my $file = $self->{service}->{index_files}->[$filepos];
    my $fullpath = $self->{service}->{docroot} . $uri . '/' . $file;

    # now see if it exists
    Perlbal::AIO::aio_stat($fullpath, sub {
        return if $self->{closed};
( run in 1.771 second using v1.01-cache-2.11-cpan-39bf76dae61 )