diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm | 34 |
1 files changed, 30 insertions, 4 deletions
diff --git a/Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm b/Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm index 59c9eded1ab..8d7c6d93928 100644 --- a/Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm +++ b/Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm @@ -40,8 +40,15 @@ sub _new_socket unless ($sock) { # IO::Socket::INET leaves additional error messages in $@ - $@ =~ s/^.*?: //; - die "Can't connect to $host:$port ($@)"; + my $status = "Can't connect to $host:$port"; + if ($@ =~ /\bconnect: (.*)/ || + $@ =~ /\b(Bad hostname)\b/ || + $@ =~ /\b(certificate verify failed)\b/ || + $@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/ + ) { + $status .= " ($1)"; + } + die "$status\n\n$@"; } # perl 5.005's IO::Socket does not have the blocking method. @@ -153,6 +160,16 @@ sub request # connect to remote site my $socket = $self->_new_socket($host, $port, $timeout); + + my $http_version = ""; + if (my $proto = $request->protocol) { + if ($proto =~ /^(?:HTTP\/)?(1.\d+)$/) { + $http_version = $1; + $socket->http_version($http_version); + $socket->send_te(0) if $http_version eq "1.0"; + } + } + $self->_check_sock($request, $socket); my @h; @@ -237,7 +254,15 @@ sub request my $eof; my $wbuf; my $woffset = 0; - if (ref($content_ref) eq 'CODE') { + INITIAL_READ: + if ($write_wait) { + # skip filling $wbuf when waiting for 100-continue + # because if the response is a redirect or auth required + # the request will be cloned and there is no way + # to reset the input stream + # return here via the label after the 100-continue is read + } + elsif (ref($content_ref) eq 'CODE') { my $buf = &$content_ref(); $buf = "" unless defined($buf); $buf = sprintf "%x%s%s%s", length($buf), $CRLF, $buf, $CRLF @@ -260,7 +285,7 @@ sub request vec($fbits, fileno($socket), 1) = 1; WRITE: - while ($woffset < length($$wbuf)) { + while ($write_wait || $woffset < length($$wbuf)) { my $sel_timeout = $timeout; if ($write_wait) { @@ -316,6 +341,7 @@ sub request if ($code eq "100") { $write_wait = 0; undef($code); + goto INITIAL_READ; } else { $drop_connection++; |