diff -c5 -r -w libwww-perl-5.47/lib/LWP/Protocol/http.pm libwww-perl-5.47-patch/lib/LWP/Protocol/http.pm
*** libwww-perl-5.47/lib/LWP/Protocol/http.pm	Thu Nov  4 15:31:21 1999
--- libwww-perl-5.47-patch/lib/LWP/Protocol/http.pm	Wed Apr  5 15:55:09 2000
***************
*** 18,39 ****
  				   # instance MacPerl defines it to "\012\015"
  
  sub _new_socket
  {
      my($self, $host, $port, $timeout) = @_;
  
      local($^W) = 0;  # IO::Socket::INET can be noisy
!     my $sock = IO::Socket::INET->new(PeerAddr => $host,
  				     PeerPort => $port,
  				     Proto    => 'tcp',
  				     Timeout  => $timeout,
  				    );
      unless ($sock) {
  	# IO::Socket::INET leaves additional error messages in $@
  	$@ =~ s/^.*?: //;
  	die "Can't connect to $host:$port ($@)";
      }
      $sock;
  }
  
  
  sub _check_sock
--- 18,60 ----
  				   # instance MacPerl defines it to "\012\015"
  
  sub _new_socket
  {
      my($self, $host, $port, $timeout) = @_;
+     my($sock);
  
+     if ($self->connection_cache_active())
+     {
+         if (defined($sock=$self->connection_cache_get($host,$port)))
+         {
+ 	    # Make an effort to make sure the connection is still there.
+             unless (IO::Select->new($sock)->has_exception(0))
+ 	    {
+                 LWP::Debug::debug("Using kept-alive connection to $host:$port");
+                 $self->{socket_from_cache}=1;
+                 return $sock;
+             }
+ 	    &LWP::Debug::debug("Exception occured on kept-alive connection to $host:$port; closing cached socket.");
+         }
+     }
+     $self->{socket_from_cache}=undef;
      local($^W) = 0;  # IO::Socket::INET can be noisy
!     $sock = IO::Socket::INET->new(PeerAddr => $host,
  				  PeerPort => $port,
  				  Proto    => 'tcp',
  				  Timeout  => $timeout,
  				  );
      unless ($sock) {
  	# IO::Socket::INET leaves additional error messages in $@
  	$@ =~ s/^.*?: //;
  	die "Can't connect to $host:$port ($@)";
      }
+     if ($self->connection_cache_active())
+     {
+         $self->connection_cache_add($host,$port,$sock);
+         LWP::Debug::debug("Caching socket at $host:$port");
+     }
      $sock;
  }
  
  
  sub _check_sock
***************
*** 46,55 ****
--- 67,113 ----
      my($self, $res, $sock) = @_;
      $res->header("Client-Peer" =>
  		 $sock->peerhost . ":" . $sock->peerport);
  }
  
+ sub connection_cache
+ {
+     my($self,$pCache)=@_;
+ 
+     LWP::Debug::debug("Activating connection cache for http");
+     $self->{"connection_cache"}=$pCache;
+ }
+ 
+ sub connection_cache_add
+ {
+   my($self,$host,$port,$sock)=@_;
+   my($lcHost,$lcPort)=(lc $host, lc $port);
+   
+   $self->{"connection_cache"}{"$lcHost:$lcPort"}=$sock;
+ }
+ 
+ sub connection_cache_del
+ {
+   my($self,$host,$port)=@_;
+   my($lcHost,$lcPort)=(lc $host, lc $port);
+ 
+   delete $self->{"connection_cache"}{"$lcHost:$lcPort"};
+ }
+ 
+ sub connection_cache_get
+ {
+   my($self,$host,$port)=@_;
+   my($lcHost,$lcPort)=(lc $host, lc $port);
+ 
+   return $self->{"connection_cache"}{"$lcHost:$lcPort"};
+ }
+ 
+ sub connection_cache_active
+ {
+   my($self)=@_;
+   return (defined($self->{"connection_cache"}));
+ }
  
  sub request
  {
      my($self, $request, $proxy, $arg, $size, $timeout) = @_;
      LWP::Debug::trace('()');
***************
*** 79,95 ****
  	$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;
      my $cont_ref = $request->content_ref;
      $cont_ref = $$cont_ref if ref($$cont_ref);
      my $ctype = ref($cont_ref);
--- 137,155 ----
  	$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 eq "CONNECT") ?
