summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/LWP/Protocol/http.pm34
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++;