HTTP.pm revision 1.3 
1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: HTTP.pm,v 1.3 2011/07/18 19:42:32 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 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 get_directory
127{
128	my ($o, $dname) = @_;
129	my $crlf="\015\012";
130	$o->print("GET $dname/ HTTP/1.1", $crlf,
131	    "Host: ", $o->{host}, $crlf, $crlf);
132	# get header
133
134	my $_ = $o->getline;
135	if (!m,^HTTP/1\.1\s+(\d\d\d),) {
136		print "ABORTED\n";
137		return;
138	}
139	my $code = $1;
140	if ($code != 200) {
141		print "ABORTED";
142		return;
143	}
144	my $h = {};
145	while ($_ = $o->getline) {
146		last if m/^$/;
147		if (m/^([\w\-]+)\:\s*(.*)$/) {
148			print "$1 => $2\n";
149			$h->{$1} = $2;
150		} else {
151			print "unknown line: $_\n";
152		}
153	}
154}
155
156sub main
157{
158	my $self = shift;
159	my $o = _Proxy::Connection->new($self->{host}, "www");
160	while (<STDIN>) {
161		chomp;
162		if (m/^LIST\s+(.*)$/o) {
163			my $dname = $1;
164			batch(sub {get_directory($o, $dname);});
165		} elsif (m/^GET\s+(.*)$/o) {
166			my $fname = $1;
167			batch(sub {
168				if (open(my $fh, '<', $fname)) {
169					my $size = (stat $fh)[7];
170					print "TRANSFER: $size\n";
171					my $buffer = '';
172					while (read($fh, $buffer, 1024 * 1024) > 0) {
173						print $buffer;
174					}
175					close($fh);
176				} else {
177					print "ERROR: bad file $fname $!\n";
178				}
179			});
180		} elsif (m/^BYE$/o) {
181			exit(0);
182		} elsif (m/^ABORT$/o) {
183			abort_batch();
184		} else {
185			print "ERROR: Unknown command\n";
186		}
187	}
188}
189
190
191sub get_file
192{
193	my ($o, $file) = @_;
194	my $crlf="\015\012";
195	open my $fh, '>', $file;
196
197	my $start = 0;
198	my $end = 4000;
199	my $total_size = 0;
200
201	do {
202		$end *= 2;
203		$o->print("GET /pub/OpenBSD/snapshots/packages/amd64/$file HTTP/1.1$crlf",
204    "Host: www.w3.org$crlf",
205		"Range: bytes=",$start, "-", $end-1, $crlf, $crlf);
206
207		# get header
208
209		my $_ = $o->getline;
210		if (m,^HTTP/1\.1\s+(\d\d\d),) {
211			my $code = $1;
212			print "Code: $code\n";
213		} else {
214			print $_, "\n";
215		}
216		my $h = {};
217		while ($_ = $o->getline) {
218			last if m/^$/;
219			if (m/^([\w\-]+)\:\s*(.*)$/) {
220				print "$1 => $2\n";
221				$h->{$1} = $2;
222			} else {
223				print "unknown line: $_\n";
224			}
225		}
226
227		if (defined $h->{'Content-Range'} && $h->{'Content-Range'} =~
228			m/^bytes\s+\d+\-\d+\/(\d+)/) {
229				$total_size = $1;
230		}
231		print "END OF HEADER\n";
232
233		if (defined $h->{'Content-Length'}) {
234			my $v = $o->retrieve($h->{'Content-Length'});
235			print $fh $v;
236		}
237		$start = $end;
238	} while ($end < $total_size);
239}
240
2411;
242