1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: HTTP.pm,v 1.16 2023/07/03 17:01:59 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 v5.36;
20
21use OpenBSD::PackageRepository::Persistent;
22
23package OpenBSD::PackageRepository::HTTP1;
24our @ISA = qw(OpenBSD::PackageRepository::Persistent);
25sub urlscheme($)
26{
27	return 'http';
28}
29
30sub initiate($self)
31{
32	my ($rdfh, $wrfh);
33	pipe($self->{getfh}, $wrfh) or die;
34	pipe($rdfh, $self->{cmdfh}) or die;
35
36	my $old =select $self->{getfh};
37	$| = 1;
38	select $self->{cmdfh};
39	$| = 1;
40	select $rdfh;
41	$| = 1;
42	select $wrfh;
43	$| = 1;
44	select $old;
45	my $pid = fork();
46	if ($pid == 0) {
47		close($self->{getfh});
48		close($self->{cmdfh});
49#		close(STDOUT);
50#		close(STDIN);
51		open(STDOUT, '>&', $wrfh);
52		open(STDIN, '<&', $rdfh);
53		_Proxy::main($self);
54	} else {
55		close($rdfh);
56		close($wrfh);
57		$self->{controller} = $pid;
58	}
59}
60
61package _Proxy::Header;
62
63sub new($class)
64{
65	bless {}, $class;
66}
67
68sub code($self)
69{
70	return $self->{code};
71}
72
73package _Proxy::Connection;
74sub new($class, $host, $port)
75{
76	require IO::Socket::INET;
77	my $o = IO::Socket::INET->new(
78		PeerHost => $host,
79		PeerPort => $port);
80	my $old = select($o);
81	$| = 1;
82	select($old);
83	bless {fh => $o, host => $host, buffer => ''}, $class;
84}
85
86sub send_header($o, $document, %extra)
87{
88	my $crlf="\015\012";
89	$o->print("GET $document HTTP/1.1", $crlf,
90	    "Host: ", $o->{host}, $crlf);
91	if (defined $extra{range}) {
92		my ($a, $b) = @{$extra{range}};
93	    	$o->print("Range: bytes=$a-$b", $crlf);
94	}
95	$o->print($crlf);
96}
97
98sub get_header($o)
99{
100	my $l = $o->getline;
101	if ($l !~ m,^HTTP/1\.1\s+(\d\d\d),) {
102		return undef;
103	}
104	my $h = _Proxy::Header->new;
105	$h->{code} = $1;
106	while ($l = $o->getline) {
107		last if $l =~ m/^$/;
108		if ($l =~ m/^([\w\-]+)\:\s*(.*)$/) {
109			$h->{$1} = $2;
110		} else {
111			print STDERR "unknown line: $l\n";
112		}
113	}
114	if (defined $h->{'Content-Length'}) {
115		$h->{length} = $h->{'Content-Length'}
116	} elsif (defined $h->{'Transfer-Encoding'} &&
117	    $h->{'Transfer-Encoding'} eq 'chunked') {
118		$h->{chunked} = 1;
119	}
120	if (defined $h->{'Content-Range'} &&
121	    $h->{'Content-Range'} =~ m/^bytes\s+(\d+)\-(\d+)\/(\d+)/) {
122		($h->{start}, $h->{end}, $h->{size}) = ($1, $2, $3);
123	}
124	$o->{header} = $h;
125	return $h;
126}
127
128sub getline($self)
129{
130	while (1) {
131		if ($self->{buffer} =~ s/^(.*?)\015\012//) {
132			return $1;
133		}
134		my $buffer;
135		$self->{fh}->recv($buffer, 1024);
136		$self->{buffer}.=$buffer;
137    	}
138}
139
140sub retrieve($self, $sz)
141{
142	while(length($self->{buffer}) < $sz) {
143		my $buffer;
144		$self->{fh}->recv($buffer, $sz - length($self->{buffer}));
145		$self->{buffer}.=$buffer;
146	}
147	my $result= substr($self->{buffer}, 0, $sz);
148	$self->{buffer} = substr($self->{buffer}, $sz);
149	return $result;
150}
151
152sub retrieve_and_print($self, $sz, $fh)
153{
154	my $result = substr($self->{buffer}, 0, $sz);
155	print $fh $result;
156	my $retrieved = length($result);
157	if ($retrieved == $sz) {
158		$self->{buffer} = substr($self->{buffer}, $sz);
159		return;
160	} else {
161		$self->{buffer} = '';
162	}
163	while ($retrieved < $sz) {
164		$self->{fh}->recv($result, $sz - $retrieved);
165		print $fh $result;
166		$retrieved += length($result);
167	}
168}
169
170sub retrieve_chunked($self)
171{
172	my $result = '';
173	while (1) {
174		my $sz = $self->getline;
175		if ($sz =~ m/^([0-9a-fA-F]+)/) {
176			my $realsize = hex($1);
177			last if $realsize == 0;
178			$result .= $self->retrieve($realsize);
179		}
180	}
181	return $result;
182}
183
184sub retrieve_response($self, $h)
185{
186	if ($h->{chunked}) {
187		return $self->retrieve_chunked;
188	}
189	if ($h->{length}) {
190		return $self->retrieve($h->{length});
191	}
192	return undef;
193}
194
195sub retrieve_response_and_print($self, $h, $fh)
196{
197	if ($h->{chunked}) {
198		print $fh $self->retrieve_chunked;
199	}
200	if ($h->{length}) {
201		$self->retrieve_and_print($h->{length}, $fh);
202	}
203}
204
205sub print($self, @l)
206{
207#	print STDERR "Before print\n";
208	if (!print {$self->{fh}} @l) {
209		print STDERR "network print failed with $!\n";
210	}
211#	print STDERR "After print\n";
212}
213
214package _Proxy;
215
216my $pid;
217my $token = 0;
218
219sub batch($code)
220{
221	if (defined $pid) {
222		waitpid($pid, 0);
223		undef $pid;
224	}
225	$token++;
226	$pid = fork();
227	if (!defined $pid) {
228		print "ERROR: fork failed: $!\n";
229	}
230	if ($pid == 0) {
231		&$code();
232		exit(0);
233	}
234}
235
236sub abort_batch()
237{
238	if (defined $pid) {
239		kill HUP => $pid;
240		waitpid($pid, 0);
241		undef $pid;
242	}
243	print "\nABORTED $token\n";
244}
245
246sub get_directory($o, $dname)
247{
248	local $SIG{'HUP'} = 'IGNORE';
249	$o->send_header("$dname/");
250	my $h = $o->get_header;
251	if (!defined $h) {
252		print "ERROR: can't decode header\n";
253		exit 1;
254	}
255
256	my $r = $o->retrieve_response($h);
257	if (!defined $r) {
258		print "ERROR: can't decode response\n";
259	}
260	if ($h->code != 200) {
261			print "ERROR: code was ", $h->code, "\n";
262			exit 1;
263	}
264	print "SUCCESS: directory $dname\n";
265	for my $pkg ($r =~ m/\<A[^>]*\s+HREF=\"(.+?)\.tgz\"/gio) {
266		$pkg = $1 if $pkg =~ m|^.*/(.*)$|;
267		# decode uri-encoding; from URI::Escape
268		$pkg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
269		print $pkg, "\n";
270	}
271	print "\n";
272	return;
273}
274
275use File::Basename;
276
277sub get_file($o, $fname)
278{
279	my $bailout = 0;
280	$SIG{'HUP'} = sub {
281		$bailout++;
282	};
283	my $first = 1;
284	my $start = 0;
285	my $end = 2000;
286	my $total_size = 0;
287
288	do {
289		$end *= 2;
290		$o->send_header($fname, range => [$start, $end-1]);
291		my $h = $o->get_header;
292		if (!defined $h) {
293			print "ERROR\n";
294			exit 1;
295		}
296		if (defined $h->{size}) {
297			$total_size = $h->{size};
298		}
299		if ($h->code != 200 && $h->code != 206) {
300			print "ERROR: code was ", $h->code, "\n";
301			my $r = $o->retrieve_response($h);
302			exit 1;
303		}
304		if ($first) {
305			print "TRANSFER: $total_size\n";
306			$first = 0;
307		}
308		$o->retrieve_response_and_print($h, \*STDOUT);
309		$start = $end;
310		if ($bailout) {
311			exit 0;
312		}
313	} while ($end < $total_size);
314}
315
316sub main($self)
317{
318	my $o = _Proxy::Connection->new($self->{host}, "www");
319	while (<STDIN>) {
320		chomp;
321		if (m/^LIST\s+(.*)$/o) {
322			my $dname = $1;
323			batch(sub() {get_directory($o, $dname);});
324		} elsif (m/^GET\s+(.*)$/o) {
325			my $fname = $1;
326			batch(sub() { get_file($o, $fname);});
327		} elsif (m/^BYE$/o) {
328			exit(0);
329		} elsif (m/^ABORT$/o) {
330			abort_batch();
331		} else {
332			print "ERROR: Unknown command\n";
333		}
334	}
335}
336
3371;
338