HTTP.pm revision 1.4 
1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: HTTP.pm,v 1.4 2011/07/18 20:03:12 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}, $rdfh);
33	pipe($wrfh, $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, host => $host, 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 retrieve_chunked
88{
89	my $self = shift;
90	my $result = '';
91	while (1) {
92		my $sz = $self->getline;
93		if ($sz =~ m/^([0-9a-fA-F]+)/) {
94			my $realsize = hex($1);
95			last if $realsize == 0;
96			$result .= $self->retrieve($realsize);
97		}
98	}
99	return $result;
100}
101
102sub print
103{
104	my ($self, @l) = @_;
105	print {$self->{fh}} @l;
106}
107
108package _Proxy;
109
110my $pid;
111my $token = 0;
112
113sub batch(&)
114{
115	my $code = shift;
116	if (defined $pid) {
117		waitpid($pid, 0);
118		undef $pid;
119	}
120	$token++;
121	$pid = fork();
122	if (!defined $pid) {
123		print "ERROR: fork failed: $!\n";
124	}
125	if ($pid == 0) {
126		&$code();
127		exit(0);
128	}
129}
130
131sub abort_batch()
132{
133	if (defined $pid) {
134		kill 1, $pid;
135		waitpid($pid, 0);
136		undef $pid;
137	}
138	print "\nABORTED $token\n";
139}
140
141sub get_directory
142{
143	my ($o, $dname) = @_;
144	my $crlf="\015\012";
145	$o->print("GET $dname/ HTTP/1.1", $crlf,
146	    "Host: ", $o->{host}, $crlf, $crlf);
147	# get header
148
149	my $_ = $o->getline;
150	if (!m,^HTTP/1\.1\s+(\d\d\d),) {
151		print "ERROR\n";
152		return;
153	}
154	my $code = $1;
155	my $h = {};
156	while ($_ = $o->getline) {
157		last if m/^$/;
158		if (m/^([\w\-]+)\:\s*(.*)$/) {
159			print STDERR "$1 => $2\n";
160			$h->{$1} = $2;
161		} else {
162			print STDERR "unknown line: $_\n";
163		}
164	}
165	if ($h->{'Transfer-Encoding'} eq 'chunked') {
166		my $buffer = $o->retrieve_chunked;
167		if ($code == 200) {
168			print "SUCCESS: directory $dname\n";
169			for my $pkg ($buffer =~ m/\<A\s+HREF=\"(.+?)\.tgz\"\>/gio) {
170				$pkg = $1 if $pkg =~ m|^.*/(.*)$|;
171				# decode uri-encoding; from URI::Escape
172				$pkg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
173				print $pkg, "\n";
174			}
175			print "\n";
176			return;
177		} else {
178			print "ERROR: code was $code\n";
179			return;
180		}
181	} else {
182		print "ERROR: can't decode non-chunked\n";
183	}
184}
185
186
187sub main
188{
189	my $self = shift;
190	my $o = _Proxy::Connection->new($self->{host}, "www");
191	while (<STDIN>) {
192		chomp;
193		if (m/^LIST\s+(.*)$/o) {
194			my $dname = $1;
195			batch(sub {get_directory($o, $dname);});
196		} elsif (m/^GET\s+(.*)$/o) {
197			my $fname = $1;
198			batch(sub {
199				if (open(my $fh, '<', $fname)) {
200					my $size = (stat $fh)[7];
201					print "TRANSFER: $size\n";
202					my $buffer = '';
203					while (read($fh, $buffer, 1024 * 1024) > 0) {
204						print $buffer;
205					}
206					close($fh);
207				} else {
208					print "ERROR: bad file $fname $!\n";
209				}
210			});
211		} elsif (m/^BYE$/o) {
212			exit(0);
213		} elsif (m/^ABORT$/o) {
214			abort_batch();
215		} else {
216			print "ERROR: Unknown command\n";
217		}
218	}
219}
220
221
222sub get_file
223{
224	my ($o, $file) = @_;
225	my $crlf="\015\012";
226	open my $fh, '>', $file;
227
228	my $start = 0;
229	my $end = 4000;
230	my $total_size = 0;
231
232	do {
233		$end *= 2;
234		$o->print("GET /pub/OpenBSD/snapshots/packages/amd64/$file HTTP/1.1$crlf",
235    "Host: www.w3.org$crlf",
236		"Range: bytes=",$start, "-", $end-1, $crlf, $crlf);
237
238		# get header
239
240		my $_ = $o->getline;
241		if (m,^HTTP/1\.1\s+(\d\d\d),) {
242			my $code = $1;
243			print "Code: $code\n";
244		} else {
245			print $_, "\n";
246		}
247		my $h = {};
248		while ($_ = $o->getline) {
249			last if m/^$/;
250			if (m/^([\w\-]+)\:\s*(.*)$/) {
251				print "$1 => $2\n";
252				$h->{$1} = $2;
253			} else {
254				print "unknown line: $_\n";
255			}
256		}
257
258		if (defined $h->{'Content-Range'} && $h->{'Content-Range'} =~
259			m/^bytes\s+\d+\-\d+\/(\d+)/) {
260				$total_size = $1;
261		}
262		print "END OF HEADER\n";
263
264		if (defined $h->{'Content-Length'}) {
265			my $v = $o->retrieve($h->{'Content-Length'});
266			print $fh $v;
267		}
268		$start = $end;
269	} while ($end < $total_size);
270}
271
2721;
273