!       "$method $host:$port HTTP/1.0$CRLF" :
! 	"$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);
***************
*** 112,132 ****
      $hhost =~ s/^([^\@]*)\@//;  # get rid of potential "user:pass@"
      $h->header('Host' => $hhost) unless defined $h->header('Host');
  
      $h->remove_header('Connection');  # need support here to be useful
  
      # 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(split(":", $1));
      }
  
!     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);
  
--- 172,210 ----
      $hhost =~ s/^([^\@]*)\@//;  # get rid of potential "user:pass@"
      $h->header('Host' => $hhost) unless defined $h->header('Host');
  
      $h->remove_header('Connection');  # need support here to be useful
  
+     # If we're caching connections, ask the server not to shut
+     # down the connection.
+     if ($self->connection_cache_active())
+     {
+         $h->header('Connection','Keep-Alive');
+     }
+ 
      # 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(split(":", $1));
      }
  
!     # connect to remote site
!     my($socket,$sel,$buf);
      my $n;  # used for return value from syswrite/sysread
+     my $response;
+   SENDREQ: {
+       eval {
+ 	$socket = $self->_new_socket($host, $port, $timeout);
+ 	$self->_check_sock($request, $socket);
+ 
+ 	$sel = IO::Select->new($socket) if $timeout;
+ 	
+ 	$buf = $request_line . $h->as_string($CRLF) . $CRLF;
  
  	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);
  
***************
*** 147,159 ****
      }
  
      # 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);
--- 225,235 ----
***************
*** 170,179 ****
--- 246,256 ----
  	    $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));
***************
*** 183,192 ****
--- 260,279 ----
  	    }
  
  	    # now we start parsing the headers.  The strategy is to
  	    # remove one line at a time from the beginning of the header
  	    # buffer ($res).
+ 
+ 	    # Now we've written a line, and read a line;
+ 	    # we're pretty sure the connection is up.
+ 	    # Disable the special-case for cached connections.
+ 	    #   --sg
+ 	    if (defined($self->{socket_from_cache}))
+ 	      {
+ 		delete $self->{socket_from_cache};
+ 	      }
+ 
  	    my($key, $val);
  	    while ($buf =~ s/([^\012]*)\012//) {
  	      my $line = $1;
  
  	      # if we need to restore as content when illegal headers
***************
*** 228,255 ****
  	} 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;
--- 315,398 ----
  	  } else {
  	    # need more data
  	    LWP::Debug::debug("need more status line data");
  	  }
  	};
+       };  # end eval
+ 
+       if ($@)
+ 	{
+ 	  if (defined($self->{socket_from_cache}))
+ 	    {
+ 	      LWP::Debug::debug("Error on cached connection: '$@'.  Trying again with new connection.");
+ 	      undef $socket;
+ 	      $self->connection_cache_del($host,$port);
+ 	      redo SENDREQ;
+ 	    }
+ 	  else
+ 	    {
+ 	      die $@;
+ 	    }
+ 	}
+     } # end SENDREQ block
+ 
      $response->request($request);
      $self->_get_sock_info($response, $socket);
  
  
      my $usebuf = length($buf) > 0;
+     ### DCW ### -- don't collect on CONNECT
+     my $clen=0;
+     if ($self->connection_cache_active())
+       {
+ 	$clen=$response->header("Content-Length");
+       }
+     my $curlen=0;
+ 	
+     if (defined($response->header("Connection")) &&
+ 	$response->header("Connection") !~ /\bkeep-alive\b/i)
+       {
+ 	LWP::Debug::debug("Server requested connection be closed");
+ 	if ($self->connection_cache_get($host,$port))
+ 	  {
+ 	    $self->connection_cache_delete($host,$port);
+ 	  }
+ 	$clen=0;
+       }
+ 
+     if ($clen)
+       {
+ 	LWP::Debug::debug("Content-Length is $clen bytes");
+       }
+ 
+     if ($method ne "CONNECT") {
        $response = $self->collect($arg, $response, sub {
  				   if ($usebuf) {
  				     $usebuf = 0;
  				     return \$buf;
  				   }
+ 				   if ($clen)
+ 				     {
+ 				       if (($curlen == $clen))
+ 					 {
+ 					   return undef;
+ 					 }
+ 				     }
  				   die "read timeout" if $timeout && !$sel->can_read($timeout);
  				   my $n = $socket->sysread($buf, $size);
  				   die $! unless defined($n);
+ 				   $curlen += $n;
  				   #LWP::Debug::conns($buf);
  				   return \$buf;
  				 } );
+     }
+ 
+     # Don't close it -- just let it go out of scope.  If it's being
+     # cached, it will be referenced elsewhere, so won't be destroyed.
  
