1# ex:ts=8 sw=4:
2# $OpenBSD: PackageRepository.pm,v 1.171 2019/11/08 14:50:58 espie Exp $
3#
4# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use strict;
19use warnings;
20
21# XXX load extra class, grab match from Base class, and tweak inheritance
22# to get all methods.
23
24use OpenBSD::PackageRepository::Installed;
25$OpenBSD::PackageRepository::Installed::ISA = qw(OpenBSD::PackageRepository);
26
27package OpenBSD::PackageRepository;
28our @ISA=(qw(OpenBSD::PackageRepositoryBase));
29
30use OpenBSD::PackageLocation;
31use OpenBSD::Paths;
32use OpenBSD::Error;
33use OpenBSD::Temp;
34
35sub make_error_file
36{
37	my ($self, $object) = @_;
38	$object->{errors} = OpenBSD::Temp->file;
39	if (!defined $object->{errors}) {
40		$self->{state}->fatal(OpenBSD::Temp->last_error);
41	}
42}
43
44sub baseurl
45{
46	my $self = shift;
47
48	return $self->{path};
49}
50
51sub new
52{
53	my ($class, $baseurl, $state) = @_;
54	if (!defined $state) {
55		require Carp;
56		Carp::croak "fatal: old api call to $class: needs state";
57	}
58	my $o = $class->parse(\$baseurl, $state);
59	if ($baseurl ne '') {
60		return undef;
61	}
62	return $o;
63}
64
65sub can_be_empty
66{
67	my $self = shift;
68	$self->{empty_okay} = 1;
69	return $self;
70}
71
72my $cache = {};
73
74sub unique
75{
76	my ($class, $o) = @_;
77	return $o unless defined $o;
78	if (defined $cache->{$o->url}) {
79		return $cache->{$o->url};
80	}
81	$cache->{$o->url} = $o;
82	return $o;
83}
84
85OpenBSD::Handler->atend(
86    sub {
87	for my $repo (values %$cache) {
88		$repo->cleanup;
89	}
90    });
91
92sub parse_fullurl
93{
94	my ($class, $r, $state) = @_;
95
96	$class->strip_urlscheme($r) or return undef;
97	return $class->unique($class->parse_url($r, $state));
98}
99
100sub dont_cleanup
101{
102}
103
104sub ftp() { 'OpenBSD::PackageRepository::FTP' }
105sub http() { 'OpenBSD::PackageRepository::HTTP' }
106sub https() { 'OpenBSD::PackageRepository::HTTPS' }
107sub scp() { 'OpenBSD::PackageRepository::SCP' }
108sub file() { 'OpenBSD::PackageRepository::Local' }
109sub installed() { 'OpenBSD::PackageRepository::Installed' }
110
111sub parse
112{
113	my ($class, $r, $state) = @_;
114
115	{
116	no warnings qw(uninitialized);	# in case installpath is empty
117	$$r =~ s/^installpath(\:|$)/$state->installpath.$1/e;
118	}
119
120	my $u = $$r;
121	return undef if $u eq '';
122
123
124
125	if ($u =~ m/^ftp\:/io) {
126		return $class->ftp->parse_fullurl($r, $state);
127	} elsif ($u =~ m/^http\:/io) {
128#		require OpenBSD::PackageRepository::HTTP;
129
130		return $class->http->parse_fullurl($r, $state);
131	} elsif ($u =~ m/^https\:/io) {
132		return $class->https->parse_fullurl($r, $state);
133	} elsif ($u =~ m/^scp\:/io) {
134		return undef if $state->defines("NO_SCP");
135
136		require OpenBSD::PackageRepository::SCP;
137
138		return $class->scp->parse_fullurl($r, $state);
139	} elsif ($u =~ m/^file\:/io) {
140		return $class->file->parse_fullurl($r, $state);
141	} elsif ($u =~ m/^inst\:$/io) {
142		return $class->installed->parse_fullurl($r, $state);
143	} else {
144		if ($$r =~ m/^([a-z0-9][a-z0-9.]+\.[a-z0-9.]+)(\:|$)/
145		    && !-d $1) {
146			$$r =~ s//http:\/\/$1\/%m$2/;
147			return $class->http->parse_fullurl($r, $state);
148		}
149		return $class->file->parse_fullurl($r, $state);
150	}
151}
152
153sub available
154{
155	my $self = shift;
156
157	return @{$self->list};
158}
159
160sub stemlist
161{
162	my $self = shift;
163	if (!defined $self->{stemlist}) {
164		require OpenBSD::PackageName;
165		my @l = $self->available;
166		if (@l == 0 && !$self->{empty_okay}) {
167			$self->{state}->errsay("#1: #2", $self->url,
168				$self->{no_such_dir} ? "no such dir" : "empty");
169		}
170		$self->{stemlist} = OpenBSD::PackageName::avail2stems(@l);
171	}
172	return $self->{stemlist};
173}
174
175sub wipe_info
176{
177	my ($self, $pkg) = @_;
178
179	require File::Path;
180
181	my $dir = $pkg->{dir};
182	if (defined $dir) {
183		OpenBSD::Error->rmtree($dir);
184		OpenBSD::Temp->reclaim($dir);
185		delete $pkg->{dir};
186	}
187}
188
189# by default, all objects may exist
190sub may_exist
191{
192	return 1;
193}
194
195# by default, we don't track opened files for this key
196
197sub opened
198{
199	undef;
200}
201
202# hint: 0 premature close, 1 real error. undef, normal !
203
204sub close
205{
206	my ($self, $object, $hint) = @_;
207	close($object->{fh}) if defined $object->{fh};
208	if (defined $object->{pid2}) {
209		local $SIG{ALRM} = sub {
210			kill HUP => $object->{pid2};
211		};
212		alarm(30);
213		waitpid($object->{pid2}, 0);
214		alarm(0);
215	}
216	$self->parse_problems($object->{errors}, $hint, $object)
217	    if defined $object->{errors};
218	undef $object->{errors};
219	$object->deref;
220}
221
222sub make_room
223{
224	my $self = shift;
225
226	# kill old files if too many
227	my $already = $self->opened;
228	if (defined $already) {
229		# gc old objects
230		if (@$already >= $self->maxcount) {
231			@$already = grep { defined $_->{fh} } @$already;
232		}
233		while (@$already >= $self->maxcount) {
234			my $o = shift @$already;
235			$self->close_now($o);
236		}
237	}
238	return $already;
239}
240
241# open method that tracks opened files per-host.
242sub open
243{
244	my ($self, $object) = @_;
245
246	return unless $self->may_exist($object->{name});
247
248	# kill old files if too many
249	my $already = $self->make_room;
250	local $SIG{'PIPE'} = 'DEFAULT';
251	my $fh = $self->open_pipe($object);
252	if (!defined $fh) {
253		return;
254	}
255	$object->{fh} = $fh;
256	if (defined $already) {
257		push @$already, $object;
258	}
259	return $fh;
260}
261
262sub find
263{
264	my ($repository, $name) = @_;
265	my $self = $repository->new_location($name);
266
267	if ($self->contents) {
268		return $self;
269	}
270	return undef;
271}
272
273sub grabPlist
274{
275	my ($repository, $name, $code) = @_;
276	my $self = $repository->new_location($name);
277
278	return $self->grabPlist($code);
279}
280
281sub parse_problems
282{
283	my ($self, $filename, $hint, $object) = @_;
284	CORE::open(my $fh, '<', $filename) or return;
285	my $baseurl = $self->url;
286	my $objecturl = $baseurl;
287	if (defined $object) {
288		$objecturl = $object->url;
289		$object->{error_reported} = 1;
290	}
291	my $notyet = 1;
292	my $broken = 0;
293	my $signify_error = 0;
294	$self->{last_error} = 0;
295	$self->{count}++;
296	while(<$fh>) {
297		if (m/^Redirected to (https?)\:\/\/([^\/]*)/) {
298			my ($scheme, $newhost) = ($1, $2);
299			$self->{state}->print("#1", $_);
300			next if $scheme ne $self->urlscheme;
301			# XXX try logging but syslog doesn't exist for Info
302			eval {
303			    $self->{state}->syslog("Redirected from #1 to #2",
304				$self->{host}, $newhost);
305			};
306			$self->{host} = $newhost;
307			$self->setup_session;
308			$baseurl = $self->url;
309			next;
310		}
311		next if m/^(?:200|220|221|226|229|230|227|250|331|500|150)[\s\-]/o;
312		next if m/^EPSV command not understood/o;
313		next if m/^Trying [\da-f\.\:]+\.\.\./o;
314		# XXX make_room may call close_now on objects of the right
315		# type, but from a different repository
316		next if m/^Requesting (?:\Q$baseurl\E|\Q$objecturl\E)/;
317		next if m/^Remote system type is\s+/o;
318		next if m/^Connected to\s+/o;
319		next if m/^remote\:\s+/o;
320		next if m/^Using binary mode to transfer files/o;
321		next if m/^Retrieving\s+/o;
322		next if m/^Success?fully retrieved file/o;
323		next if m/^\d+\s+bytes\s+received\s+in/o;
324		next if m/^ftp: connect to address.*: No route to host/o;
325		if (m/^ftp: Writing -: Broken pipe/o) {
326			$broken = 1;
327			next;
328		}
329		if (m/^tls session resumed\: (\w+)/) {
330			next; # disable the detailed handling for now
331			my $s = $1;
332			if ($s eq 'yes') {
333				# everything okay for now
334				$self->{said_slow} = 0;
335				next;
336			}
337			next if $self->{count} < 2 || $self->{said_slow};
338			$self->{said_slow} = 1;
339			$self->{state}->say("#1: no session resumption supported by ftp(1) on connection ##2", $self->{host}, $self->{count});
340			$self->{state}->say("#1: https will be slow", $self->{host});
341			next;
342		}
343		# http error
344		if (m/^ftp: Error retrieving .*: 404/o) {
345			$self->{lasterror} = 404;
346			if (!defined $object) {
347				$self->{no_such_dir} = 1;
348				next;
349			}
350			# ignore errors for stable packages
351			next if $self->can_be_empty;
352		}
353
354		if (defined $hint && $hint == 0) {
355			next if m/^ftp: -: short write/o;
356			next if m/^ftp: local: -: Broken pipe/o;
357			next if m/^421\s+/o;
358		}
359		# not retrieving the file => always the same message
360		# so it's superfluous
361		next if m/^signify:/ && $self->{lasterror};
362		if ($notyet) {
363			$self->{state}->errprint("#1: ", $objecturl);
364			$notyet = 0;
365		}
366		if (m/^signify:/) {
367			$signify_error = 1;
368			s/.*unsigned .*archive.*/unsigned package/;
369		}
370		if (m/^421\s+/o ||
371		    m/^ftp: connect: Connection timed out/o ||
372		    m/^ftp: Can't connect or login to host/o) {
373			$self->{lasterror} = 421;
374		}
375		if (m/^550\s+/o) {
376			$self->{lasterror} = 550;
377		}
378		$self->{state}->errprint("#1", $_);
379	}
380	if ($broken) {
381		unless ($signify_error || defined $hint && $hint == 0) {
382			$self->{state}->errprint('#1', "ftp: Broken pipe");
383		}
384	}
385	CORE::close($fh);
386	OpenBSD::Temp->reclaim($filename);
387	unlink $filename;
388}
389
390sub cleanup
391{
392	# nothing to do
393}
394
395sub relative_url
396{
397	my ($self, $name) = @_;
398	if (defined $name) {
399		return $self->baseurl.$name.".tgz";
400	} else {
401		return $self->baseurl;
402	}
403}
404
405sub add_to_list
406{
407	my ($self, $list, $filename) = @_;
408	if ($filename =~ m/^(.*\-\d.*)\.tgz$/o) {
409		push(@$list, $1);
410	}
411}
412
413sub did_it_fork
414{
415	my ($self, $pid) = @_;
416	if (!defined $pid) {
417		$self->{state}->fatal("Cannot fork: #1", $!);
418	}
419	if ($pid == 0) {
420		delete $SIG{'WINCH'};
421		delete $SIG{'CONT'};
422		delete $SIG{'INFO'};
423	}
424}
425
426sub uncompress
427{
428	my $self = shift;
429	my $object = shift;
430	require IO::Uncompress::Gunzip;
431	my $fh = IO::Uncompress::Gunzip->new(@_, MultiStream => 1);
432	my $result = "";
433	if ($object->{is_signed}) {
434		my $h = $fh->getHeaderInfo;
435		if ($h) {
436			for my $line (split /\n/, $h->{Comment}) {
437				if ($line =~ m/^key=.*\/(.*)\.sec$/) {
438					$result .= "\@signer $1\n";
439				} elsif ($line =~ m/^date=(.*)$/) {
440					$result .= "\@digital-signature signify2:$1:external\n";
441				}
442			}
443		} else {
444			$fh->close;
445			return undef;
446		}
447	}
448	$object->{extra_content} = $result;
449	return $fh;
450}
451
452sub signify_pipe
453{
454	my $self = shift;
455	my $object = shift;
456	CORE::open STDERR, ">>", $object->{errors};
457	exec {OpenBSD::Paths->signify}
458	    ("signify",
459	    "-zV",
460	    @_)
461	or $self->{state}->fatal("Can't run #1: #2",
462	    OpenBSD::Paths->signify, $!);
463}
464
465sub check_signed
466{
467	my ($self, $object) = @_;
468	if ($object->{repository}{trusted}) {
469		return 0;
470	}
471	if ($self->{state}{signature_style} eq 'new') {
472		$object->{is_signed} = 1;
473		return 1;
474	} else {
475		return 0;
476	}
477}
478
479package OpenBSD::PackageRepository::Local;
480our @ISA=qw(OpenBSD::PackageRepository);
481use OpenBSD::Error;
482
483sub is_local_file
484{
485	return 1;
486}
487
488sub urlscheme
489{
490	return 'file';
491}
492
493my $pkg_db;
494
495sub pkg_db
496{
497	if (!defined $pkg_db) {
498		use OpenBSD::Paths;
499		$pkg_db = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb;
500	}
501	return $pkg_db;
502}
503
504sub parse_fullurl
505{
506	my ($class, $r, $state) = @_;
507
508	my $ok = $class->strip_urlscheme($r);
509	my $o = $class->parse_url($r, $state);
510	if (!$ok && $o->{path} eq $class->pkg_db."/") {
511		return $class->installed->new(0, $state);
512	} else {
513		if ($o->{path} eq './') {
514			$o->can_be_empty;
515		}
516		return $class->unique($o);
517	}
518}
519
520# wrapper around copy, that sometimes does not copy
521sub may_copy
522{
523	my ($self, $object, $destdir) = @_;
524	my $src = $self->relative_url($object->{name});
525	require File::Spec;
526	my (undef, undef, $base) = File::Spec->splitpath($src);
527	my $dest = File::Spec->catfile($destdir, $base);
528	if (File::Spec->canonpath($dest) eq File::Spec->canonpath($src)) {
529	    	return;
530	}
531	if (-f $dest) {
532		my ($ddev, $dino) = (stat $dest)[0,1];
533		my ($sdev, $sino) = (stat $src)[0, 1];
534		if ($ddev == $sdev and $sino == $dino) {
535			return;
536		}
537	}
538	$self->{state}->copy_file($src, $destdir);
539}
540
541sub open_pipe
542{
543	my ($self, $object) = @_;
544	if (defined $self->{state}->cache_directory) {
545		$self->may_copy($object, $self->{state}->cache_directory);
546	}
547	my $name = $self->relative_url($object->{name});
548	if ($self->check_signed($object)) {
549		$self->make_error_file($object);
550		my $pid = open(my $fh, "-|");
551		$self->did_it_fork($pid);
552		if ($pid) {
553			$object->{pid} = $pid;
554			return $self->uncompress($object, $fh);
555		} else {
556			$self->signify_pipe($object, "-x", $name);
557		}
558	} else {
559		return $self->uncompress($object, $name);
560	}
561}
562
563sub may_exist
564{
565	my ($self, $name) = @_;
566	return -r $self->relative_url($name);
567}
568
569my $local = [];
570
571sub opened
572{
573	return $local;
574}
575
576sub maxcount
577{
578	return 3;
579}
580
581sub list
582{
583	my $self = shift;
584	my $l = [];
585	my $dname = $self->baseurl;
586	opendir(my $dir, $dname) or return $l;
587	while (my $e = readdir $dir) {
588		next unless -f "$dname/$e";
589		$self->add_to_list($l, $e);
590	}
591	close($dir);
592	return $l;
593}
594
595package OpenBSD::PackageRepository::Distant;
596our @ISA=qw(OpenBSD::PackageRepository);
597
598sub baseurl
599{
600	my $self = shift;
601
602	return "//$self->{host}$self->{path}";
603}
604
605sub setup_session
606{
607	# nothing to do except for https
608}
609
610sub parse_url
611{
612	my ($class, $r, $state) = @_;
613	# same heuristics as ftp(1):
614	# find host part, rest is parsed as a local url
615	if (my ($host, $path) = $$r =~ m/^\/\/(.*?)(\/.*)$/) {
616
617		$$r = $path;
618		my $o = $class->SUPER::parse_url($r, $state);
619		$o->{host} = $host;
620		if (defined $o->{release}) {
621			$o->can_be_empty;
622			$$r = $class->urlscheme."://$o->{host}$o->{release}:$$r";
623		}
624		$o->setup_session;
625		return $o;
626	} else {
627		return undef;
628	}
629}
630
631my $buffsize = 2 * 1024 * 1024;
632
633sub pkg_copy
634{
635	my ($self, $in, $object) = @_;
636
637	my $name = $object->{name};
638	my $dir = $object->{cache_dir};
639
640	my ($copy, $filename) = OpenBSD::Temp::permanent_file($dir, $name) or
641		$self->{state}->fatal(OpenBSD::Temp->last_error);
642	chmod((0666 & ~umask), $filename);
643	$object->{tempname} = $filename;
644	my $handler = sub {
645		my ($sig) = @_;
646		unlink $filename;
647		close($in);
648		$SIG{$sig} = 'DEFAULT';
649		kill $sig, $$;
650	};
651
652	my $nonempty = 0;
653	my $error = 0;
654	{
655
656	local $SIG{'PIPE'} =  $handler;
657	local $SIG{'INT'} =  $handler;
658	local $SIG{'HUP'} =  $handler;
659	local $SIG{'QUIT'} =  $handler;
660	local $SIG{'KILL'} =  $handler;
661	local $SIG{'TERM'} =  $handler;
662
663	my ($buffer, $n);
664	# copy stuff over
665	do {
666		$n = sysread($in, $buffer, $buffsize);
667		if (!defined $n) {
668			$self->{state}->fatal("Error reading: #1", $!);
669		}
670		if ($n > 0) {
671			$nonempty = 1;
672		}
673		if (!$error) {
674			my $r = syswrite $copy, $buffer;
675			if (!defined $r || $r < $n) {
676				$error = 1;
677			}
678		}
679		syswrite STDOUT, $buffer;
680	} while ($n != 0);
681	close($copy);
682	}
683
684	if ($nonempty && !$error) {
685		rename $filename, "$dir/$name.tgz";
686	} else {
687		unlink $filename;
688	}
689	close($in);
690}
691
692sub open_pipe
693{
694	my ($self, $object) = @_;
695	$self->make_error_file($object);
696	my $d = $self->{state}->cache_directory;
697	if (defined $d) {
698		$object->{cache_dir} = $d;
699		if (! -d -w $d) {
700			$self->{state}->fatal("bad PKG_CACHE directory #1", $d);
701		}
702		$object->{cache_dir} = $d;
703	}
704	$object->{parent} = $$;
705
706	my ($rdfh, $wrfh);
707
708	pipe($rdfh, $wrfh);
709	my $pid2 = fork();
710	$self->did_it_fork($pid2);
711	if ($pid2) {
712		$object->{pid2} = $pid2;
713		close($wrfh);
714	} else {
715		open STDERR, '>>', $object->{errors};
716		open(STDOUT, '>&', $wrfh);
717		close($rdfh);
718		close($wrfh);
719		if (defined $d) {
720			my $pid3 = open(my $in, "-|");
721			$self->did_it_fork($pid3);
722			if ($pid3) {
723				$self->dont_cleanup;
724				$self->pkg_copy($in, $object);
725			} else {
726				$self->grab_object($object);
727			}
728		} else {
729			$self->grab_object($object);
730		}
731		exit(0);
732	}
733
734	if ($self->check_signed($object)) {
735		my $pid = open(my $fh, "-|");
736		$self->did_it_fork($pid);
737		if ($pid) {
738			$object->{pid} = $pid;
739			close($rdfh);
740		} else {
741			open(STDIN, '<&', $rdfh) or
742			    $self->{state}->fatal("Bad dup: #1", $!);
743			close($rdfh);
744			$self->signify_pipe($object);
745		}
746
747		return $self->uncompress($object, $fh);
748	} else {
749		return $self->uncompress($object, $rdfh);
750	}
751}
752
753sub finish_and_close
754{
755	my ($self, $object) = @_;
756	if (defined $object->{cache_dir}) {
757		while (defined $object->next) {
758		}
759	}
760	$self->SUPER::finish_and_close($object);
761}
762
763package OpenBSD::PackageRepository::HTTPorFTP;
764our @ISA=qw(OpenBSD::PackageRepository::Distant);
765
766our %distant = ();
767
768my ($fetch_uid, $fetch_gid, $fetch_user);
769
770sub fill_up_fetch_data
771{
772	my $self = shift;
773	if ($< == 0) {
774		$fetch_user = '_pkgfetch';
775		unless ((undef, undef, $fetch_uid, $fetch_gid) =
776		    getpwnam($fetch_user)) {
777			$self->{state}->fatal(
778			    "Couldn't change identity: can't find #1 user",
779			    $fetch_user);
780		}
781	} else {
782		($fetch_user) = getpwuid($<);
783    	}
784}
785
786sub fetch_id
787{
788	my $self = shift;
789	if (!defined $fetch_user) {
790		$self->fill_up_fetch_data;
791	}
792	return ($fetch_uid, $fetch_gid, $fetch_user);
793}
794
795sub ftp_cmd
796{
797	my $self = shift;
798	return OpenBSD::Paths->ftp;
799}
800
801sub drop_privileges_and_setup_env
802{
803	my $self = shift;
804	my ($uid, $gid, $user) = $self->fetch_id;
805	if (defined $uid) {
806		# we happen right before exec, so change id permanently
807		$( = $gid;
808		$) = "$gid $gid";
809		$< = $uid;
810		$> = $uid;
811	}
812	# create sanitized env for ftp
813	my %newenv = (
814		HOME => '/var/empty',
815		USER => $user,
816		LOGNAME => $user,
817		SHELL => '/bin/sh',
818		LC_ALL => 'C', # especially, laundry error messages
819		PATH => '/bin:/usr/bin'
820	    );
821
822	# copy selected stuff;
823	for my $k (qw(
824	    TERM
825	    FTPMODE
826	    FTPSERVER
827	    FTPSERVERPORT
828	    ftp_proxy
829	    http_proxy
830	    http_cookies
831	    ALL_PROXY
832	    FTP_PROXY
833	    HTTPS_PROXY
834	    HTTP_PROXY
835	    NO_PROXY)) {
836	    	if (exists $ENV{$k}) {
837			$newenv{$k} = $ENV{$k};
838		}
839	}
840	# don't forget to swap!
841	%ENV = %newenv;
842}
843
844
845sub grab_object
846{
847	my ($self, $object) = @_;
848	my ($ftp, @extra) = split(/\s+/, $self->ftp_cmd);
849	$self->drop_privileges_and_setup_env;
850	exec {$ftp}
851	    $ftp,
852	    @extra,
853	    "-o",
854	    "-", $self->url($object->{name})
855	or $self->{state}->fatal("Can't run #1: #2", $self->ftp_cmd, $!);
856}
857
858sub open_read_ftp
859{
860	my ($self, $cmd, $errors) = @_;
861	my $child_pid = open(my $fh, '-|');
862	if ($child_pid) {
863		$self->{pipe_pid} = $child_pid;
864		return $fh;
865	} else {
866		open STDERR, '>>', $errors if defined $errors;
867
868		$self->drop_privileges_and_setup_env;
869		exec($cmd)
870		or $self->{state}->fatal("Can't run #1: #2", $cmd, $!);
871	}
872}
873
874sub close_read_ftp
875{
876	my ($self, $fh) = @_;
877	close($fh);
878	waitpid $self->{pipe_pid}, 0;
879}
880
881sub maxcount
882{
883	return 1;
884}
885
886sub opened
887{
888	my $self = $_[0];
889	my $k = $self->{host};
890	if (!defined $distant{$k}) {
891		$distant{$k} = [];
892	}
893	return $distant{$k};
894}
895
896sub should_have
897{
898	my ($self, $pkgname) = @_;
899	if (defined $self->{lasterror} && $self->{lasterror} == 421) {
900		return (defined $self->{list}) &&
901			grep { $_ eq $pkgname } @{$self->{list}};
902	} else {
903		return 0;
904	}
905}
906
907sub try_until_success
908{
909	my ($self, $pkgname, $code) = @_;
910
911	for (my $retry = 5; $retry <= 160; $retry *= 2) {
912		undef $self->{lasterror};
913		my $o = &$code;
914		if (defined $o) {
915			return $o;
916		}
917		if (defined $self->{lasterror} &&
918		    ($self->{lasterror} == 550 || $self->{lasterror} == 404)) {
919			last;
920		}
921		if ($self->should_have($pkgname)) {
922			$self->errsay("Temporary error, sleeping #1 seconds",
923				$retry);
924			sleep($retry);
925		}
926	}
927	return undef;
928}
929
930sub find
931{
932	my ($self, $pkgname, @extra) = @_;
933
934	return $self->try_until_success($pkgname,
935	    sub {
936	    	return $self->SUPER::find($pkgname, @extra); });
937
938}
939
940sub grabPlist
941{
942	my ($self, $pkgname, @extra) = @_;
943
944	return $self->try_until_success($pkgname,
945	    sub {
946	    	return $self->SUPER::grabPlist($pkgname, @extra); });
947}
948
949sub list
950{
951	my ($self) = @_;
952	if (!defined $self->{list}) {
953		$self->make_room;
954		my $error = OpenBSD::Temp->file;
955		if (!defined $error) {
956			$self->{state}->fatal(OpenBSD::Temp->last_error);
957		}
958		$self->{list} = $self->obtain_list($error);
959		$self->parse_problems($error);
960	}
961	return $self->{list};
962}
963
964sub get_http_list
965{
966	my ($self, $error) = @_;
967
968	my $fullname = $self->url;
969	my $l = [];
970	my $fh = $self->open_read_ftp($self->ftp_cmd." -o - $fullname",
971	    $error) or return;
972	while(<$fh>) {
973		chomp;
974		for my $pkg (m/\<A[^>]*\s+HREF=\"(.*?\.tgz)\"/gio) {
975			$pkg = $1 if $pkg =~ m|^.*/(.*)$|;
976			# decode uri-encoding; from URI::Escape
977			$pkg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
978			$self->add_to_list($l, $pkg);
979		}
980	}
981	$self->close_read_ftp($fh);
982	return $l;
983}
984
985package OpenBSD::PackageRepository::HTTP;
986our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP);
987
988sub urlscheme
989{
990	return 'http';
991}
992
993sub obtain_list
994{
995	my ($self, $error) = @_;
996	return $self->get_http_list($error);
997}
998
999package OpenBSD::PackageRepository::HTTPS;
1000our @ISA=qw(OpenBSD::PackageRepository::HTTP);
1001
1002sub urlscheme
1003{
1004	return 'https';
1005}
1006
1007sub setup_session
1008{
1009	my $self = shift;
1010
1011	require OpenBSD::Temp;
1012	$self->{count} = 0;
1013	local ($>, $));
1014	my ($uid, $gid, $user) = $self->fetch_id;
1015	if (defined $uid) {
1016		$> = $uid;
1017		$) = "$gid $gid";
1018	}
1019	my ($fh, undef) = OpenBSD::Temp::fh_file("session",
1020		sub { unlink(shift); });
1021	if (!defined $fh) {
1022		$self->{state}->fatal(OpenBSD::Temp->last_error);
1023	}
1024	$self->{fh} = $fh; # XXX store the full fh and not the fileno
1025}
1026
1027sub ftp_cmd
1028{
1029	my $self = shift;
1030	return $self->SUPER::ftp_cmd." -S session=/dev/fd/".fileno($self->{fh});
1031}
1032
1033sub drop_privileges_and_setup_env
1034{
1035	my $self = shift;
1036	$self->SUPER::drop_privileges_and_setup_env;
1037	# reset the CLOEXEC flag on that one
1038	use Fcntl;
1039	fcntl($self->{fh}, F_SETFD, 0);
1040}
1041
1042package OpenBSD::PackageRepository::FTP;
1043our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP);
1044
1045sub urlscheme
1046{
1047	return 'ftp';
1048}
1049
1050sub _list
1051{
1052	my ($self, $cmd, $error) = @_;
1053	my $l =[];
1054	my $fh = $self->open_read_ftp($cmd, $error) or return;
1055	while(<$fh>) {
1056		chomp;
1057		next if m/^\d\d\d\s+\S/;
1058		if (m/No such file or directory|Failed to change directory/i) {
1059			$self->{no_such_dir} = 1;
1060		}
1061		next unless m/^(?:\.\/)?(\S+\.tgz)\s*$/;
1062		$self->add_to_list($l, $1);
1063	}
1064	$self->close_read_ftp($fh);
1065	return $l;
1066}
1067
1068sub get_ftp_list
1069{
1070	my ($self, $error) = @_;
1071
1072	my $fullname = $self->url;
1073	return $self->_list("echo 'nlist'| ".$self->ftp_cmd." $fullname",
1074	    $error);
1075}
1076
1077sub obtain_list
1078{
1079	my ($self, $error) = @_;
1080	if (defined $ENV{'ftp_proxy'} && $ENV{'ftp_proxy'} ne '') {
1081		return $self->get_http_list($error);
1082	} else {
1083		return $self->get_ftp_list($error);
1084	}
1085}
1086
10871;
1088