diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
commit | 126777bc019a54afb4ec51299f2cf9d2841698aa (patch) | |
tree | 97f76e571902ead55ba138f1156a4b4f00b9b779 /perl-install/install/http.pm | |
parent | f1f67448efc714873378dfeb8279fae68054a90a (diff) | |
download | drakx-backup-do-not-use-126777bc019a54afb4ec51299f2cf9d2841698aa.tar drakx-backup-do-not-use-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.gz drakx-backup-do-not-use-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.bz2 drakx-backup-do-not-use-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.xz drakx-backup-do-not-use-126777bc019a54afb4ec51299f2cf9d2841698aa.zip |
re-sync after the big svn loss
Diffstat (limited to 'perl-install/install/http.pm')
-rw-r--r-- | perl-install/install/http.pm | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/perl-install/install/http.pm b/perl-install/install/http.pm new file mode 100644 index 000000000..75d026d0d --- /dev/null +++ b/perl-install/install/http.pm @@ -0,0 +1,59 @@ +package install::http; # $Id$ + +use IO::Socket; + +my $sock; + + +sub close() { + $sock->close if $sock; +} + +sub getFile { + my ($url) = @_; + my ($_size, $fh) = get_file_and_size($url) or return; + $fh; +} +sub get_file_and_size { + local ($^W) = 0; + + my ($url) = @_; + $sock->close if $sock; + + # can be used for ftp urls (with http proxy) + my ($host, $port, $path) = $url =~ m,^(?:http|ftp)://([^/:]+)(?::(\d+))?(/\S*)?$,; + defined $host or return undef; + + my $use_http_proxy = $ENV{PROXY} && $ENV{PROXYPORT}; + + $sock = IO::Socket::INET->new(PeerAddr => $use_http_proxy ? $ENV{PROXY} : $host, + PeerPort => $use_http_proxy ? $ENV{PROXYPORT} : $port || 80, + Proto => 'tcp', + Timeout => 60) or die "can not connect $@"; + $sock->autoflush; + print $sock join("\015\012" => + "GET " . ($use_http_proxy ? $url : $path) . " HTTP/1.0", + "Host: $host" . ($port && ":$port"), + "User-Agent: DrakX/vivelinuxabaszindozs", + "", ""); + + #- skip until empty line + my $now = 0; + my ($last, $buf, $tmp); + my $read = sub { sysread($sock, $buf, 1) or die ''; $tmp .= $buf }; + do { + $last = $now; + &$read; &$read if $buf =~ /\015/; + $now = $buf =~ /\012/; + } until $now && $last; + + if ($tmp =~ /^(.*\b(\d+)\b.*)/ && $2 == 200) { + my ($size) = $tmp =~ /^Content-Length:\s*(\d+)\015?$/m; + $size, $sock; + } else { + log::l("HTTP error: $1"); + undef; + } +} + +1; |