diff options
| -rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
| -rw-r--r-- | cpan/File-Fetch/lib/File/Fetch.pm | 20 |
2 files changed, 19 insertions, 3 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 0b58929420..468178a60d 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -660,7 +660,7 @@ use File::Glob qw(:case); 'File::Fetch' => { 'MAINTAINER' => 'kane', - 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.21_01.tar.gz', + 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.21_02.tar.gz', 'FILES' => q[cpan/File-Fetch], 'CPAN' => 1, 'UPSTREAM' => 'cpan', diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm index dfe0484f19..9f1d0b6120 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -22,7 +22,7 @@ use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $FTP_PASSIVE $TIMEOUT $DEBUG $WARN ]; -$VERSION = '0.21_01'; +$VERSION = '0.21_02'; $VERSION = eval $VERSION; # avoid warnings with development releases $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; @@ -619,7 +619,9 @@ sub _iosock_fetch { "Could not open '%1' for writing: %2",$to,$!)); } - $sock->send( "GET $self->path HTTP/1.0\x0d\x0aHost: $self->host\x0d\x0a\x0d\x0a" ); + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); my $select = IO::Select->new( $sock ); @@ -638,6 +640,20 @@ sub _iosock_fetch { return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); } + # Check the "response" + # Strip preceeding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } + + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; close $fh; return $to; |