!     #   --sg
!     #    $socket->close;
  
      $response;
  }
  
  1;
Only in libwww-perl-5.47-patch/lib/LWP/Protocol: http.pm.orig
Only in libwww-perl-5.47-patch/lib/LWP/Protocol: http.pm.rej
diff -c5 -r -w libwww-perl-5.47/lib/LWP/Protocol/https.pm libwww-perl-5.47-patch/lib/LWP/Protocol/https.pm
*** libwww-perl-5.47/lib/LWP/Protocol/https.pm	Mon Sep 20 08:48:37 1999
--- libwww-perl-5.47-patch/lib/LWP/Protocol/https.pm	Wed Apr  5 15:58:18 2000
***************
*** 26,37 ****
  @ISA=qw(LWP::Protocol::http);
  
  sub _new_socket
  {
      my($self, $host, $port, $timeout) = @_;
      local($^W) = 0;  # IO::Socket::INET can be noisy
!     my $sock = $SSL_CLASS->new(PeerAddr => $host,
  			       PeerPort => $port,
  			       Proto    => 'tcp',
  			       Timeout  => $timeout,
  			      );
      unless ($sock) {
--- 26,53 ----
  @ISA=qw(LWP::Protocol::http);
  
  sub _new_socket
  {
      my($self, $host, $port, $timeout) = @_;
+ 	my($sock);
+     if ($self->connection_cache_active())
+     {
+         if (defined($sock=$self->connection_cache_get($host,$port)))
+         {
+ 	    # Make an effort to make sure the connection is still there.
+             unless (IO::Select->new($sock)->has_exception(0))
+ 	    {
+                 LWP::Debug::debug("Using kept-alive connection to $host:$port");
+                 $self->{socket_from_cache}=1;
+                 return $sock;
+             }
+ 	    &LWP::Debug::debug("Exception occured on kept-alive connection to $host:$port; closing cached socket.");
+         }
+     }
+     $self->{socket_from_cache}=undef;
      local($^W) = 0;  # IO::Socket::INET can be noisy
!     $sock = $SSL_CLASS->new(PeerAddr => $host,
  							PeerPort => $port,
  							Proto    => 'tcp',
  							Timeout  => $timeout,
  			      );
      unless ($sock) {
***************
*** 67,73 ****
--- 83,163 ----
  	$res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
  	$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) = @_;
+   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.
+ 
+   my $url  = $request->url;
+   my $host = $url->host;
+   my $port = $url->port;
+ 
+   my $socket;
+ 
+   if (!$self->connection_cache_get($host, $port)) {
+ 	my $remember_cache = $self->{"connection_cache"};
+ 	$self->{"connection_cache"} = undef;
+ 	$socket= $self->SUPER::_new_socket($proxy->host, $proxy->port, $timeout);
+ 	LWP::Debug::trace("Creating new " . ref($socket) . " to get through firewall");
+ 	$self->SUPER::_check_sock($request, $socket);
+ 	$self->{"connection_cache"} = $remember_cache;
+ 
+ 	my $proxy_request  = $request->clone;
+ 	$proxy_request->method("CONNECT");
+ #   $proxy_request->uri(new URI("$host:$port"));
+ 
+ 	my $proxy_protocol = LWP::Protocol::create('http');
+ 	$proxy_protocol->connection_cache_add( $host, $port, $socket );
+ 
+ 	LWP::Debug::trace("Trying to CONNECT through the proxy server");
+ 
+ 
+ 	my $remove_cache=0;
+ 	if (!$self->connection_cache_active()) {
+ 	  $remove_cache=1;
+ 	  $self->{"connection_cache"} = {};
+ 	}
+ 	$self->connection_cache_add( $host, $port, $socket );
+ 
+ 	my $proxy_response = $proxy_protocol->request($proxy_request, undef, $arg, $size, $timeout);
+ 
+ 	if ($remove_cache) {
+ 	  $self->{"connection_cache"} = undef;
+ 	}
+ 
+ 	# 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;
+   }
+ 
+   return $self->SUPER::request($request, undef, $arg, $size, $timeout);
+ }
+ 
+ 
  
  1;
diff -c5 -r -w libwww-perl-5.47/lib/LWP/UserAgent.pm libwww-perl-5.47-patch/lib/LWP/UserAgent.pm
*** libwww-perl-5.47/lib/LWP/UserAgent.pm	Thu Nov  4 15:21:01 1999
--- libwww-perl-5.47-patch/lib/LWP/UserAgent.pm	Wed Apr  5 11:49:40 2000
***************
*** 129,138 ****
--- 129,139 ----
  		'cookie_jar'  => undef,
  		'use_eval'    => 1,
                  'parse_head'  => 1,
                  'max_size'    => undef,
  		'no_proxy'    => [],
+                 'connection_cache' => undef,
  	}, $class;
      }
  }
  
  
