[PATCH libwww-perl-5.41]: Allow https through proxy
David C Worenklein (dcw@gcm.com)
11 Dec 1998 12:20:22 -0500
There's also the beginning of "keep open" logic (required by WebSeal
https servers), but it's not yet implemented.
*** libwww-perl-5.41-patch/lib/LWP/Protocol/http.pm Wed Dec 2 17:06:37 1998
--- libwww-perl-5.41/lib/LWP/Protocol/http.pm Thu Nov 19 16:45:01 1998
***************
*** 48,109 ****
$sock->peerhost . ":" . $sock->peerport);
}
sub request
! {
! my($self, $request, $proxy, $arg, $size, $timeout, $socket_cache) = @_;
LWP::Debug::trace('()');
$size ||= 4096;
# check method
my $method = $request->method;
! unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
! return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
! 'Library does not allow method ' .
! "$method for 'http:' URLs";
}
my $url = $request->url;
my($host, $port, $fullpath);
- my $socket_id;
-
# Check if we're proxy'ing
if (defined $proxy) {
! # $proxy is an URL to an HTTP server which will proxy this request
! $host = $proxy->host;
! $port = $proxy->port;
! if ($method eq "CONNECT") {
! $fullpath = $url->host . ":" . $url->port;
! } else {
! $fullpath = $url->as_string;
! }
! } else {
! $host = $url->host;
! $port = $url->port;
! $fullpath = $url->path_query;
! $fullpath = "/" unless length $fullpath;
! }
!
! $socket_id = $url->host . ":" . $url->port;
!
! # connect to remote site (unless it was already done!)
! my ($socket, $keep_socket_open);
!
! if (defined($socket_cache) && defined($$socket_cache{$socket_id})) {
! $socket = $$socket_cache{$socket_id}[1];
! $$socket_cache{$socket_id}[0] = time; # Mark the cache
! $keep_socket_open=1;
! } else {
! $socket = $self->_new_socket($host, $port, $timeout);
! $keep_socket_open=0;
! }
!
! $self->_check_sock($request, $socket);
!
my $sel = IO::Select->new($socket) if $timeout;
my $request_line = "$method $fullpath HTTP/1.0$CRLF";
my $h = $request->headers->clone;
--- 48,92 ----
$sock->peerhost . ":" . $sock->peerport);
}
sub request
! {
! my($self, $request, $proxy, $arg, $size, $timeout) = @_;
LWP::Debug::trace('()');
$size ||= 4096;
# check method
my $method = $request->method;
! unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
! return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
! 'Library does not allow method ' .
! "$method for 'http:' URLs";
}
my $url = $request->url;
my($host, $port, $fullpath);
# Check if we're proxy'ing
if (defined $proxy) {
! # $proxy is an URL to an HTTP server which will proxy this request
! $host = $proxy->host;
! $port = $proxy->port;
! $fullpath = $url->as_string;
! }
! else {
! $host = $url->host;
! $port = $url->port;
! $fullpath = $url->path_query;
! $fullpath = "/" unless length $fullpath;
! }
!
! # connect to remote site
! my $socket = $self->_new_socket($host, $port, $timeout);
! $self->_check_sock($request, $socket);
!
my $sel = IO::Select->new($socket) if $timeout;
my $request_line = "$method $fullpath HTTP/1.0$CRLF";
my $h = $request->headers->clone;
***************
*** 112,166 ****
my $ctype = ref($cont_ref);
# If we're sending content we *have* to specify a content length
# otherwise the server won't know a messagebody is coming.
if ($ctype eq 'CODE') {
! die 'No Content-Length header for request with dynamic content'
unless defined($h->header('Content-Length')) ||
! $h->content_type =~ /^multipart\//;
! # For HTTP/1.1 we could have used chunked transfer encoding...
} else {
! $h->header('Content-Length' => length $$cont_ref)
! if defined($$cont_ref) && length($$cont_ref);
}
!
# HTTP/1.1 will require us to send the 'Host' header, so we might
# as well start now.
my $hhost = $url->authority;
$hhost =~ s/^([^\@]*)\@//; # get rid of potential "user:pass@"
$h->header('Host' => $hhost) unless defined $h->header('Host');
# 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')) {
! $h->authorization_basic($url->user, $url->password);
}
my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
! my $n; # used for return value from syswrite/sysread
die "write timeout" if $timeout && !$sel->can_write($timeout);
$n = $socket->syswrite($buf, length($buf));
die $! unless defined($n);
die "short write" unless $n == length($buf);
LWP::Debug::conns($buf);
if ($ctype eq 'CODE') {
! while ( ($buf = &$cont_ref()), defined($buf) && length($buf)) {
die "write timeout" if $timeout && !$sel->can_write($timeout);
$n = $socket->syswrite($buf, length($buf));
die $! unless defined($n);
die "short write" unless $n == length($buf);
LWP::Debug::conns($buf);
! }
} elsif (defined($$cont_ref) && length($$cont_ref)) {
! die "write timeout" if $timeout && !$sel->can_write($timeout);
! $n = $socket->syswrite($$cont_ref, length($$cont_ref));
! die $! unless defined($n);
! die "short write" unless $n == length($$cont_ref);
! LWP::Debug::conns($buf);
}
# read response line from server
LWP::Debug::debug('reading response');
--- 95,149 ----
my $ctype = ref($cont_ref);
# If we're sending content we *have* to specify a content length
# otherwise the server won't know a messagebody is coming.
if ($ctype eq 'CODE') {
! die 'No Content-Length header for request with dynamic content'
unless defined($h->header('Content-Length')) ||
! $h->content_type =~ /^multipart\//;
! # For HTTP/1.1 we could have used chunked transfer encoding...
} else {
! $h->header('Content-Length' => length $$cont_ref)
! if defined($$cont_ref) && length($$cont_ref);
}
!
# HTTP/1.1 will require us to send the 'Host' header, so we might
# as well start now.
my $hhost = $url->authority;
$hhost =~ s/^([^\@]*)\@//; # get rid of potential "user:pass@"
$h->header('Host' => $hhost) unless defined $h->header('Host');
# 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')) {
! $h->authorization_basic($url->user, $url->password);
}
my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
! my $n; # used for return value from syswrite/sysread
die "write timeout" if $timeout && !$sel->can_write($timeout);
$n = $socket->syswrite($buf, length($buf));
die $! unless defined($n);
die "short write" unless $n == length($buf);
LWP::Debug::conns($buf);
if ($ctype eq 'CODE') {
! while ( ($buf = &$cont_ref()), defined($buf) && length($buf)) {
die "write timeout" if $timeout && !$sel->can_write($timeout);
$n = $socket->syswrite($buf, length($buf));
die $! unless defined($n);
die "short write" unless $n == length($buf);
LWP::Debug::conns($buf);
! }
} elsif (defined($$cont_ref) && length($$cont_ref)) {
! die "write timeout" if $timeout && !$sel->can_write($timeout);
! $n = $socket->syswrite($$cont_ref, length($$cont_ref));
! die $! unless defined($n);
! die "short write" unless $n == length($$cont_ref);
! LWP::Debug::conns($buf);
}
# read response line from server
LWP::Debug::debug('reading response');
***************
*** 168,276 ****
$buf = '';
# Inside this loop we will read the response line and all headers
# found in the response.
while (1) {
! {
die "read timeout" if $timeout && !$sel->can_read($timeout);
$n = $socket->sysread($buf, $size, length($buf));
die $! unless defined($n);
die "unexpected EOF before status line seen" unless $n;
LWP::Debug::conns($buf);
! }
!
! if ($buf =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
# HTTP/1.0 response or better
my($ver,$code,$msg) = ($1, $2, $3);
$msg =~ s/\015$//;
LWP::Debug::debug("$ver $code $msg");
$response = HTTP::Response->new($code, $msg);
$response->protocol($ver);
# ensure that we have read all headers. The headers will be
# terminated by two blank lines
until ($buf =~ /^\015?\012/ || $buf =~ /\015?\012\015?\012/) {
! # must read more if we can...
! LWP::Debug::debug("need more header data");
! die "read timeout" if $timeout && !$sel->can_read($timeout);
! $n = $socket->sysread($buf, $size, length($buf));
! die $! unless defined($n);
! die "unexpected EOF before all headers seen" unless $n;
! #LWP::Debug::conns($buf);
}
# now we start parsing the headers. The strategy is to
# remove one line at a time from the beginning of the header
# buffer ($res).
my($key, $val);
while ($buf =~ s/([^\012]*)\012//) {
! my $line = $1;
! # if we need to restore as content when illegal headers
! # are found.
! my $save = "$line\012";
!
! $line =~ s/\015$//;
! last unless length $line;
!
! if ($line =~ /^([a-zA-Z0-9_\-]+)\s*:\s*(.*)/) {
$response->push_header($key, $val) if $key;
($key, $val) = ($1, $2);
! } elsif ($line =~ /^\s+(.*)/) {
unless ($key) {
! $response->header("Client-Warning" =>
! => "Illegal continuation header");
! $buf = "$save$buf";
! last;
}
$val .= " $1";
! } else {
$response->header("Client-Warning" =>
! "Illegal header '$line'");
$buf = "$save$buf";
last;
! }
}
$response->push_header($key, $val) if $key;
last;
! } elsif ((length($buf) >= 5 and $buf !~ /^HTTP\//) or
! $buf =~ /\012/ ) {
# HTTP/0.9 or worse
LWP::Debug::debug("HTTP/0.9 assume OK");
$response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
$response->protocol('HTTP/0.9');
last;
! } else {
# need more data
LWP::Debug::debug("need more status line data");
! }
! }
! ;
$response->request($request);
$self->_get_sock_info($response, $socket);
my $usebuf = length($buf) > 0;
! if ($request->method ne "CONNECT" ||
! !$response->is_success) {
! $response = $self->collect($arg, $response, sub {
! if ($usebuf) {
! $usebuf = 0;
! return \$buf;
! }
! die "read timeout" if $timeout && !$sel->can_read($timeout);
! my $n = $socket->sysread($buf, $size);
! die $! unless defined($n);
! #LWP::Debug::conns($buf);
! return \$buf;
! } );
}
! $socket->close
! unless ($keep_socket_open);
$response;
! }
1;
--- 151,253 ----
$buf = '';
# Inside this loop we will read the response line and all headers
# found in the response.
while (1) {
! {
die "read timeout" if $timeout && !$sel->can_read($timeout);
$n = $socket->sysread($buf, $size, length($buf));
die $! unless defined($n);
die "unexpected EOF before status line seen" unless $n;
LWP::Debug::conns($buf);
! }
! if ($buf =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
# HTTP/1.0 response or better
my($ver,$code,$msg) = ($1, $2, $3);
$msg =~ s/\015$//;
LWP::Debug::debug("$ver $code $msg");
$response = HTTP::Response->new($code, $msg);
$response->protocol($ver);
# ensure that we have read all headers. The headers will be
# terminated by two blank lines
until ($buf =~ /^\015?\012/ || $buf =~ /\015?\012\015?\012/) {
! # must read more if we can...
! LWP::Debug::debug("need more header data");
! die "read timeout" if $timeout && !$sel->can_read($timeout);
! $n = $socket->sysread($buf, $size, length($buf));
! die $! unless defined($n);
! die "unexpected EOF before all headers seen" unless $n;
! #LWP::Debug::conns($buf);
}
# now we start parsing the headers. The strategy is to
# remove one line at a time from the beginning of the header
# buffer ($res).
my($key, $val);
while ($buf =~ s/([^\012]*)\012//) {
! my $line = $1;
!
! # if we need to restore as content when illegal headers
! # are found.
! my $save = "$line\012";
! $line =~ s/\015$//;
! last unless length $line;
!
! if ($line =~ /^([a-zA-Z0-9_\-]+)\s*:\s*(.*)/) {
$response->push_header($key, $val) if $key;
($key, $val) = ($1, $2);
! } elsif ($line =~ /^\s+(.*)/) {
unless ($key) {
! $response->header("Client-Warning" =>
! => "Illegal continuation header");
! $buf = "$save$buf";
! last;
}
$val .= " $1";
! } else {
$response->header("Client-Warning" =>
! "Illegal header '$line'");
$buf = "$save$buf";
last;
! }
}
$response->push_header($key, $val) if $key;
last;
! } elsif ((length($buf) >= 5 and $buf !~ /^HTTP\//) or
! $buf =~ /\012/ ) {
# HTTP/0.9 or worse
LWP::Debug::debug("HTTP/0.9 assume OK");
$response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
$response->protocol('HTTP/0.9');
last;
! } else {
# need more data
LWP::Debug::debug("need more status line data");
! }
! };
$response->request($request);
$self->_get_sock_info($response, $socket);
my $usebuf = length($buf) > 0;
! $response = $self->collect($arg, $response, sub {
! if ($usebuf) {
! $usebuf = 0;
! return \$buf;
}
+ die "read timeout" if $timeout && !$sel->can_read($timeout);
+ my $n = $socket->sysread($buf, $size);
+ die $! unless defined($n);
+ #LWP::Debug::conns($buf);
+ return \$buf;
+ } );
! $socket->close;
$response;
! }
1;
*** libwww-perl-5.41-patch/lib/LWP/Protocol/https.pm Tue Dec 8 16:41:59 1998
--- libwww-perl-5.41/lib/LWP/Protocol/https.pm Wed Jan 21 07:42:23 1998
***************
*** 54,334 ****
$res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
}
$res->header("Client-SSL-Warning" => "Peer certificate not verified");
}
- sub request
- {
- my $self = shift;
- my($request, $proxy, $arg, $size, $timeout, $sockethash) = @_;
- LWP::Debug::trace('()');
-
- return $self->SUPER::request(@_)
- unless ($proxy);
-
- # We need to get through the proxy server with a regular
- # http connection, then we transmogrify the connection into
- # a secure socket.
-
- $sockethash = {} unless defined($sockethash);
-
- my $url = $request->url;
- my $host = $url->host;
- my $port = $url->port;
-
- my $socket;
-
- # I put this here b/c I don't know how to
- # check if the server closed the connection!
-
- if (defined($$sockethash{"$host:$port"})) {
- my $buf;
- my $n=$$sockethash{"$host:$port"}[1]->sysread($buf, 0);
- LWP::Debug::trace("Tried to read 0 bytes - got $n");
-
- $$sockethash{"$host:$port"}[1]->close;
- delete $$sockethash{"$host:$port"};
- }
-
- if (!exists($$sockethash{"$host:$port"})) {
- $socket= $self->SUPER::_new_socket($proxy->host, $proxy->port, $timeout);
- $self->SUPER::_check_sock($request, $socket);
-
-
- my $proxy_request = $request->clone;
- $proxy_request->method("CONNECT");
- my $new_url = new URI(undef,"http");
- $new_url->host($host);
- $new_url->port($port);
- $proxy_request->uri($new_url);
- my $proxy_protocol = new LWP::Protocol::http;
-
- LWP::Debug::trace("Trying to CONNECT through the proxy server");
- my %temp_sockethash = (%$sockethash, "$host:$port" => [time, $socket]);
-
- my $proxy_response = $proxy_protocol->request($proxy_request, $proxy, $arg, $size, $timeout,
- \%temp_sockethash);
-
- # Did we get through the proxy server?
- return $proxy_response
- unless($proxy_response->code == 200);
-
- # Turn the socket into an SSL socket
- LWP::Debug::trace("Transmogrifying our socket");
- bless $socket, "Net::SSL";
- *$socket->{'ssl_ctx'} = Net::SSL::_default_context();
- my $ssl = Crypt::SSLeay::Conn->new(*$socket->{'ssl_ctx'}, $socket);
- if ($ssl->connect <= 0) {
- # XXX should obtain the real SSLeay error message
- $socket->_error("SSL negotiation failed");
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- 'SSL negotiation failed.';
- }
- *$socket->{'ssl_ssl'} = $ssl;
-
- $$sockethash{"$host:$port"} = [time, $socket];
- }
-
- return $self->SUPER::request($request, undef, $arg, $size, $timeout, $sockethash);
- }
-
- 1;
- __END__
-
- $size ||= 4096;
-
- # check method
- my $method = $request->method;
- unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'http:' URLs";
- }
-
- my $url = $request->url;
- my($host, $port, $fullpath);
-
- # Check if we're proxy'ing
- if (defined $proxy) {
- # $proxy is an URL to an HTTP server which will proxy this request
- $host = $proxy->host;
- $port = $proxy->port;
- $fullpath = $url->as_string;
- }
- else {
- $host = $url->host;
- $port = $url->port;
- $fullpath = $url->path_query;
- $fullpath = "/" unless length $fullpath;
- }
-
- # connect to remote site
- my $socket = $self->_new_socket($host, $port, $timeout)
- unless defined($socket);
- $self->_check_sock($request, $socket);
-
- my $sel = IO::Select->new($socket) if $timeout;
-
- my $request_line = "$method $fullpath HTTP/1.0$CRLF";
-
- my $h = $request->headers->clone;
- my $cont_ref = $request->content_ref;
- $cont_ref = $$cont_ref if ref($$cont_ref);
- my $ctype = ref($cont_ref);
-
- # If we're sending content we *have* to specify a content length
- # otherwise the server won't know a messagebody is coming.
- if ($ctype eq 'CODE') {
- die 'No Content-Length header for request with dynamic content'
- unless defined($h->header('Content-Length')) ||
- $h->content_type =~ /^multipart\//;
- # For HTTP/1.1 we could have used chunked transfer encoding...
- } else {
- $h->header('Content-Length' => length $$cont_ref)
- if defined($$cont_ref) && length($$cont_ref);
- }
-
- # HTTP/1.1 will require us to send the 'Host' header, so we might
- # as well start now.
- my $hhost = $url->authority;
- $hhost =~ s/^([^\@]*)\@//; # get rid of potential "user:pass@"
- $h->header('Host' => $hhost) unless defined $h->header('Host');
-
- # 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')) {
- $h->authorization_basic($url->user, $url->password);
- }
-
- my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
- my $n; # used for return value from syswrite/sysread
-
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($buf, length($buf));
- die $! unless defined($n);
- die "short write" unless $n == length($buf);
- LWP::Debug::conns($buf);
-
- if ($ctype eq 'CODE') {
- while ( ($buf = &$cont_ref()), defined($buf) && length($buf)) {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($buf, length($buf));
- die $! unless defined($n);
- die "short write" unless $n == length($buf);
- LWP::Debug::conns($buf);
- }
- } elsif (defined($$cont_ref) && length($$cont_ref)) {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- $n = $socket->syswrite($$cont_ref, length($$cont_ref));
- die $! unless defined($n);
- die "short write" unless $n == length($$cont_ref);
- LWP::Debug::conns($buf);
- }
-
- # read response line from server
- LWP::Debug::debug('reading response');
-
- my $response;
- $buf = '';
-
- # Inside this loop we will read the response line and all headers
- # found in the response.
- while (1) {
- {
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- $n = $socket->sysread($buf, $size, length($buf));
- die $! unless defined($n);
- die "unexpected EOF before status line seen" unless $n;
- LWP::Debug::conns($buf);
- }
- if ($buf =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
- # HTTP/1.0 response or better
- my($ver,$code,$msg) = ($1, $2, $3);
- $msg =~ s/\015$//;
- LWP::Debug::debug("$ver $code $msg");
- $response = HTTP::Response->new($code, $msg);
- $response->protocol($ver);
-
- # ensure that we have read all headers. The headers will be
- # terminated by two blank lines
- until ($buf =~ /^\015?\012/ || $buf =~ /\015?\012\015?\012/) {
- # must read more if we can...
- LWP::Debug::debug("need more header data");
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- $n = $socket->sysread($buf, $size, length($buf));
- die $! unless defined($n);
- die "unexpected EOF before all headers seen" unless $n;
- #LWP::Debug::conns($buf);
- }
-
- # now we start parsing the headers. The strategy is to
- # remove one line at a time from the beginning of the header
- # buffer ($res).
- my($key, $val);
- while ($buf =~ s/([^\012]*)\012//) {
- my $line = $1;
-
- # if we need to restore as content when illegal headers
- # are found.
- my $save = "$line\012";
-
- $line =~ s/\015$//;
- last unless length $line;
-
- if ($line =~ /^([a-zA-Z0-9_\-]+)\s*:\s*(.*)/) {
- $response->push_header($key, $val) if $key;
- ($key, $val) = ($1, $2);
- } elsif ($line =~ /^\s+(.*)/) {
- unless ($key) {
- $response->header("Client-Warning" =>
- => "Illegal continuation header");
- $buf = "$save$buf";
- last;
- }
- $val .= " $1";
- } else {
- $response->header("Client-Warning" =>
- "Illegal header '$line'");
- $buf = "$save$buf";
- last;
- }
- }
- $response->push_header($key, $val) if $key;
- last;
-
- } elsif ((length($buf) >= 5 and $buf !~ /^HTTP\//) or
- $buf =~ /\012/ ) {
- # HTTP/0.9 or worse
- LWP::Debug::debug("HTTP/0.9 assume OK");
- $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
- $response->protocol('HTTP/0.9');
- last;
-
- } else {
- # need more data
- LWP::Debug::debug("need more status line data");
- }
- };
- $response->request($request);
- $self->_get_sock_info($response, $socket);
-
-
- my $usebuf = length($buf) > 0;
- $response = $self->collect($arg, $response, sub {
- if ($usebuf) {
- $usebuf = 0;
- return \$buf;
- }
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- my $n = $socket->sysread($buf, $size);
- die $! unless defined($n);
- #LWP::Debug::conns($buf);
- return \$buf;
- } );
-
- $socket->close;
-
- $response;
- }
-
1;
--- 54,59 ----
*** libwww-perl-5.41-patch/lib/LWP/UserAgent.pm Wed Dec 2 16:13:09 1998
--- libwww-perl-5.41/lib/LWP/UserAgent.pm Thu Nov 19 16:45:01 1998
***************
*** 131,142 ****
'cookie_jar' => undef,
'use_eval' => 1,
'parse_head' => 1,
'max_size' => undef,
'no_proxy' => [],
- 'socket_cache'=> {},
- 'max_sockets' => 4,
}, $class;
}
}
--- 131,140 ----
***************
*** 209,238 ****
my $response;
if ($use_eval) {
# we eval, and turn dies into responses below
eval {
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout, $self->{socket_cache});
! if (scalar(keys %{$self->{socket_cache}}) > $self->{max_sockets}) {
! # Uh oh, need to close some sockets!
! # (Not yet implemented)
! }
};
if ($@) {
$@ =~ s/\s+at\s+\S+\s+line\s+\d+\.?\s*//;
$response =
HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
$@);
}
} else {
! $response = $protocol->request($request, $proxy,
! $arg, $size, $timeout, $self->{socket_cache});
! # XXX: Should we die unless $response->is_success ???
! if (scalar(keys %{$self->{socket_cache}}) > $self->{max_sockets}) {
! # Uh oh, need to close some sockets!
! # (Not yet implemented)
! }
}
$response->request($request); # record request for reference
$cookie_jar->extract_cookies($response) if $cookie_jar;
$response->header("Client-Date" => HTTP::Date::time2str(time));
--- 207,228 ----
my $response;
if ($use_eval) {
# we eval, and turn dies into responses below
eval {
$response = $protocol->request($request, $proxy,
! $arg, $size, $timeout);
};
if ($@) {
$@ =~ s/\s+at\s+\S+\s+line\s+\d+\.?\s*//;
$response =
HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
$@);
}
} else {
! $response = $protocol->request($request, $proxy,
! $arg, $size, $timeout);
! # XXX: Should we die unless $response->is_success ???
}
$response->request($request); # record request for reference
$cookie_jar->extract_cookies($response) if $cookie_jar;
$response->header("Client-Date" => HTTP::Date::time2str(time));