summaryrefslogtreecommitdiffstats
path: root/perl-install/install/http.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2007-04-25 12:26:16 +0000
committerPascal Rigaux <pixel@mandriva.com>2007-04-25 12:26:16 +0000
commit126777bc019a54afb4ec51299f2cf9d2841698aa (patch)
tree97f76e571902ead55ba138f1156a4b4f00b9b779 /perl-install/install/http.pm
parentf1f67448efc714873378dfeb8279fae68054a90a (diff)
downloaddrakx-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.pm59
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;