***************
*** 188,197 ****
--- 189,200 ----
      if ($@) {
  	$@ =~ s/\s+at\s+\S+\s+line\s+\d+\.?\s*//;  # remove file/line number
  	return HTTP::Response->new(&HTTP::Status::RC_NOT_IMPLEMENTED, $@)
      }
      
+     LWP::Debug::debug("Got protocol object at $protocol");
+ 
      # Extract fields that will be used below
      my ($agent, $from, $timeout, $cookie_jar,
          $use_eval, $parse_head, $max_size) =
        @{$self}{qw(agent from timeout cookie_jar
                    use_eval parse_head max_size)};
***************
*** 204,213 ****
--- 207,228 ----
  
      # Transfer some attributes to the protocol object
      $protocol->parse_head($parse_head);
      $protocol->max_size($max_size);
      
+     if (defined($self->{connection_cache}))
+     {
+         eval {
+             $protocol->connection_cache($self->{connection_cache});
+         };
+         if ($@)
+         {
+             warn("Tried to use connection caching with protocol that does not support it.\n");
+         }
+ 	LWP::Debug::debug("Configured connection_cache for protocol");
+     }
+ 
      my $response;
      if ($use_eval) {
  	# we eval, and turn dies into responses below
  	eval {
  	    $response = $protocol->request($request, $proxy,
***************
*** 229,238 ****
--- 244,266 ----
      $cookie_jar->extract_cookies($response) if $cookie_jar;
      $response->header("Client-Date" => HTTP::Date::time2str(time));
      return $response;
  }
  
+ # Debugging function.
+ sub dump_connection_cache
+ {
+     my ($self)=@_;
+ 
+     my $i;
+ 
+     print "Dumping connection cache (=$self->{connection_cache})\n";
+     foreach $i (keys %{$self->{connection_cache}})
+     {
+         print "Have connection to $i\n";
+     }
+ }
  
  =item $ua->request($request, $arg [, $size])
  
  Process a request, including redirects and security.  This method may
  actually send several different simple requests.
***************
*** 466,475 ****
--- 494,533 ----
  sub from       { shift->_elem('from',      @_); }
  sub cookie_jar { shift->_elem('cookie_jar',@_); }
  sub parse_head { shift->_elem('parse_head',@_); }
  sub max_size   { shift->_elem('max_size',  @_); }
  
+ =item $ua->connection_cache([$boolean])
+ 
+ Get/set a value indicating whether we should try to cache connections
+ between requests.  If this is activated, HTTP sockets won't be closed
+ after a request is completed, but will be stored as part of the
+ UserAgent.  If, later on, we try to connect to the same host and port,
+ this connection will be reused.
+ 
+ If you pass a value to this function, all open connections will be
+ closed.
+ 
+ =cut
+ 
+ sub connection_cache {
+   my($self,$setting)=@_;
+ 
+   if (defined($setting))
+   {
+     if ($setting)
+     {
+       $self->{connection_cache} = {};
+     }
+     else
+     {
+       $self->{connection_cache} = undef;
+     }
+   }
+   return defined($self->{connection_cache});
+ }
+     
  # depreciated
  sub use_eval   { shift->_elem('use_eval',  @_); }
  sub use_alarm
  {
      Carp::carp("LWP::UserAgent->use_alarm(BOOL) is a no-op")
