HTTP.pm revision 1.2 
1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: HTTP.pm,v 1.2 2011/07/12 10:29:20 espie Exp $
4#
5# Copyright (c) 2011 Marc Espie <espie@openbsd.org>
6#
7# Permission to use, copy, modify, and distribute this software for any
8# purpose with or without fee is hereby granted, provided that the above
9# copyright notice and this permission notice appear in all copies.
10#
11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18
19use strict;
20use warnings;
21
22package OpenBSD::Repository::HTTP;
23sub urlscheme
24{
25	return 'http';
26}
27
28sub initiate
29{
30	my $self = shift;
31	my ($rdfh, $wrfh);
32	pipe($self->{getfh}, $h1);
33	pipe($h2, $self->{cmdfh});
34	my $pid = fork();
35	if ($pid == 0) {
36		close($self->{getfh});
37		close($self->{cmdfh});
38		close(STDOUT);
39		close(STDIN);
40		open(STDOUT, '>&', $wrfh);
41		open(STDIN, '<&', $rdfh);
42		_Proxy::main($self);
43	} else {
44		close($rdfh);
45		close($wrfh);
46		$self->{controller} = $pid;
47	}
48}
49
50package _Proxy::connection;
51sub new
52{
53	my ($class, $host, $port) = @_;
54	require IO::Socket::INET;
55	my $o = IO::Socket::INET->new(
56		PeerHost => $host,
57		PeerPort => $port);
58	bless {fh => $o, buffer => ''}, $class;
59}
60
61sub getline
62{
63	my $self = shift;
64	while (1) {
65		if ($self->{buffer} =~ s/^(.*?)\015\012//) {
66			return $1;
67		}
68		my $buffer;
69		$self->{fh}->recv($buffer, 1024);
70		$self->{buffer}.=$buffer;
71    	}
72}
73
74sub retrieve
75{
76	my ($self, $sz) = @_;
77	while(length($self->{buffer}) < $sz) {
78		my $buffer;
79		$self->{fh}->recv($buffer, $sz - length($self->{buffer}));
80		$self->{buffer}.=$buffer;
81	}
82	my $result= substr($self->{buffer}, 0, $sz);
83	$self->{buffer} = substr($self->{buffer}, $sz);
84	return $result;
85}
86
87sub print
88{
89	my ($self, @l) = @_;
90	print {$self->{fh}} @l;
91}
92
93package _Proxy;
94
95my $pid;
96my $token = 0;
97
98sub batch(&)
99{
100	my $code = shift;
101	if (defined $pid) {
102		waitpid($pid, 0);
103		undef $pid;
104	}
105	$token++;
106	$pid = fork();
107	if (!defined $pid) {
108		print "ERROR: fork failed: $!\n";
109	}
110	if ($pid == 0) {
111		&$code();
112		exit(0);
113	}
114}
115
116sub abort_batch()
117{
118	if (defined $pid) {
119		kill 1, $pid;
120		waitpid($pid, 0);
121		undef $pid;
122	}
123	print "\nABORTED $token\n";
124}
125
126sub main
127{
128	my $self = shift;
129	my $o = _Proxy::Connection->new($self->{host}, "www");
130	while (<STDIN>) {
131		chomp;
132		if (m/^LIST\s+(.*)$/o) {
133			my $dname = $1;
134			batch(sub {
135				my $d;
136				if (opendir($d, $dname)) {
137					print "SUCCESS: directory $dname\n";
138				} else {
139					print "ERROR: bad directory $dname $!\n";
140				}
141				while (my $e = readdir($d)) {
142					next if $e eq '.' or $e eq '..';
143					next unless $e =~ m/(.+)\.tgz$/;
144					next unless -f "$dname/$e";
145					print "$1\n";
146				}
147				print "\n";
148				closedir($d);
149			});
150		} elsif (m/^GET\s+(.*)$/o) {
151			my $fname = $1;
152			batch(sub {
153				if (open(my $fh, '<', $fname)) {
154					my $size = (stat $fh)[7];
155					print "TRANSFER: $size\n";
156					my $buffer = '';
157					while (read($fh, $buffer, 1024 * 1024) > 0) {
158						print $buffer;
159					}
160					close($fh);
161				} else {
162					print "ERROR: bad file $fname $!\n";
163				}
164			});
165		} elsif (m/^BYE$/o) {
166			exit(0);
167		} elsif (m/^ABORT$/o) {
168			abort_batch();
169		} else {
170			print "ERROR: Unknown command\n";
171		}
172	}
173}
174
175
176sub get_file
177{
178	my ($o, $file) = @_;
179	my $crlf="\015\012";
180	open my $fh, '>', $file;
181
182	my $start = 0;
183	my $end = 4000;
184	my $total_size = 0;
185
186	do {
187		$end *= 2;
188		$o->print("GET /pub/OpenBSD/snapshots/packages/amd64/$file HTTP/1.1$crlf",
189    "Host: www.w3.org$crlf",
190		"Range: bytes=",$start, "-", $end-1, $crlf, $crlf);
191
192		# get header
193
194		my $_ = $o->getline;
195		if (m,^HTTP/1\.1\s+(\d\d\d),) {
196			my $code = $1;
197			print "Code: $code\n";
198		} else {
199			print $_, "\n";
200		}
201		my $h = {};
202		while ($_ = $o->getline) {
203			last if m/^$/;
204			if (m/^([\w\-]+)\:\s*(.*)$/) {
205				print "$1 => $2\n";
206				$h->{$1} = $2;
207			} else {
208				print "unknown line: $_\n";
209			}
210		}
211
212		if (defined $h->{'Content-Range'} && $h->{'Content-Range'} =~
213			m/^bytes\s+\d+\-\d+\/(\d+)/) {
214				$total_size = $1;
215		}
216		print "END OF HEADER\n";
217
218		if (defined $h->{'Content-Length'}) {
219			my $v = $o->retrieve($h->{'Content-Length'});
220			print $fh $v;
221		}
222		$start = $end;
223	} while ($end < $total_size);
224}
225