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