package LWP::Protocol::http;
use strict;
require LWP::Debug;
require HTTP::Response;
require HTTP::Status;
require Net::HTTP;
use vars qw(@ISA @EXTRA_SOCK_OPTS);
require LWP::Protocol;
@ISA = qw(LWP::Protocol);
my $CRLF = "\015\012";
sub _new_socket
{
my($self, $host, $port, $timeout) = @_;
my $conn_cache = $self->{ua}{conn_cache};
if ($conn_cache) {
if (my $sock = $conn_cache->withdraw("http", "$host:$port")) {
return $sock if $sock && !$sock->can_read(0);
# if the socket is readable, then either the peer has closed the
# connection or there are some garbage bytes on it. In either
# case we abandon it.
$sock->close;
}
}
local($^W) = 0; # IO::Socket::INET can be noisy
my $sock = $self->socket_class->new(PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp',
Timeout => $timeout,
KeepAlive => !!$conn_cache,
SendTE => 1,
$self->_extra_sock_opts($host, $port),
);
unless ($sock) {
# IO::Socket::INET leaves additional error messages in $@
$@ =~ s/^.*?: //;
die "Can't connect to $host:$port ($@)";
}
# perl 5.005's IO::Socket does not have the blocking method.
eval { $sock->blocking(0); };
$sock;
}
sub socket_class
{
my $self = shift;
(ref($self) || $self) . "::Socket";
}
sub _extra_sock_opts # to be overridden by subclass
{
return @EXTRA_SOCK_OPTS;
}
sub _check_sock
{
#my($self, $req, $sock) = @_;
}
sub _get_sock_info
{
my($self, $res, $sock) = @_;
if (defined(my $peerhost = $sock->peerhost)) {
$res->header("Client-Peer" => "$peerhost:" . $sock->peerport);
}
}
sub _fixup_header
{
my($self, $h, $url, $proxy) = @_;
# Extract 'Host' header
my $hhost = $url->authority;
if ($hhost =~ s/^([^\@]*)\@//) { # get rid of potential "user:pass@"
# add authorization header if we need them. HTTP URLs do
# not really support specification of user and password, but
# we allow it.
if (defined($1) && not $h->header('Authorization')) {
require URI::Escape;
$h->authorization_basic(map URI::Escape::uri_unescape($_),
split(":", $1, 2));
}
}
$h->init_header('Host' => $hhost);
if ($proxy) {
# Check the proxy URI's userinfo() for proxy credentials
# export http_proxy="http://proxyuser:proxypass@proxyhost:port"
my $p_auth = $proxy->userinfo();
if(defined $p_auth) {
require URI::Escape;
=1= |