1#! /usr/bin/perl
2
3# ex:ts=8 sw=4:
4# $OpenBSD: PkgCheck.pm,v 1.81 2023/06/16 10:38:29 espie Exp $
5#
6# Copyright (c) 2003-2014 Marc Espie <espie@openbsd.org>
7#
8# Permission to use, copy, modify, and distribute this software for any
9# purpose with or without fee is hereby granted, provided that the above
10# copyright notice and this permission notice appear in all copies.
11#
12# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
13# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
14# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
15# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
16# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
17# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
18# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
19
20use v5.36;
21
22use OpenBSD::AddCreateDelete;
23
24package Installer::State;
25our @ISA = qw(OpenBSD::PkgAdd::State);
26sub new($class, $cmd)
27{
28	my $state = $class->SUPER::new($cmd);
29	$state->{localbase} = OpenBSD::Paths->localbase;
30	return $state;
31}
32
33package Installer;
34our @ISA = qw(OpenBSD::PkgAdd);
35
36sub new($class, $mystate)
37{
38	my $state = Installer::State->new("pkg_check");
39	$state->{v} = $mystate->{v};
40	$state->{subst} = $mystate->{subst};
41	$state->{interactive} = $mystate->{interactive};
42	$state->{destdir} = $mystate->{destdir};
43	$state->{signature_style} = $mystate->{signature_style};
44	$state->progress->setup($state->opt('x'), $state->opt('m'), $state);
45	bless { state => $state}, $class;
46}
47
48sub install($self, $pkg)
49{
50	my $state = $self->{state};
51	push(@{$state->{setlist}},
52	    $state->updateset->add_hints2($pkg));
53	$self->try_and_run_command($state);
54	return $state->{bad} != 0;
55}
56
57package OpenBSD::PackingElement;
58sub thorough_check($self, $state)
59{
60	$self->basic_check($state);
61}
62
63sub basic_check($, $)
64{
65	1
66}
67
68# $self->find_dpendencies($state, $l, $checker, $pkgname)
69sub find_dependencies($, $, $, $, $)
70{
71}
72
73# XXX this is a snag for ShareLibs OO-ness
74# $self->mark_indirect_depends($pkgname, $state)
75sub mark_indirect_depends($self, $pkgname, $state)
76{
77	$self->mark_available_lib($pkgname, $state->shlibs);
78}
79
80# $self->cache_depends($copy)
81sub cache_depends($, $)
82{
83}
84
85package OpenBSD::PackingElement::DefineTag;
86
87sub mark_indirect_depends($self, $pkgname, $state)
88{
89	$state->{tagdefinition}{$self->name} = $pkgname;
90}
91
92package OpenBSD::PackingElement::FileBase;
93use File::Basename;
94
95sub basic_check($self, $state)
96{
97	my $name = $state->destdir($self->fullname);
98	$state->{known}{dirname($name)}{basename($name)} = 1;
99	if ($self->{symlink}) {
100		if (!-l $name) {
101			if (!-e $name) {
102				$state->log("#1 should be a symlink but does not exist", $name);
103			} else {
104				$state->log("#1 is not a symlink", $name);
105			}
106			return 0;
107		} else {
108			if (readlink($name) ne $self->{symlink}) {
109				$state->log("#1 should point to #2 but points to #3 instead",
110				    $name, $self->{symlink}, readlink($name));
111				return 0;
112			}
113		}
114		return 1;
115	}
116	if (!-e $name) {
117		if (-l $name) {
118			$state->log("#1 points to non-existent #2",
119			    $name, readlink($name));
120		} else {
121			$state->log("#1 should exist", $name);
122		}
123	    	return 0;
124	} elsif (!-f _) {
125		$state->log("#1 is not a file", $name);
126		return 0;
127	}
128	if ($self->{link}) {
129		my ($a, $b) = (stat _)[0, 1];
130		if (!-f $state->destdir($self->{link})) {
131			$state->log("#1 should link to non-existent #2",
132			    $name, $self->{link});
133			return 0;
134		} else {
135			my ($c, $d) = (stat _)[0, 1];
136			if (defined $a && defined $c) {
137				if ($a != $c || $b != $d) {
138					$state->log("#1 doesn't link to #2",
139					    $name, $self->{link});
140					return 0;
141				}
142			}
143
144		}
145	}
146	return 1;
147}
148
149sub thorough_check($self, $state)
150{
151	my $name = $state->destdir($self->fullname);
152	if (!$self->basic_check($state)) {
153		return;
154	}
155	return if $self->{link} or $self->{symlink} or $self->{nochecksum};
156	if (!-r $name) {
157		$state->log("can't read #1", $name);
158		return;
159	}
160	if (!defined $self->{d}) {
161		$state->log("no checksum for #1", $name);
162		return;
163	}
164	my $d = $self->compute_digest($name, $self->{d});
165	if (!$d->equals($self->{d})) {
166		$state->log("checksum for #1 does not match", $name);
167	}
168}
169
170package OpenBSD::PackingElement::SpecialFile;
171sub basic_check	# forwarder
172{
173	&OpenBSD::PackingElement::FileBase::basic_check;
174}
175
176sub thorough_check	# forwarder
177{
178	&OpenBSD::PackingElement::FileBase::basic_check;
179}
180
181package OpenBSD::PackingElement::DirlikeObject;
182sub basic_check($self, $state)
183{
184	my $name = $state->destdir($self->fullname);
185	$state->{known}{$name} //= {};
186	if (!-e $name) {
187		$state->log("#1 should exist", $name);
188	}
189	if (!-d _) {
190		$state->log("#1 is not a directory", $name);
191	}
192}
193
194package OpenBSD::PackingElement::Sample;
195use File::Basename;
196sub basic_check($self, $state)
197{
198	my $name = $state->destdir($self->fullname);
199	$state->{known}{dirname($name)}{basename($name)} = 1;
200	return 1;
201}
202
203package OpenBSD::PackingElement::Sampledir;
204sub basic_check($self, $state)
205{
206	my $name = $state->destdir($self->fullname);
207	$state->{known}{$name} //= {};
208	return 1;
209}
210
211package OpenBSD::PackingElement::Mandir;
212sub basic_check($self, $state)
213{
214	$self->SUPER::basic_check($state);
215	my $name = $state->destdir($self->fullname);
216	for my $file (OpenBSD::Paths->man_cruft) {
217		$state->{known}{$name}{$file} = 1;
218	}
219	return 1;
220}
221
222package OpenBSD::PackingElement::Fontdir;
223sub basic_check($self, $state)
224{
225	$self->SUPER::basic_check($state);
226	my $name = $state->destdir($self->fullname);
227	for my $i (qw(fonts.alias fonts.scale fonts.dir)) {
228		$state->{known}{$name}{$i} = 1;
229	}
230	return 1;
231}
232
233package OpenBSD::PackingElement::Infodir;
234sub basic_check($self, $state)
235{
236	$self->SUPER::basic_check($state);
237	my $name = $state->destdir($self->fullname);
238	$state->{known}{$name}{'dir'} = 1;
239	return 1;
240}
241
242package OpenBSD::PackingElement::Depend;
243sub cache_depends($self, $copy)
244{
245	$self->add_object($copy);
246}
247
248package OpenBSD::PackingElement::Dependency;
249sub find_dependencies($self, $state, $l, $checker, $pkgname)
250{
251	# several ways to failure
252	if (!$self->spec->is_valid) {
253		$state->log("invalid \@", $self->keyword, " ",
254		    $self->stringize);
255		return;
256	}
257	my @deps = $self->spec->filter(@$l);
258	if (@deps == 0) {
259		$state->log("dependency #1 in #2 does not match any installed package",
260		    $self->stringize, $pkgname);
261		return;
262	}
263	my $okay = 0;
264	for my $i (@deps) {
265		if ($checker->find($i)) {
266			$okay = 1;
267		}
268	}
269	if (!$okay) {
270		$checker->not_found($deps[0]);
271	}
272}
273
274package OpenBSD::PackingElement::Wantlib;
275sub find_dependencies($self, $state, $l, $checker, $pkgname)
276{
277	my $r = $state->shlibs->lookup_libspec($state->{localbase},
278	    $self->spec);
279	if (defined $r && @$r != 0) {
280		my $okay = 0;
281		for my $lib (@$r) {
282			my $i = $lib->origin;
283			if ($i eq 'system') {
284				$okay = 1;
285				$state->{needed_libs}{$lib->to_string} = 1;
286				next;
287			}
288			if ($checker->find($i)) {
289				$okay = 1;
290			}
291		}
292		if (!$okay) {
293			$checker->not_found($r->[0]->origin);
294		}
295	} else {
296		$state->log("#1 in #2 not found", $self->stringize, $pkgname);
297	}
298}
299
300package OpenBSD::PackingElement::Tag;
301sub find_dependencies($self, $state, $l, $checker, $pkgname)
302{
303	my $location = $state->{tagdefinition}{$self->name};
304	if (defined $location) {
305		if ($location eq $pkgname) {
306			return;
307		}
308		if (!$checker->find($location)) {
309			$checker->not_found($location);
310		}
311	} else {
312		$state->log("definition for #1 not found", $self->stringize);
313	}
314}
315
316sub cache_depends	# forwarder
317{
318	&OpenBSD::PackingElement::Depend::cache_depends;
319}
320
321package OpenBSD::PkgCheck::State;
322our @ISA = qw(OpenBSD::AddCreateDelete::State);
323
324use File::Spec;
325use OpenBSD::Log;
326use File::Basename;
327
328sub init($self)
329{
330	$self->{l} = OpenBSD::Log->new($self);
331	$self->SUPER::init;
332}
333
334sub log($self, @p)
335{
336	if (@p == 0) {
337		return $self->{l};
338	} else {
339		$self->{l}->say(@p);
340	}
341}
342
343sub handle_options($self)
344{
345	$self->{no_exports} = 1;
346
347	$self->add_interactive_options;
348	$self->SUPER::handle_options('fFB:q',
349		'[-FfIimnqvx] [-B pkg-destdir] [-D value]');
350	$self->{force} = $self->opt('f');
351	$self->{quick} = $self->opt('q') // 0;
352	$self->{filesystem} = $self->opt('F');
353	if (defined $self->opt('B')) {
354		$self->{destdir} = $self->opt('B');
355	}
356	if (defined $self->{destdir}) {
357		$self->{destdir} .= '/';
358	} else {
359		$self->{destdir} = '';
360	}
361}
362
363sub destdir($self, $path)
364{
365	return File::Spec->canonpath($self->{destdir}.$path);
366}
367
368sub process_entry($self, $entry)
369{
370	my $name = $self->destdir($entry);
371	$self->{known}{dirname($name)}{basename($name)} = 1;
372}
373
374package OpenBSD::DependencyCheck;
375
376sub new($class, $state, $name, $req)
377{
378	my $o = bless {
379		not_yet => {},
380		possible => {},
381		others => {},
382		name => $name,
383		req => $req
384	    }, $class;
385	for my $pkg ($req->list) {
386		$o->{not_yet}{$pkg} = 1;
387		if ($state->{exists}{$pkg}) {
388			$o->{possible}{$pkg} = 1;
389		} else {
390			$state->errsay("#1: bogus #2", $name, $o->string($pkg));
391		}
392	}
393	return $o;
394}
395
396sub find($self, $name)
397{
398	if ($self->{possible}{$name}) {
399		delete $self->{not_yet}{$name};
400		return 1;
401	} else {
402		return 0;
403	}
404}
405
406sub not_found($self, $name)
407{
408	$self->{others}{$name} = 1;
409}
410
411sub ask_delete_deps($self, $state, $l)
412{
413	if ($state->{force}) {
414		$self->{req}->delete(@$l);
415	} elsif ($state->confirm_defaults_to_no(
416	    "Remove extra #1", $self->string(@$l))) {
417			$self->{req}->delete(@$l);
418	}
419}
420
421sub ask_add_deps($self, $state, $l)
422{
423	if ($state->{force}) {
424		$self->{req}->add(@$l);
425	} elsif ($state->confirm_defaults_to_no(
426	    "Add missing #1", $self->string(@$l))) {
427			$self->{req}->add(@$l);
428	}
429}
430
431sub adjust($self, $state)
432{
433	if (keys %{$self->{not_yet}} > 0) {
434		my @todo = sort keys %{$self->{not_yet}};
435		unless ($state->{subst}->value("weed_libs")) {
436			@todo = grep {!/^\.libs/} @todo;
437		}
438		if (@todo != 0) {
439			$state->errsay("#1 has too many #2",
440			    $self->{name}, $self->string(@todo));
441			$self->ask_delete_deps($state, \@todo);
442		}
443	}
444	if (keys %{$self->{others}} > 0) {
445		my @todo = sort keys %{$self->{others}};
446		$state->errsay("#1 is missing #2",
447		    $self->{name}, $self->string(@todo));
448		    if ($self->{name} =~ m/^partial/) {
449			    $state->errsay("not a problem, since this is a partial- package");
450		    } else {
451			    $self->ask_add_deps($state, \@todo);
452		    }
453	}
454}
455
456package OpenBSD::DirectDependencyCheck;
457our @ISA = qw(OpenBSD::DependencyCheck);
458use OpenBSD::RequiredBy;
459sub string($self, @p)
460{
461	return "dependencies: ". join(' ', @p);
462}
463
464sub new($class, $state, $name)
465{
466	return $class->SUPER::new($state, $name,
467	    OpenBSD::Requiring->new($name));
468}
469
470package OpenBSD::ReverseDependencyCheck;
471our @ISA = qw(OpenBSD::DependencyCheck);
472use OpenBSD::RequiredBy;
473sub string($self, @p)
474{
475	return "reverse dependencies: ". join(' ', @p);
476}
477
478sub new($class, $state, $name)
479{
480	return $class->SUPER::new($state, $name,
481	    OpenBSD::RequiredBy->new($name));
482}
483
484package OpenBSD::Pkglocate;
485sub new($class, $state)
486{
487	bless {state => $state, result => {unknown => []},
488	    params => []}, $class;
489}
490
491sub add_param($self, @p)
492{
493	push(@{$self->{params}}, @p);
494	while (@{$self->{params}} > 200) {
495		$self->run_command;
496	}
497}
498
499sub run_command($self)
500{
501	if (@{$self->{params}} == 0) {
502		return;
503	}
504	my %h = map {($_, 1)} @{$self->{params}};
505	open(my $cmd, '-|', 'pkg_locate', map {"*:$_"} @{$self->{params}});
506	while (<$cmd>) {
507		chomp;
508		my ($pkgname, $pkgpath, $path) = split(':', $_, 3);
509
510		# pkglocate will return false positives, so trim them
511		if ($h{$path}) {
512			push(@{$self->{result}{"$pkgname:$pkgpath"} }, $path);
513			delete $h{$path};
514		}
515	}
516	close($cmd);
517	for my $k (keys %h) {
518		push(@{$self->{result}{unknown}}, $k);
519	}
520
521	$self->{params} = [];
522}
523
524sub show_results($self)
525{
526	while (@{$self->{params}} > 0) {
527		$self->run_command;
528	}
529	my $state = $self->{state};
530	my $r = $self->{result};
531	my $u = $r->{unknown};
532	delete $r->{unknown};
533
534	$state->say("Not found:");
535	for my $e (sort @$u) {
536		$state->say("\t#1", $e);
537	}
538
539	for my $k (sort keys %{$r}) {
540		$state->say("In #1:", $k);
541		for my $e (sort @{$r->{$k}}) {
542			$state->say("\t#1", $e);
543		}
544	}
545}
546
547package OpenBSD::PkgCheck;
548our @ISA = qw(OpenBSD::AddCreateDelete);
549
550use OpenBSD::PackageInfo;
551use OpenBSD::PackingList;
552use File::Find;
553use OpenBSD::Paths;
554use OpenBSD::Mtree;
555
556sub fill_base_system($self, $state)
557{
558	open(my $cmd, '-|', 'locate',
559	    '-d', OpenBSD::Paths->srclocatedb,
560	    '-d', OpenBSD::Paths->xlocatedb, ':');
561	while (<$cmd>) {
562		chomp;
563		my ($set, $path) = split(':', $_, 2);
564		$state->{basesystem}{$path} = 1;
565	}
566	close($cmd);
567}
568
569sub remove($self, $state, $name)
570{
571	$state->{removed}{$name} = 1;
572	my $dir = installed_info($name);
573	for my $i (@OpenBSD::PackageInfo::info) {
574		if (-e $dir.$i) {
575			if ($state->verbose) {
576				$state->say("unlink(#1)", $dir.$i);
577			}
578			unless ($state->{not}) {
579				unlink($dir.$i) or
580				    $state->errsay("#1: Couldn't delete #2: #3",
581				    	$name, $dir.$i, $!);
582			}
583		}
584	}
585	if (-f $dir) {
586		if ($state->verbose) {
587			$state->say("unlink(#1)", $dir);
588		}
589		unless ($state->{not}) {
590			unlink($dir) or
591			    $state->errsay("#1: Couldn't delete #2: #3",
592				$name, $dir, $!);
593		}
594	} elsif (-d $dir) {
595		if ($state->verbose) {
596			$state->say("rmdir(#1)", $dir);
597		}
598		unless ($state->{not}) {
599			rmdir($dir) or
600			    $state->errsay("#1: Couldn't delete #2: #3",
601			    	$name, $dir, $!);
602		}
603	}
604}
605
606sub may_remove($self, $state, $name)
607{
608	if ($state->{force}) {
609		$self->remove($state, $name);
610	} elsif ($state->confirm_defaults_to_no(
611	    "Remove wrong package #1", $name)) {
612			$self->remove($state, $name);
613	}
614	$state->{bogus}{$name} = 1;
615}
616
617sub may_unlink($self, $state, $path)
618{
619	if (!$state->{force} &&
620	    !$state->confirm_defaults_to_no("Remove #1", $path)) {
621		return;
622	}
623	if ($state->verbose) {
624		$state->say("remove #1", $path);
625	}
626	return if $state->{not};
627	unlink($path) or rmdir($path) or
628	    $state->errsay("Couldn't delete #1: #2", $path, $!);
629}
630
631sub may_fix_ownership($self, $state, $path)
632{
633	if (!$state->{force} &&
634	    !$state->confirm_defaults_to_no("Give #1 to root:wheel", $path)) {
635		return;
636	}
637	if ($state->verbose) {
638		$state->say("chown root:wheel #1", $path);
639	}
640	return if $state->{not};
641	chown 0, 0, $path or
642	    $state->errsay("Couldn't fix ownership for #1: #2", $path, $!);
643}
644
645sub may_fix_perms($self, $state, $path, $perm, $readable)
646{
647	if (!$state->{force} &&
648	    !$state->confirm_defaults_to_no("Make #1 #2", $path,
649	    ($readable ? "not world/group-writable" : "world readable"))) {
650		return;
651	}
652	if ($state->verbose) {
653		$state->say("chmod #1 #2", sprintf("%04o", $perm), $path);
654	}
655	return if $state->{not};
656	chmod $perm, $path or
657	    $state->errsay("Couldn't fix perms for #1: #2", $path, $!);
658}
659
660sub for_all_packages($self, $state, $l, $msg, $code)
661{
662	$state->progress->for_list($msg, $l,
663	    sub($name) {
664		return if $state->{removed}{$name};
665		if ($state->{bogus}{$name}) {
666			$state->errsay("skipping #1", $name);
667			return;
668		}
669		&$code($name);
670	    });
671}
672
673sub check_dir_permissions($self, $state, $dir)
674{
675	my ($perm, $uid, $gid) = (stat $dir)[2, 4, 5];
676	$perm &= 0777;
677
678	if (($perm & 0555) != 0555) {
679		$state->errsay("Directory #1 is not world-readable", $dir);
680		$perm |= 0555;
681		$self->may_fix_perms($state, $dir, $perm, 0);
682	}
683	if ($uid != 0 || $gid != 0) {
684		$state->errsay("Directory #1 does not belong to root:wheel",
685		    $dir);
686	    	$self->may_fix_ownership($state, $dir);
687	}
688	if (($perm & 0022) != 0) {
689		$state->errsay("Directory #1 is world/group writable", $dir);
690		$perm &= 0755;
691		$self->may_fix_perms($state, $dir, $perm, 1);
692	}
693}
694
695sub check_permissions($self, $state, $dir)
696{
697	$self->check_dir_permissions($state, $dir);
698	opendir(my $d, $dir) or return;
699	for my $name (readdir $d) {
700		next if $name eq '.' or $name eq '..';
701		my $file = $dir.$name;
702		if (!grep {$_ eq $name} (@OpenBSD::PackageInfo::info)) {
703			$state->errsay("Weird filename in pkg db: #1",
704			    $file);
705			$self->may_unlink($state, $file);
706			next;
707		}
708		my ($perm, $uid, $gid) = (stat $file)[2, 4, 5];
709		if (!-f $file) {
710			$state->errsay("#1 should be a file", $file);
711			$self->may_unlink($state, $file);
712			next;
713		}
714		$perm &= 0777;
715		if (($perm & 0444) != 0444) {
716			$state->errsay("File #1 is not world-readable", $file);
717			$perm |= 0444;
718			$self->may_fix_perms($state, $file, $perm, 0);
719		}
720		if ($uid != 0 || $gid != 0) {
721			$state->errsay("File #1 does not belong to root:wheel",
722			    $file);
723			$self->may_fix_ownership($state, $file);
724		}
725		if (($perm & 0022) != 0) {
726			$state->errsay("File #1 is world/group writable",
727			    $file);
728			$perm &= 0755;
729			$self->may_fix_perms($state, $file, $perm, 1);
730		}
731	}
732	closedir($d);
733}
734
735
736sub sanity_check($self, $state, $l)
737{
738	# let's find /var/db/pkg or its equivalent
739	my $base = installed_info("");
740	$base =~ s,/*$,,;
741	$self->check_dir_permissions($state, $base);
742
743	$self->for_all_packages($state, $l, "Packing-list sanity", sub($name) {
744		if ($name ne $state->safe($name)) {
745			$state->errsay("#1: bogus pkgname", $name);
746			$self->may_remove($state, $name);
747			return;
748		}
749		my $info = installed_info($name);
750		if (-f $info) {
751			$state->errsay("#1: #2 should be a directory",
752			    $name, $info);
753			if ($info =~ m/\.core$/) {
754				$state->errsay("looks like a core dump, ".
755					"removing");
756				$self->remove($state, $name);
757			} else {
758				$self->may_remove($state, $name);
759			}
760			return;
761		}
762		$self->check_permissions($state, $info);
763		my $contents = $info.OpenBSD::PackageInfo::CONTENTS;
764		unless (-f $contents) {
765			$state->errsay("#1: missing #2", $name, $contents);
766			$self->may_remove($state, $name);
767			return;
768		}
769		my $plist;
770		eval {
771			$plist = OpenBSD::PackingList->fromfile($contents);
772		};
773		if ($@ || !defined $plist) {
774			$state->errsay("#1: bad packing-list", $name);
775			if ($@) {
776				$state->errsay("#1", $@);
777			}
778			$self->may_remove($state, $name);
779			return;
780		}
781		if (!defined $plist->pkgname) {
782			$state->errsay("#1: no pkgname in plist", $name);
783			$self->may_remove($state, $name);
784			return;
785		}
786		if ($plist->pkgname ne $name) {
787			$state->errsay("#1: pkgname does not match", $name);
788			$self->may_remove($state, $name);
789		}
790		$plist->mark_indirect_depends($plist->pkgname, $state);
791		my $p = OpenBSD::PackingList->new;
792		$plist->cache_depends($p);
793		$state->{plist_cache}{$plist->pkgname} = $p;
794		$state->{exists}{$plist->pkgname} = 1;
795	});
796}
797
798sub dependencies_check($self, $state, $l)
799{
800	$state->shlibs->add_libs_from_system($state->{destdir});
801	$self->for_all_packages($state, $l, "Direct dependencies", sub($name) {
802		$state->log->set_context($name);
803		my $plist = $state->{plist_cache}{$name};
804		my $checker = OpenBSD::DirectDependencyCheck->new($state,
805		    $name);
806		$state->{localbase} = $plist->localbase;
807		$plist->find_dependencies($state, $l, $checker, $name);
808		$checker->adjust($state);
809		for my $dep ($checker->{req}->list) {
810			push(@{$state->{reverse}{$dep}}, $name);
811		}
812	});
813	delete $state->{plist_cache};
814}
815
816sub reverse_dependencies_check($self, $state, $l)
817{
818	$self->for_all_packages($state, $l, "Reverse dependencies", sub($name) {
819		my $checker = OpenBSD::ReverseDependencyCheck->new($state,
820		    $name);
821		for my $i (@{$state->{reverse}{$name}}) {
822			$checker->find($i) or $checker->not_found($i);
823		}
824		$checker->adjust($state);
825	});
826}
827
828sub package_files_check($self, $state, $l)
829{
830	$self->for_all_packages($state, $l, "Files from packages", sub($name) {
831		my $plist = OpenBSD::PackingList->from_installation($name);
832		$state->log->set_context($name);
833		if ($state->{quick}) {
834			$plist->basic_check($state);
835		} else {
836			$plist->thorough_check($state);
837		}
838		$plist->mark_available_lib($plist->pkgname, $state->shlibs);
839	});
840}
841
842sub install_pkglocate($self, $state)
843{
844	my $spec = 'pkglocatedb->=1.1';
845
846	my @l = installed_stems()->find('pkglocatedb');
847	require OpenBSD::PkgSpec;
848	if (OpenBSD::PkgSpec->new($spec)->match_ref(\@l)) {
849		return 1;
850	}
851	unless ($state->confirm_defaults_to_no("Unknown file system entries.\n".
852	    "Do you want to install $spec to look them up")) {
853	    	return 0;
854	}
855
856	require OpenBSD::PkgAdd;
857
858	$state->{installer} //= Installer->new($state);
859	if ($state->{installer}->install('pkglocatedb--')) {
860		return 1;
861	} else {
862		$state->errsay("Couldn't install #1", $spec);
863		return 0;
864	}
865}
866
867# non fancy display of unknown objects
868sub display_unknown($self, $state)
869{
870	if (defined $state->{unknown}{file}) {
871		$state->say("Unknown files:");
872		for my $e (sort @{$state->{unknown}{file}}) {
873			$state->say("\t#1", $e);
874		}
875	}
876	if (defined $state->{unknown}{dir}) {
877		$state->say("Unknown directories:");
878		for my $e (sort {$b cmp $a } @{$state->{unknown}{dir}}) {
879			$state->say("\t#1", $e);
880		}
881	}
882}
883
884sub display_tmps($self, $state)
885{
886	$state->say("Unregistered temporary files:");
887	for my $e (sort @{$state->{tmps}}) {
888		$state->say("\t#1", $e);
889	}
890	if ($state->{force}) {
891		unlink(@{$state->{tmps}});
892	} elsif ($state->confirm_defaults_to_no("Remove")) {
893			unlink(@{$state->{tmps}});
894	}
895}
896
897sub display_unregs($self, $state)
898{
899	$state->say("System libs NOT in locate dbs:");
900	for my $e (sort @{$state->{unreg_libs}}) {
901		$state->say("\t#1", $e);
902	}
903}
904
905sub locate_unknown($self, $state)
906{
907	my $locator = OpenBSD::Pkglocate->new($state);
908	if (defined $state->{unknown}{file}) {
909		$state->progress->for_list("Locating unknown files",
910		    $state->{unknown}{file},
911			sub($p) {
912				$locator->add_param($p);
913			});
914	}
915	if (defined $state->{unknown}{dir}) {
916		$state->progress->for_list("Locating unknown directories",
917		    $state->{unknown}{dir},
918			sub($p) {
919				$locator->add_param($p);
920			});
921	}
922	$locator->show_results;
923}
924
925sub fill_localbase($self, $state, $base)
926{
927	for my $file (OpenBSD::Paths->man_cruft) {
928		$state->{known}{$base."/man"}{$file} = 1;
929	}
930	$state->{known}{$base."/info"}{'dir'} = 1;
931	$state->{known}{$base."/lib/X11"}{'app-defaults'} = 1;
932	$state->{known}{$base."/libdata"} = {};
933	$state->{known}{$base."/libdata/perl5"} = {};
934}
935
936sub fill_root($self, $state, $root)
937{
938	OpenBSD::Mtree::parse($state->{known}, $root,
939	    '/etc/mtree/4.4BSD.dist', 1);
940	OpenBSD::Mtree::parse($state->{known}, $root,
941	    '/etc/mtree/BSD.x11.dist', 1);
942}
943
944sub filesystem_check($self, $state)
945{
946	$state->{known} //= {};
947	$self->fill_localbase($state,
948	    $state->destdir(OpenBSD::Paths->localbase));
949	my $root = $state->{destdir} || '/';
950	$self->fill_root($state, $root);
951	$self->fill_base_system($state);
952
953	$state->progress->set_header("Checking file system");
954	find(sub() {
955		$state->progress->working(1024);
956		if (-d $_) {
957			for my $i ('/dev', '/home', OpenBSD::Paths->pkgdb, '/var/log', '/var/backups', '/var/cron', '/var/run', '/tmp', '/var/tmp') {
958				if ($File::Find::name eq $state->destdir($i)) {
959					$File::Find::prune = 1;
960				}
961			}
962		}
963		if (defined $state->{basesystem}{$File::Find::name}) {
964			delete $state->{basesystem}{$File::Find::name};
965			return;
966		}
967		if (defined $state->{needed_libs}{$File::Find::name}) {
968			push(@{$state->{unreg_libs}}, $File::Find::name);
969			return;
970		}
971		if (-d $_) {
972			if ($_ eq "lost+found") {
973				$state->say("fsck(8) info found: #1",
974				    $File::Find::name);
975				$File::Find::prune = 1;
976				return;
977			}
978			# some directories we've got to ignore
979			if (! -r -x _) {
980				$File::Find::prune = 1;
981				$state->errsay("can't enter #1",
982				    $File::Find::name);
983			}
984			return if defined $state->{known}{$File::Find::name};
985			if (-l $_) {
986				return if $state->{known}{$File::Find::dir}{$_};
987			}
988			push(@{$state->{unknown}{dir}}, $File::Find::name);
989			$File::Find::prune = 1;
990		} else {
991			return if $state->{known}{$File::Find::dir}{$_};
992			if (m/^pkg\..{10}$/) {
993				push(@{$state->{tmps}}, $File::Find::name);
994			} else {
995				push(@{$state->{unknown}{file}},
996				    $File::Find::name);
997			}
998		}
999	}, $root);
1000	if (defined $state->{tmps}) {
1001		$self->display_tmps($state);
1002	}
1003	if (defined $state->{unreg_libs}) {
1004		$self->display_unregs($state);
1005	}
1006	if (defined $state->{unknown}) {
1007		if ($self->install_pkglocate($state)) {
1008			$self->locate_unknown($state);
1009		} else {
1010			$self->display_unknown($state);
1011		}
1012	}
1013}
1014
1015sub run($self, $state)
1016{
1017	my $list = [installed_packages()];
1018
1019	my $list2;
1020	if (@ARGV != 0) {
1021		$list2 = \@ARGV;
1022	} else {
1023		$list2 = $list;
1024	}
1025	$self->sanity_check($state, $list);
1026	$self->dependencies_check($state, $list);
1027	$state->log->dump;
1028	$self->reverse_dependencies_check($state, $list);
1029	$state->log->dump;
1030	if ($state->{quick} < 2) {
1031		$self->package_files_check($state, $list2);
1032		$state->log->dump;
1033	}
1034	if ($state->{filesystem}) {
1035		$self->filesystem_check($state);
1036		$state->progress->next;
1037	}
1038}
1039
1040sub parse_and_run($self, $cmd)
1041{
1042	my $state = OpenBSD::PkgCheck::State->new($cmd);
1043	$state->handle_options;
1044	lock_db(0, $state) unless $state->{subst}->value('nolock');
1045	$self->run($state);
1046	return 0;
1047}
1048
10491;
1050