#!/usr/bin/perl

# $OpenBSD: pkg_check-problems,v 1.14 2023/05/14 15:06:11 espie Exp $
# Copyright (c) 2004, 2010 Marc Espie <espie@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# check all packages in the current directory, and report common directory
# issues

use v5.36;
my ($ports1);

use FindBin;
BEGIN {
	$ports1 = $ENV{PORTSDIR} || '/usr/ports';
}
use lib ("$ports1/infrastructure/lib", "$FindBin::Bin/../lib");

use File::Spec;
use File::Path;
use File::Basename;
use OpenBSD::PkgCfl;
use OpenBSD::Mtree;
use OpenBSD::PlistScanner;

# code for checking directories
sub register_dir($d, $h)
{
	return if defined $h->{$d};
	$h->{$d} = 1;
	register_dir(dirname($d), $h);
}

package OpenBSD::PackingElement;
# $self->register($o, $db, $pkgname)
sub register($, $, $, $)
{
}

# $self->known_page($h)
sub known_page($, $)
{
}

# $self_>add_extra_manpage($known, $plist)
sub add_extra_manpage($, $, $)
{
}

package OpenBSD::PackingElement::FileBase;

use File::Basename;
sub register($self, $o, $db, $pkgname)
{
	# common dirs
	if ($o->{do_dirs}) {
		my $d = File::Spec->canonpath($self->fullname);
		main::register_dir(dirname($d), $db->{need_dirs});
	}
	# conflicts
	if (defined $o->{filehash}) {
		my $all_conflict = $o->{filehash};
		my $pkg_list = $o->{pkg_list};
		my $seen = $o->{seen};

		my $file = File::Spec->canonpath($self->fullname);
		# build one single list for each pkgnames combination
		if (exists $all_conflict->{$file}) {
			$pkg_list->{$all_conflict->{$file}}{$pkgname} ||=
			    [@{$all_conflict->{$file}}, $pkgname ];
			$all_conflict->{$file} = 
			    $pkg_list->{$all_conflict->{$file}}{$pkgname};
		} elsif (exists $seen->{$file}) {
			$pkg_list->{$seen->{$file}}{$pkgname} ||=
			    [ @{$seen->{$file}}, $pkgname ];
			$all_conflict->{$file} = 
			    $pkg_list->{$seen->{$file}}{$pkgname};
			delete $seen->{$file};
		} else {
			$pkg_list->{$pkgname} ||= [$pkgname];
			$seen->{$file} = $pkg_list->{$pkgname};
		}
	}
}

package OpenBSD::PackingElement::DirlikeObject;
sub register($self, $o, $db, $)
{
	if ($o->{do_dirs}) {
		my $d = File::Spec->canonpath($self->fullname);
		$db->{dirs}{$d} = 1;
	}
}

package OpenBSD::PackingElement::Dependency;
sub register($self, $o, $db, $pkgname)
{
	$db->{deps}{$self->{def}} = 1;
	$o->{wanted}{$self->{def}} //= $o->{currentname};
	$o->{pkgpath}{$self->{def}} = $self->{pkgpath};
	push @{$o->{all_deps}{$pkgname}}, $self->{def};
}

package OpenBSD::PackingElement::ExtraInfo;
sub register($self, $o, $, $pkgname)
{
	if ($self->{ftp} eq 'yes') {
		$o->{ftp_okay}{$pkgname} = 1;
	} else {
		$o->{ftp_okay}{$pkgname} = 0;
	}
}

package OpenBSD::PackingElement::Manpage;

sub is_dest($self)
{
	return $self->name =~ m/man\/cat[^\/]+\/[^\/]+\.0$/o;
}

sub dest_to_source($self)
{
	my $v = $self->name;
	$v =~ s/(man\/)cat([^\/]+)(\/[^\/]+)\.0$/$1man$2$3.$2/;
	return $v;
}

sub known_page($self, $h)
{
	$h->{File::Spec->canonpath($self->fullname)} = 1;
}

sub add_extra_manpage($self, $known, $plist)
{
	if ($self->is_source) {
		my $dest = $self->source_to_dest;
		my $fullname = $self->cwd."/".$dest;
		my $file = File::Spec->canonpath($fullname);
		if (!$known->{$file}) {
			OpenBSD::PackingElement::Manpage->add($plist, $dest);
			$known->{$file} = 1;
		}
	}
	if ($self->is_dest) {
		my $src = $self->dest_to_source;
		my $fullname = $self->cwd."/".$src;
		my $file = File::Spec->canonpath($fullname);
		if (!$known->{$file}) {
			OpenBSD::PackingElement::Manpage->add($plist, $src);
			$known->{$file} = 1;
		}
	}
}

