Adding debian version 2.4.38-3+deb10u8.debian/2.4.38-3+deb10u8debian

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 1258 insertions, 0 deletions

diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
new file mode 100644
index 0000000..55d32c8
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
@@ -0,0 +1,1258 @@
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements.  See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License.  You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+package Apache::TestRequest;
+
+use strict;
+use warnings FATAL => 'all';
+
+BEGIN {
+    $ENV{PERL_LWP_USE_HTTP_10}   = 1;    # default to http/1.0
+    $ENV{APACHE_TEST_HTTP_09_OK} ||= 0;  # 0.9 responses are ok
+}
+
+use Apache::Test ();
+use Apache::TestConfig ();
+
+use Carp;
+
+use constant TRY_TIMES => 200;
+use constant INTERP_KEY => 'X-PerlInterpreter';
+use constant UA_TIMEOUT => 60 * 10; #longer timeout for debugging
+
+my $have_lwp = 0;
+
+# APACHE_TEST_PRETEND_NO_LWP=1 pretends that LWP is not available so
+# one can test whether the test suite survives if the user doesn't
+# have lwp installed
+unless ($ENV{APACHE_TEST_PRETEND_NO_LWP}) {
+    $have_lwp = eval {
+        require LWP::UserAgent;
+        require HTTP::Request::Common;
+
+        unless (defined &HTTP::Request::Common::OPTIONS) {
+            package HTTP::Request::Common;
+            no strict 'vars';
+            *OPTIONS = sub { _simple_req(OPTIONS => @_) };
+            push @EXPORT, 'OPTIONS';
+        }
+        1;
+    };
+}
+
+unless ($have_lwp) {
+    require Apache::TestClient;
+}
+
+sub has_lwp { $have_lwp }
+
+unless ($have_lwp) {
+    #need to define the shortcuts even though the wont be used
+    #so Perl can parse test scripts
+    @HTTP::Request::Common::EXPORT = qw(GET HEAD POST PUT OPTIONS);
+}
+
+sub install_http11 {
+    eval {
+        die "no LWP" unless $have_lwp;
+        LWP->VERSION(5.60); #minimal version
+        require LWP::Protocol::http;
+        #LWP::Protocol::http10 is used by default
+        LWP::Protocol::implementor('http', 'LWP::Protocol::http');
+    };
+}
+
+use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP);
+
+require Exporter;
+*import = \&Exporter::import;
+@EXPORT = @HTTP::Request::Common::EXPORT;
+
+@ISA = qw(LWP::UserAgent);
+
+my $UA;
+my $REDIR = $have_lwp ? undef : 1;
+my $conn_opts = {};
+
+sub module {
+    my $module = shift;
+    $Apache::TestRequest::Module = $module if $module;
+    $Apache::TestRequest::Module;
+}
+
+sub scheme {
+    my $scheme = shift;
+    $Apache::TestRequest::Scheme = $scheme if $scheme;
+    $Apache::TestRequest::Scheme;
+}
+
+sub module2path {
+    my $package = shift;
+
+    # httpd (1.3 && 2) / winFU have problems when the first path's
+    # segment includes ':' (security precaution which breaks the rfc)
+    # so we can't use /TestFoo::bar as path_info
+    (my $path = $package) =~ s/::/__/g;
+
+    return $path;
+}
+
+sub module2url {
+    my $module   = shift;
+    my $opt      = shift || {};
+    my $scheme   = $opt->{scheme} || 'http';
+    my $path     = exists $opt->{path} ? $opt->{path} : module2path($module);
+
+    module($module);
+
+    my $config   = Apache::Test::config();
+    my $hostport = hostport($config);
+
+    $path =~ s|^/||;
+    return "$scheme://$hostport/$path";
+}
+
+sub user_agent {
+    my $args = {@_};
+
+    if (delete $args->{reset}) {
+        $UA = undef;
+    }
+
+    if (exists $args->{requests_redirectable}) {
+        my $redir = $args->{requests_redirectable};
+        if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
+            # Set our internal flag if there's no LWP.
+            $REDIR = $have_lwp ? undef : 1;
+        } elsif ($redir) {
+            if ($have_lwp) {
+                $args->{requests_redirectable} = [ qw/GET HEAD POST/ ];
+                $REDIR = undef;
+            } else {
+                # Set our internal flag.
+                $REDIR = 1;
+            }
+        } else {
+            # Make sure our internal flag is false if there's no LWP.
+            $REDIR = $have_lwp ? undef : 0;
+        }
+    }
+
+    $args->{keep_alive} ||= $ENV{APACHE_TEST_HTTP11};
+
+    if ($args->{keep_alive}) {
+        install_http11();
+        eval {
+            require LWP::Protocol::https; #https10 is the default
+            LWP::Protocol::implementor('https', 'LWP::Protocol::https');
+        };
+    }
+
+    # in LWP 6, verify_hostname defaults to on, so SSL_ca_file
+    # needs to be set accordingly
+    if ($have_lwp and $LWP::VERSION >= 6.0 and not exists $args->{ssl_opts}->{SSL_ca_file}) {
+        my $vars = Apache::Test::vars();
+        my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
+        $args->{ssl_opts}->{SSL_ca_file} = $cafile;
+        # IO::Socket:SSL raw socket compatibility
+        $conn_opts->{SSL_ca_file} = $cafile;
+    }
+
+    eval { $UA ||= __PACKAGE__->new(%$args); };
+}
+
+sub user_agent_request_num {
+    my $res = shift;
+    $res->header('Client-Request-Num') ||  #lwp 5.60
+        $res->header('Client-Response-Num'); #lwp 5.62+
+}
+
+sub user_agent_keepalive {
+    $ENV{APACHE_TEST_HTTP11} = shift;
+}
+
+sub do_request {
+    my($ua, $method, $url, $callback) = @_;
+    my $r = HTTP::Request->new($method, resolve_url($url));
+    my $response = $ua->request($r, $callback);
+    lwp_trace($response);
+}
+
+sub hostport {
+    my $config = shift || Apache::Test::config();
+    my $vars = $config->{vars};
+    local $vars->{scheme} =
+        $Apache::TestRequest::Scheme || $vars->{scheme};
+    my $hostport = $config->hostport;
+
+    my $default_hostport = join ':', $vars->{servername}, $vars->{port};
+    if (my $module = $Apache::TestRequest::Module) {
+        $hostport = $module eq 'default'
+            ? $default_hostport
+            : $config->{vhosts}->{$module}->{hostport};
+    }
+
+    $hostport || $default_hostport;
+}
+
+sub resolve_url {
+    my $url = shift;
+    Carp::croak("no url passed") unless defined $url;
+
+    return $url if $url =~ m,^(\w+):/,;
+    $url = "/$url" unless $url =~ m,^/,;
+
+    my $vars = Apache::Test::vars();
+
+    local $vars->{scheme} =
+      $Apache::TestRequest::Scheme || $vars->{scheme} || 'http';
+
+    scheme_fixup($vars->{scheme});
+
+    my $hostport = hostport();
+
+    return "$vars->{scheme}://$hostport$url";
+}
+
+my %wanted_args = map {$_, 1} qw(username password realm content filename
+                                 redirect_ok cert);
+
+sub wanted_args {
+    \%wanted_args;
+}
+
+sub redirect_ok {
+    my $self = shift;
+    if ($have_lwp) {
+        # Return user setting or let LWP handle it.
+        return $RedirectOK if defined $RedirectOK;
+        return $self->SUPER::redirect_ok(@_);
+    }
+
+    # No LWP. We don't support redirect on POST.
+    return 0 if $self->method eq 'POST';
+    # Return user setting or our internal calculation.
+    return $RedirectOK if defined $RedirectOK;
+    return $REDIR;
+}
+
+my %credentials;
+
+#subclass LWP::UserAgent
+sub new {
+    my $self = shift->SUPER::new(@_);
+
+    lwp_debug(); #init from %ENV (set by Apache::TestRun)
+
+    my $config = Apache::Test::config();
+    if (my $proxy = $config->configure_proxy) {
+        #t/TEST -proxy
+        $self->proxy(http => "http://$proxy");
+    }
+
+    $self->timeout(UA_TIMEOUT);
+
+    $self;
+}
+
+sub credentials {
+    my $self = shift;
+    return $self->get_basic_credentials(@_);
+}
+
+sub get_basic_credentials {
+    my($self, $realm, $uri, $proxy) = @_;
+
+    for ($realm, '__ALL__') {
+        next unless $_ && $credentials{$_};
+        return @{ $credentials{$_} };
+    }
+
+    return (undef,undef);
+}
+
+sub vhost_socket {
+    my $module = shift;
+    local $Apache::TestRequest::Module = $module if $module;
+
+    my $hostport = hostport(Apache::Test::config());
+
+    my($host, $port) = split ':', $hostport;
+    my(%args) = (PeerAddr => $host, PeerPort => $port);
+
+    if ($module and ($module =~ /ssl/ || $module eq 'h2')) {
+        require IO::Socket::SSL;
+        # Add all conn_opts to args
+        map {$args{$_} = $conn_opts->{$_}} keys %{$conn_opts};
+        return IO::Socket::SSL->new(%args, Timeout => UA_TIMEOUT);
+    }
+    else {
+        require IO::Socket;
+        return IO::Socket::INET->new(%args);
+    }
+}
+
+#IO::Socket::SSL::getline does not correctly handle OpenSSL *_WANT_*.
+#Could care less about performance here, just need a getline()
+#that returns the same results with or without ssl.
+#Inspired from Net::SSLeay::ssl_read_all().
+my %getline = (
+    'IO::Socket::SSL' => sub {
+        my $self = shift;
+        # _get_ssl_object in IO::Socket::SSL only meant for internal use!
+        # But we need to compensate for unsufficient getline impl there.
+        my $ssl = $self->_get_ssl_object;
+        my ($got, $rv, $errs);
+        my $reply = '';
+    
+        while (1) {
+            ($got, $rv) = Net::SSLeay::read($ssl, 1);
+            if (! defined $got) {
+                my $err = Net::SSLeay::get_error($ssl, $rv);
+                if ($err != Net::SSLeay::ERROR_WANT_READ() and
+                    $err != Net::SSLeay::ERROR_WANT_WRITE()) {
+                    $errs = Net::SSLeay::print_errs('SSL_read');
+                    last;
+                }
+                next;
+            }
+            last if $got eq '';  # EOF
+            $reply .= $got;
+            last if $got eq "\n";
+        }
+
+        wantarray ? ($reply, $errs) : $reply;
+    },
+);
+
+sub getline {
+    my $sock = shift;
+    my $class = ref $sock;
+    my $method = $getline{$class} || 'getline';
+    $sock->$method();
+}
+
+sub socket_trace {
+    my $sock = shift;
+    return unless $sock->can('get_peer_certificate');
+
+    #like having some -v info
+    my $cert = $sock->get_peer_certificate;
+    print "#Cipher:  ", $sock->get_cipher, "\n";
+    print "#Peer DN: ", $cert->subject_name, "\n";
+}
+
+sub prepare {
+    my $url = shift;
+
+    if ($have_lwp) {
+        user_agent();
+        $url = resolve_url($url);
+    }
+    else {
+        lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP};
+    }
+
+    my($pass, $keep) = Apache::TestConfig::filter_args(\@_, \%wanted_args);
+
+    %credentials = ();
+    if (defined $keep->{username}) {
+        $credentials{$keep->{realm} || '__ALL__'} =
+          [$keep->{username}, $keep->{password}];
+    }
+    if (defined(my $content = $keep->{content})) {
+        if ($content eq '-') {
+            $content = join '', <STDIN>;
+        }
+        elsif ($content =~ /^x(\d+)$/) {
+            $content = 'a' x $1;
+        }
+        push @$pass, content => $content;
+    }
+    if (exists $keep->{cert}) {
+        set_client_cert($keep->{cert});
+    }
+
+    return ($url, $pass, $keep);
+}
+
+sub UPLOAD {
+    my($url, $pass, $keep) = prepare(@_);
+
+    local $RedirectOK = exists $keep->{redirect_ok}
+        ? $keep->{redirect_ok}
+        : $RedirectOK;
+
+    if ($keep->{filename}) {
+        return upload_file($url, $keep->{filename}, $pass);
+    }
+    else {
+        return upload_string($url, $keep->{content});
+    }
+}
+
+sub UPLOAD_BODY {
+    UPLOAD(@_)->content;
+}
+
+sub UPLOAD_BODY_ASSERT {
+    content_assert(UPLOAD(@_));
+}
+
+#lwp only supports files
+sub upload_string {
+    my($url, $data) = @_;
+
+    my $CRLF = "\015\012";
+    my $bound = 742617000027;
+    my $req = HTTP::Request->new(POST => $url);
+
+    my $content = join $CRLF,
+      "--$bound",
+      "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"",
+      "Content-Type: text/plain", "",
+      $data, "--$bound--", "";
+
+    $req->header("Content-Length", length($content));
+    $req->content_type("multipart/form-data; boundary=$bound");
+    $req->content($content);
+
+    $UA->request($req);
+}
+
+sub upload_file {
+    my($url, $file, $args) = @_;
+
+    my $content = [@$args, filename => [$file]];
+
+    $UA->request(HTTP::Request::Common::POST($url,
+                 Content_Type => 'form-data',
+                 Content      => $content,
+    ));
+}
+
+#useful for POST_HEAD and $DebugLWP (see below)
+sub lwp_as_string {
+    my($r, $want_body) = @_;
+    my $content = $r->content;
+
+    unless ($r->isa('HTTP::Request') or
+            $r->header('Content-Length') or
+            $r->header('Transfer-Encoding'))
+    {
+        $r->header('Content-Length' => length $content);
+        $r->header('X-Content-length-note' => 'added by Apache::TestRequest');
+    }
+
+    $r->content('') unless $want_body;
+
+    (my $string = $r->as_string) =~ s/^/\#/mg;
+    $r->content($content); #reset
+    $string;
+}
+
+$DebugLWP = 0; #1 == print METHOD URL and header response for all requests
+               #2 == #1 + response body
+               #other == passed to LWP::Debug->import
+
+sub lwp_debug {
+    package main; #wtf: else package in perldb changes
+    my $val = $_[0] || $ENV{APACHE_TEST_DEBUG_LWP};
+
+    return unless $val;
+
+    if ($val =~ /^\d+$/) {
+        $Apache::TestRequest::DebugLWP = $val;
+        return "\$Apache::TestRequest::DebugLWP = $val\n";
+    }
+    else {
+        my(@args) = @_ ? @_ : split /\s+/, $val;
+        require LWP::Debug;
+        LWP::Debug->import(@args);
+        return "LWP::Debug->import(@args)\n";
+    }
+}
+
+sub lwp_trace {
+    my $r = shift;
+
+    unless ($r->request->protocol) {
+        #lwp always sends a request, but never sets
+        #$r->request->protocol, happens deeper in the
+        #LWP::Protocol::http* modules
+        my $proto = user_agent_request_num($r) ? "1.1" : "1.0";
+        $r->request->protocol("HTTP/$proto");
+    }
+
+    my $want_body = $DebugLWP > 1;
+    print "#lwp request:\n",
+      lwp_as_string($r->request, $want_body);
+
+    print "#server response:\n",
+      lwp_as_string($r, $want_body);
+}
+
+sub lwp_call {
+    my($name, $shortcut) = (shift, shift);
+
+    my $r = (\&{$name})->(@_);
+
+    Carp::croak("$name(@_) didn't return a response object") unless $r;
+
+    my $error = "";
+    unless ($shortcut) {
+        #GET, HEAD, POST
+        if ($r->method eq "POST" && !defined($r->header("Content-Length"))) {
+            $r->header('Content-Length' => length($r->content));
+        }
+        $r = $UA ? $UA->request($r) : $r;
+        my $proto = $r->protocol;
+        if (defined($proto)) {
+            if ($proto !~ /^HTTP\/(\d\.\d)$/) {
+                $error = "response had no protocol (is LWP broken or something?)";
+            }
+            if ($1 ne "1.0" && $1 ne "1.1") {
+                $error = "response had protocol HTTP/$1 (headers not sent?)"
+                    unless ($1 eq "0.9" && $ENV{APACHE_TEST_HTTP_09_OK});
+            }
+        }
+    }
+
+    if ($DebugLWP and not $shortcut) {
+        lwp_trace($r);
+    }
+
+    Carp::croak($error) if $error;
+
+    return $shortcut ? $r->$shortcut() : $r;
+}
+
+my %shortcuts = (RC   => sub { shift->code },
+                 OK   => sub { shift->is_success },
+                 STR  => sub { shift->as_string },
+                 HEAD => sub { lwp_as_string(shift, 0) },
+                 BODY => sub { shift->content },
+                 BODY_ASSERT => sub { content_assert(shift) },
+);
+
+for my $name (@EXPORT) {
+    my $package = $have_lwp ?
+      'HTTP::Request::Common': 'Apache::TestClient';
+
+    my $method = join '::', $package, $name;
+    no strict 'refs';
+
+    next unless defined &$method;
+
+    *$name = sub {
+        my($url, $pass, $keep) = prepare(@_);
+        local $RedirectOK = exists $keep->{redirect_ok}
+            ? $keep->{redirect_ok}
+            : $RedirectOK;
+        return lwp_call($method, undef, $url, @$pass);
+    };
+
+    while (my($shortcut, $cv) = each %shortcuts) {
+        my $alias = join '_', $name, $shortcut;
+        *$alias = sub { lwp_call($name, $cv, @_) };
+    }
+}
+
+my @export_std = @EXPORT;
+for my $method (@export_std) {
+    push @EXPORT, map { join '_', $method, $_ } keys %shortcuts;
+}
+
+push @EXPORT, qw(UPLOAD UPLOAD_BODY UPLOAD_BODY_ASSERT);
+
+sub to_string {
+    my $obj = shift;
+    ref($obj) ? $obj->as_string : $obj;
+}
+
+# request an interpreter instance and use this interpreter id to
+# select the same interpreter in requests below
+sub same_interp_tie {
+    my($url) = @_;
+
+    my $res = GET($url, INTERP_KEY, 'tie');
+    unless ($res->code == 200) {
+        die sprintf "failed to init the same_handler data (url=%s). " .
+            "Failed with code=%s, response:\n%s",
+                $url, $res->code, $res->content;
+    }
+    my $same_interp = $res->header(INTERP_KEY);
+
+    return $same_interp;
+}
+
+# run the request though the selected perl interpreter, by polling
+# until we found it
+# currently supports only GET, HEAD, PUT, POST subs
+sub same_interp_do {
+    my($same_interp, $sub, $url, @args) = @_;
+
+    die "must pass an interpreter id, obtained via same_interp_tie()"
+        unless defined $same_interp and $same_interp;
+
+    push @args, (INTERP_KEY, $same_interp);
+
+    my $res      = '';
+    my $times    = 0;
+    my $found_same_interp = '';
+    do {
+        #loop until we get a response from our interpreter instance
+        $res = $sub->($url, @args);
+        die "no result" unless $res;
+        my $code = $res->code;
+        if ($code == 200) {
+            $found_same_interp = $res->header(INTERP_KEY) || '';
+        }
+        elsif ($code == 404) {
+            # try again
+        }
+        else {
+            die sprintf "failed to run the request (url=%s):\n" .
+                "code=%s, response:\n%s", $url, $code, $res->content;
+        }
+
+        unless ($found_same_interp eq $same_interp) {
+            $found_same_interp = '';
+        }
+
+        if ($times++ > TRY_TIMES) { #prevent endless loop
+            die "unable to find interp $same_interp\n";
+        }
+    } until ($found_same_interp);
+
+    return $found_same_interp ? $res : undef;
+}
+
+
+sub set_client_cert {
+    my $name = shift;
+    my $vars = Apache::Test::vars();
+    my $dir = join '/', $vars->{sslca}, $vars->{sslcaorg};
+
+    if ($name) {
+        my ($cert, $key) = ("$dir/certs/$name.crt", "$dir/keys/$name.pem");
+        # IO::Socket:SSL raw socket compatibility
+        $conn_opts->{SSL_cert_file} = $cert;
+        $conn_opts->{SSL_key_file} = $key;
+        if ($LWP::VERSION >= 6.0) {
+            # IO::Socket:SSL doesn't look at environment variables
+            if ($UA) {
+                $UA->ssl_opts(SSL_cert_file => $cert);
+                $UA->ssl_opts(SSL_key_file  => $key);
+            } else {
+                user_agent(ssl_opts => { SSL_cert_file => $cert,
+                                         SSL_key_file  => $key });
+            }
+        }
+    }
+    else {
+        # IO::Socket:SSL raw socket compatibility
+        $conn_opts->{SSL_cert_file} = undef;
+        $conn_opts->{SSL_key_file} = undef;
+        if ($LWP::VERSION >= 6.0 and $UA) {
+            $UA->ssl_opts(SSL_cert_file => undef);
+            $UA->ssl_opts(SSL_key_file  => undef);
+        }
+    }
+}
+
+# Only for IO::Socket:SSL raw socket compatibility,
+# when using user_agent() already done in its
+# constructor.
+sub set_ca_cert {
+    my $vars = Apache::Test::vars();
+    my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
+    $conn_opts->{SSL_ca_file} = $cafile;
+}
+
+#want news: urls to work with the LWP shortcuts
+#but cant find a clean way to override the default nntp port
+#by brute force we trick Net::NTTP into calling FixupNNTP::new
+#instead of IO::Socket::INET::new, we fixup the args then forward
+#to IO::Socket::INET::new
+
+#also want KeepAlive on for Net::HTTP
+#XXX libwww-perl 5.53_xx has: LWP::UserAgent->new(keep_alive => 1);
+
+sub install_net_socket_new {
+    my($module, $code) = @_;
+
+    return unless Apache::Test::have_module($module);
+
+    no strict 'refs';
+
+    my $new;
+    my $isa = \@{"$module\::ISA"};
+
+    for (@$isa) {
+        last if $new = $_->can('new');
+    }
+
+    my $fixup_class = "Apache::TestRequest::$module";
+    unshift @$isa, $fixup_class;
+
+    *{"$fixup_class\::new"} = sub {
+        my $class = shift;
+        my $args = {@_};
+        $code->($args);
+        return $new->($class, %$args);
+    };
+}
+
+my %scheme_fixups = (
+    'news' => sub {
+        return if $INC{'Net/NNTP.pm'};
+        eval {
+            install_net_socket_new('Net::NNTP' => sub {
+                my $args = shift;
+                my($host, $port) = split ':',
+                  Apache::TestRequest::hostport();
+                $args->{PeerPort} = $port;
+                $args->{PeerAddr} = $host;
+            });
+        };
+    },
+);
+
+sub scheme_fixup {
+    my $scheme = shift;
+    my $fixup = $scheme_fixups{$scheme};
+    return unless $fixup;
+    $fixup->();
+}
+
+# when the client side simply prints the response body which should
+# include the test's output, we need to make sure that the request
+# hasn't failed, or the test will be skipped instead of indicating the
+# error.
+sub content_assert {
+    my $res = shift;
+
+    return $res->content if $res->is_success;
+
+    die join "\n",
+        "request has failed (the response code was: " . $res->code . ")",
+        "see t/logs/error_log for more details\n";
+}
+
+1;
+
+=head1 NAME
+
+Apache::TestRequest - Send requests to your Apache test server
+
+=head1 SYNOPSIS
+
+  use Apache::Test qw(ok have_lwp);
+  use Apache::TestRequest qw(GET POST);
+  use Apache::Constants qw(HTTP_OK);
+
+  plan tests => 1, have_lwp;
+
+  my $res = GET '/test.html';
+  ok $res->code == HTTP_OK, "Request is ok";
+
+=head1 DESCRIPTION
+
+B<Apache::TestRequest> provides convenience functions to allow you to
+make requests to your Apache test server in your test scripts. It
+subclasses C<LWP::UserAgent>, so that you have access to all if its
+methods, but also exports a number of useful functions likely useful
+for majority of your test requests. Users of the old C<Apache::test>
+(or C<Apache::testold>) module, take note! Herein lie most of the
+functions you'll need to use to replace C<Apache::test> in your test
+suites.
+
+Each of the functions exported by C<Apache::TestRequest> uses an
+C<LWP::UserAgent> object to submit the request and retrieve its
+results. The return value for many of these functions is an
+HTTP::Response object. See L<HTTP::Response|HTTP::Response> for
+documentation of its methods, which you can use in your tests. For
+example, use the C<code()> and C<content()> methods to test the
+response code and content of your request. Using C<GET>, you can
+perform a couple of tests using these methods like this:
+
+  use Apache::Test qw(ok have_lwp);
+  use Apache::TestRequest qw(GET POST);
+  use Apache::Constants qw(HTTP_OK);
+
+  plan tests => 2, have_lwp;
+
+  my $uri = "/test.html?foo=1&bar=2";
+  my $res = GET $uri;
+  ok $res->code == HTTP_OK, "Check that the request was OK";
+  ok $res->content eq "foo => 1, bar => 2", "Check its content";
+
+Note that you can also use C<Apache::TestRequest> with
+C<Test::Builder> and its derivatives, including C<Test::More>:
+
+  use Test::More;
+  # ...
+  is $res->code, HTTP_OK, "Check that the request was OK";
+  is $res->content, "foo => 1, bar => 2", "Check its content";
+
+=head1 CONFIGURATION FUNCTION
+
+You can tell C<Apache::TestRequest> what kind of C<LWP::UserAgent>
+object to use for its convenience functions with C<user_agent()>. This
+function uses its arguments to construct an internal global
+C<LWP::UserAgent> object that will be used for all subsequent requests
+made by the convenience functions. The arguments it takes are the same
+as for the C<LWP::UserAgent> constructor. See the
+C<L<LWP::UserAgent|LWP::UserAgent>> documentation for a complete list.
+
+The C<user_agent()> function only creates the internal
+C<LWP::UserAgent> object the first time it is called. Since this
+function is called internally by C<Apache::TestRequest>, you should
+always use the C<reset> parameter to force it to create a new global
+C<LWP::UserAgent> Object:
+
+  Apache::TestRequest::user_agent(reset => 1, %params);
+
+C<user_agent()> differs from C<< LWP::UserAgent->new >> in two
+additional ways. First, it supports an additional parameter,
+C<keep_alive>, which enables connection persistence, where the same
+connection is used to process multiple requests (and, according to the
+C<L<LWP::UserAgent|LWP::UserAgent>> documentation, has the effect of
+loading and enabling the new experimental HTTP/1.1 protocol module).
+
+And finally, the semantics of the C<requests_redirectable> parameter is
+different than for C<LWP::UserAgent> in that you can pass it a boolean
+value as well as an array for C<LWP::UserAgent>. To force
+C<Apache::TestRequest> not to follow redirects in any of its convenience
+functions, pass a false value to C<requests_redirectable>:
+
+  Apache::TestRequest::user_agent(reset => 1,
+                                  requests_redirectable => 0);
+
+If LWP is not installed, then you can still pass in an array reference
+as C<LWP::UserAgent> expects. C<Apache::TestRequest> will examine the
+array and allow redirects if the array contains more than one value or
+if there is only one value and that value is not "POST":
+
+  # Always allow redirection.
+  my $redir = have_lwp() ? [qw(GET HEAD POST)] : 1;
+  Apache::TestRequest::user_agent(reset => 1,
+                                  requests_redirectable => $redir);
+
+But note that redirection will B<not> work with C<POST> unless LWP is
+installed. It's best, therefore, to check C<have_lwp> before running
+tests that rely on a redirection from C<POST>.
+
+Sometimes it is desireable to have C<Apache::TestRequest> remember
+cookies sent by the pages you are testing and send them back to the
+server on subsequent requests. This is especially necessary when
+testing pages whose functionality relies on sessions or the presence
+of preferences stored in cookies.
+
+By default, C<LWP::UserAgent> does B<not> remember cookies between
+requests. You can tell it to remember cookies between request by
+adding:
+
+  Apache::TestRequest::user_agent(cookie_jar => {});
+
+before issuing the requests.
+
+
+=head1 FUNCTIONS
+
+C<Apache::TestRequest> exports a number of functions that will likely
+prove convenient for use in the majority of your request tests.
+
+
+
+
+=head2 Optional Parameters
+
+Each function also takes a number of optional arguments.
+
+=over 4
+
+=item redirect_ok
+
+By default a request will follow redirects retrieved from the server. To
+prevent this behavior, pass a false value to a C<redirect_ok>
+parameter:
+
+  my $res = GET $uri, redirect_ok => 0;
+
+Alternately, if all of your tests need to disable redirects, tell
+C<Apache::TestRequest> to use an C<LWP::UserAgent> object that
+disables redirects:
+
+  Apache::TestRequest::user_agent( reset => 1,
+                                   requests_redirectable => 0 );
+
+=item cert
+
+If you need to force an SSL request to use a particular SSL
+certificate, pass the name of the certificate via the C<cert>
+parameter:
+
+  my $res = GET $uri, cert => 'my_cert';
+
+=item content
+
+If you need to add content to your request, use the C<content>
+parameter:
+
+  my $res = GET $uri, content => 'hello world!';
+
+=item filename
+
+The name of a local file on the file system to be sent to the Apache
+test server via C<UPLOAD()> and its friends.
+
+=back
+
+=head2 The Functions
+
+=head3 GET
+
+  my $res = GET $uri;
+
+Sends a simple GET request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+You can also supply additional headers to be sent with the request by
+adding their name/value pairs after the C<url> parameter, for example:
+
+  my $res = GET $url, 'Accept-Language' => 'de,en-us,en;q=0.5';
+
+=head3 GET_STR
+
+A shortcut function for C<GET($uri)-E<gt>as_string>.
+
+=head3 GET_BODY
+
+A shortcut function for C<GET($uri)-E<gt>content>.
+
+=head3 GET_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<GET_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<GET_BODY> would.
+
+=head3 GET_OK
+
+A shortcut function for C<GET($uri)-E<gt>is_success>.
+
+=head3 GET_RC
+
+A shortcut function for C<GET($uri)-E<gt>code>.
+
+=head3 GET_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<GET_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 HEAD
+
+  my $res = HEAD $uri;
+
+Sends a HEAD request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+=head3 HEAD_STR
+
+A shortcut function for C<HEAD($uri)-E<gt>as_string>.
+
+=head3 HEAD_BODY
+
+A shortcut function for C<HEAD($uri)-E<gt>content>. Of course, this
+means that it will likely return nothing.
+
+=head3 HEAD_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<HEAD_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<HEAD_BODY> would.
+
+=head3 HEAD_OK
+
+A shortcut function for C<GET($uri)-E<gt>is_success>.
+
+=head3 HEAD_RC
+
+A shortcut function for C<GET($uri)-E<gt>code>.
+
+=head3 HEAD_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<GET_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 PUT
+
+  my $res = PUT $uri;
+
+Sends a simple PUT request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+=head3 PUT_STR
+
+A shortcut function for C<PUT($uri)-E<gt>as_string>.
+
+=head3 PUT_BODY
+
+A shortcut function for C<PUT($uri)-E<gt>content>.
+
+=head3 PUT_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<PUT_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<PUT_BODY> would.
+
+=head3 PUT_OK
+
+A shortcut function for C<PUT($uri)-E<gt>is_success>.
+
+=head3 PUT_RC
+
+A shortcut function for C<PUT($uri)-E<gt>code>.
+
+=head3 PUT_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<PUT_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 POST
+
+  my $res = POST $uri, [ arg => $val, arg2 => $val ];
+
+Sends a POST request to the Apache test server and returns an
+C<HTTP::Response> object. An array reference of parameters passed as
+the second argument will be submitted to the Apache test server as the
+POST content. Parameters corresponding to those documented in
+L<Optional Parameters|/Optional
+Parameters> can follow the optional array reference of parameters, or after
+C<$uri>.
+
+To upload a chunk of data, simply use:
+
+  my $res = POST $uri, content => $data;
+
+=head3 POST_STR
+
+A shortcut function for C<POST($uri, @args)-E<gt>content>.
+
+=head3 POST_BODY
+
+A shortcut function for C<POST($uri, @args)-E<gt>content>.
+
+=head3 POST_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<POST_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<POST_BODY> would.
+
+=head3 POST_OK
+
+A shortcut function for C<POST($uri, @args)-E<gt>is_success>.
+
+=head3 POST_RC
+
+A shortcut function for C<POST($uri, @args)-E<gt>code>.
+
+=head3 POST_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<POST_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 UPLOAD
+
+  my $res = UPLOAD $uri, \@args, filename => $filename;
+
+Sends a request to the Apache test server that includes an uploaded
+file. Other POST parameters can be passed as a second argument as an
+array reference.
+
+C<Apache::TestRequest> will read in the contents of the file named via
+the C<filename> parameter for submission to the server. If you'd
+rather, you can submit use the C<content> parameter instead of
+C<filename>, and its value will be submitted to the Apache server as
+file contents:
+
+  my $res = UPLOAD $uri, undef, content => "This is file content";
+
+The name of the file sent to the server will simply be "b". Note that
+in this case, you cannot pass other POST arguments to C<UPLOAD()> --
+they would be ignored.
+
+=head3 UPLOAD_BODY
+
+A shortcut function for C<UPLOAD($uri, @params)-E<gt>content>.
+
+=head3 UPLOAD_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<UPLOAD_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<UPLOAD_BODY> would.
+
+=head3 OPTIONS
+
+  my $res = OPTIONS $uri;
+
+Sends an C<OPTIONS> request to the Apache test server. Returns an
+C<HTTP::Response> object with the I<Allow> header, indicating which
+methods the server supports. Possible methods include C<OPTIONS>,
+C<GET>, C<HEAD> and C<POST>. This function thus can be useful for
+testing what options the Apache server supports. Consult the HTTPD 1.1
+specification, section 9.2, at
+I<http://www.faqs.org/rfcs/rfc2616.html> for more information.
+
+
+
+
+
+=head2 URL Manipulation Functions
+
+C<Apache::TestRequest> also includes a few helper functions to aid in
+the creation of urls used in the functions above.
+
+
+
+=head3 C<module2path>
+
+  $path = Apache::TestRequest::module2path($module_name);
+
+Convert a module name to a path, safe for use in the various request
+methods above. e.g. C<::> can't be used in URLs on win32. For example:
+
+  $path = Apache::TestRequest::module2path('Foo::Bar');
+
+returns:
+
+  /Foo__Bar
+
+
+
+
+=head3 C<module2url>
+
+  $url = Apache::TestRequest::module2url($module);
+  $url = Apache::TestRequest::module2url($module, \%options);
+
+Convert a module name to a full URL including the current
+configurations C<hostname:port> and sets C<module> accordingly.
+
+  $url = Apache::TestRequest::module2url('Foo::Bar');
+
+returns:
+
+  http://$hostname:$port/Foo__Bar
+
+The default scheme used is C<http>. You can override this by passing
+your preferred scheme into an optional second param. For example:
+
+  $module = 'MyTestModule::TestHandler';
+  $url = Apache::TestRequest::module2url($module, {scheme => 'https'});
+
+returns:
+
+  https://$hostname:$port/MyTestModule__TestHandler
+
+You may also override the default path with a path of your own:
+
+  $module = 'MyTestModule::TestHandler';
+  $url = Apache::TestRequest::module2url($module, {path => '/foo'});
+
+returns:
+
+  http://$hostname:$port/foo
+
+
+
+
+
+=head1 ENVIRONMENT VARIABLES
+
+The following environment variables can affect the behavior of
+C<Apache::TestRequest>:
+
+=over
+
+=item APACHE_TEST_PRETEND_NO_LWP
+
+If the environment variable C<APACHE_TEST_PRETEND_NO_LWP> is set to a
+true value, C<Apache::TestRequest> will pretend that LWP is not
+available so one can test whether the test suite will survive on a
+system which doesn't have libwww-perl installed.
+
+=item APACHE_TEST_HTTP_09_OK
+
+If the environment variable C<APACHE_TEST_HTTP_09_OK> is set to a
+true value, C<Apache::TestRequest> will allow HTTP/0.9 responses
+from the server to proceed.  The default behavior is to die if
+the response protocol is not either HTTP/1.0 or HTTP/1.1.
+
+=back
+
+=head1 SEE ALSO
+
+L<Apache::Test|Apache::Test> is the main Apache testing module. Use it
+to set up your tests, create a plan, and to ensure that you have the
+Apache version and modules you need.
+
+Use L<Apache::TestMM|Apache::TestMM> in your I<Makefile.PL> to set up
+your distribution for testing.
+
+=head1 AUTHOR
+
+Doug MacEachern with contributions from Geoffrey Young, Philippe
+M. Chiasson, Stas Bekman and others. Documentation by David Wheeler.
+
+Questions can be asked at the test-dev <at> httpd.apache.org list. For
+more information see: I<http://httpd.apache.org/test/> and
+I<http://perl.apache.org/docs/general/testing/testing.html>.