package CheckProblemsScanner;
our @ISA = (qw(OpenBSD::PlistScanner));
use OpenBSD::PackageInfo;

sub add_more_man($self, $plist)
{
	my $knownman = {};
	$plist->known_page($knownman);
	$plist->add_extra_manpage($knownman, $plist);
}

sub register_plist($self, $plist)
{
	my $pkgname = $plist->pkgname;

	# don't register twice, which happens for ports tree scans
	return if $self->{got}{$pkgname};

	$self->{got}{$pkgname} = 1;

	$self->{db}{$pkgname} = {
		pkgname => $pkgname,
		missing_deps => {},
		dirs => {}, 
		need_dirs => {}, 
		deps => {},
		problems => {}
	};


	if ($self->{do_conflicts}) {
		$self->{conflicts}{$pkgname} = 
		    OpenBSD::PkgCfl->make_conflict_list($plist);
	}
	if ($self->{do_manpages}) {
		$self->add_more_man($plist);
	}
	$plist->register($self, $self->{db}{$pkgname}, $pkgname);
}

sub handle_options($self)
{
	$self->{signature_style} = 'unsigned';
	$self->SUPER::handle_options('CD',
	    "[-CDeSv] [-d plist_dir] [-o output] [-p ports_dir] [pkgname ...]");
}

sub new($class)
{
	my $o = $class->SUPER::new('pkg_check-problem');

	if ($o->ui->opt('D') && $o->ui->opt('C')) {
		$o->ui->usage("Won't compute anything");
	}

	$o->{do_dirs} = !$o->ui->opt('D');
	$o->{do_conflicts} = !$o->ui->opt('C');
	$o->{do_manpages} = $o->ui->opt('e');

	$o->{db} = {};
	$o->{mtree} = { 
	    '/usr/local/lib/X11' => 1,
	    '/usr/local/include/X11' => 1,
	    '/usr/local/lib/X11/app-defaults' => 1
	    };
	OpenBSD::Mtree::parse($o->{mtree}, '/', 
	    '/etc/mtree/4.4BSD.dist');
	OpenBSD::Mtree::parse($o->{mtree}, '/', 
	    '/etc/mtree/BSD.x11.dist');
	if ($o->{do_conflicts}) {
		$o->{filehash} = {};
		$o->{pkg_list} = {};
		$o->{conflicts} = {};
		$o->{all_deps} = {};
		$o->{seen} = {};
	}
	return $o;
}


# for common dirs
sub parent_has_dir($self, $db, $t, $dir)
{
	for my $dep (keys %{$t->{deps}}) {
		if (!defined $db->{$dep}) {
		    if (!defined $self->{missing_deps}{$dep}) {
			    $self->ui->errsay("#1 : #2 not found", $t->{pkgname},
			    	$dep);
			    $self->{missing_deps}{$dep} = 1;
		    }
		    next;
		}
		if ($db->{$dep}->{dirs}->{$dir} || 
		    $self->parent_has_dir($db, $db->{$dep}, $dir)) {
			$t->{dirs}{$dir} = 1;
			return 1;
		}
	}
	return 0;
}

sub parent_has_problem($db, $t, $dir)
{
	for my $dep (keys %{$t->{deps}}) {
		next if !defined $db->{$dep};
		if ($db->{$dep}->{problems}->{$dir}) {
			return 1;
		}
	}
	return 0;
}

sub build_common_dirs($self)
{
	my $db = $self->{db};
	my $mtree = $self->{mtree};
	my @l = keys %$db;

	$self->progress->next;
	$self->progress->for_list("Checking common dirs", \@l,
	    sub {
	    	my $pkgname = shift;
		my $t = $db->{$pkgname};
		for my $dir (keys(%{$t->{need_dirs}})) {
			return if $t->{dirs}{$dir};
			return if $mtree->{$dir};
			return if $self->parent_has_dir($db, $t, $dir);
			$t->{problems}{$dir} = 1;
		}
	    });
}

sub show_common_dirs($self)
{
	my $db = $self->{db};

	for my $pkgname (sort {$self->fullname($a) cmp $self->fullname($b)}
	    keys %$db) {
		my @l=();
		my $t = $db->{$pkgname};
		for my $dir (keys %{$t->{problems}}) {
			next if parent_has_problem($db, $t, $dir);
			push(@l, $dir);
		}
		if (@l != 0) {
			$self->say("#1: #2", $self->fullname($pkgname), 
			    join(', ', sort @l));
		}
	}
}

# for conflicts
my $cache3 = {};
my $cache4 = {}; 

sub direct_conflict($conflicts, $pkg, $pkg2)
{
	return $cache3->{$pkg}{$pkg2} //= $conflicts->{$pkg}->conflicts_with($pkg2);
}

sub has_a_conflict($conflicts, $deps, $pkg, $pkg2)
{
	return $cache4->{$pkg}{$pkg2} //= find_a_conflict($conflicts, $deps, $pkg, $pkg2);
}

sub find_a_conflict($conflicts, $deps, $pkg, $pkg2)
{
	return 0 if $pkg eq $pkg2;
	
	if (defined $conflicts->{$pkg} && 
	    direct_conflict($conflicts, $pkg, $pkg2)) {
		return 1;
	}
	if (defined $deps->{$pkg}) {
		for my $dep (@{$deps->{$pkg}}) {
		    if (has_a_conflict($conflicts, $deps, $dep, $pkg2)) {
			    return 1;
		    }
		}
	}
	if (defined $deps->{$pkg2}) {
		for my $dep (@{$deps->{$pkg2}}) {
			if (has_a_conflict($conflicts, $deps, $pkg, $dep)) {
				return 1;
			}
		}
	}
	return 0;
}

sub compute_true_conflicts($self, $l)
{
	my $conflicts = $self->{conflicts};
	my $deps = $self->{all_deps};
	# create a list of unconflicting packages.
	my $l2 = [];
	for my $pkg (@$l) {
		my $keepit = 0;
		for my $pkg2 (@$l) {
			next if $pkg eq $pkg2;
			if (!(has_a_conflict($conflicts, $deps, $pkg, $pkg2) ||
			    has_a_conflict($conflicts, $deps, $pkg2, $pkg))) {
				$keepit = 1;
				last;
			}
		}
		if ($keepit) {
		    push(@$l2, $pkg);
		}
	}
	return $l2;
}

sub compute_conflicts($self)
{
	$self->progress->set_header("Compute file problems");
	my $c = {};
	my $c2 = {};
	my $r = {};
	my $cache = {};

	my $h = $self->{filehash};
	my $total = scalar(keys %$h);
	my $i =0;
	while (my ($key, $l) = each %$h) {
		$self->progress->show(++$i, $total);
		if (!defined $c->{$l}) {
			my %s = map {($_, 1)} @$l;
			$c->{$l} = [sort keys %s];
			$c2->{$l} = join(',', @{$c->{$l}});
		}
		my $hv = $c2->{$l};
		$l = $c->{$l};
		next if @$l == 1;
		$cache->{$hv} //= $self->compute_true_conflicts($l);
		my $result = $cache->{$hv};
		if (@$result != 0) {
			my $newkey = join(',', 
			    sort map { $self->fullname($_) } @$result);
			if (@$result == 1) {
				$newkey .= "-> was ".join(',', @$l);
			}
			push(@{$r->{$newkey}}, $key);
		}
	}
	$self->progress->next;
	return $r;
}

sub show_conflicts($self, $result)
{
	for my $cfl (sort keys %$result) {
		$self->say("#1", $cfl);
		for my $f (sort @{$result->{$cfl}}) {
			$self->say("\t#1", $f);
		}
	}
}

sub check_license($self, $pkg, $k)
{
	my @todo = ($pkg);
	my $done = {};

	while (@todo > 0) {
		my $dep = shift @todo;
		next if $done->{$dep};
		$done->{$dep} = 1;
		if (defined $self->{all_deps}{$dep}) {
			push(@todo, @{$self->{all_deps}{$dep}});
		}
		if (defined $self->{$k}{$dep}) {
			return $dep if $self->{$k}{$dep} == 0;
		} else {
			return $dep;
		}

	}
	return undef;
}

sub check_licenses($self)
{
	my $r = {};

	$self->progress->set_header("Compute licenses issues");
	for my $k (qw(ftp_okay)) {
		while (my ($pkg, $v) = each %{$self->{$k}}) {
			next if $v == 0;
			next if !$self->{current}{$pkg};
			my $d = $self->check_license($pkg, $k);
			if (defined $d) {
				$r->{$k}{$pkg} = $d;
			}
		}
	}
	$self->progress->next;
	return $r;
}

sub show_licenses_issues($self, $result)
{
	for my $k (qw(ftp_okay)) {
		for my $pkg (sort keys %{$result->{$k}}) {
			$self->say("#1 is marked as #2 but depends on #3",
			    $pkg, $k, $result->{$k}{$pkg});
		}
	}
}

sub display_results($self)
{
	if ($self->{do_dirs}) {
		$self->build_common_dirs;
		$self->say("Common dirs:");
		$self->show_common_dirs;
	}
	if ($self->{do_conflicts}) {
		my $result = $self->compute_conflicts;
		$self->say("Conflicts:");
		$self->show_conflicts($result);
		my $r2 = $self->check_licenses;
		$self->say("Licenses problems:");
		$self->show_licenses_issues($r2);
	}
}


package main;

my $o = CheckProblemsScanner->new;
$o->run;