openbsd-ports/infrastructure/bin/check-common-dirs

#!/usr/bin/perl

# $OpenBSD: check-common-dirs,v 1.3 2011/01/17 20:08:08 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 strict;
use warnings;

use File::Spec;
use File::Path;
use File::Basename;
use OpenBSD::PackageInfo;
use OpenBSD::PackingList;
use OpenBSD::Mtree;
use OpenBSD::AddCreateDelete;

sub register_dir
{
	my ($d, $h) = @_;
	return if defined $h->{$d};
	$h->{$d} = 1;
	register_dir(dirname($d), $h);
}

package OpenBSD::PackingElement;
sub check_common_dirs
{
}

package OpenBSD::PackingElement::FileBase;
use File::Basename;
sub check_common_dirs
{
	my ($item, $t) = @_;
	my $d = File::Spec->canonpath($item->fullname);
	main::register_dir(dirname($d), $t->{need_dirs});
}

package OpenBSD::PackingElement::DirlikeObject;
sub check_common_dirs
{
	my ($item, $t) = @_;
	my $d = File::Spec->canonpath($item->fullname);
	$t->{dirs}->{$d} = 1;
}

package OpenBSD::PackingElement::Dependency;
sub check_common_dirs
{
	my ($item, $t) = @_;
	$t->{deps}->{$item->{def}} = 1;
}

package main;

sub analyze 
{
	my ($plist, $db) = @_;
	my $pkgname = $plist->pkgname;
	$db->{$pkgname} //= {
		pkgname => $pkgname,
		missing_deps => {},
		dirs => {}, 
		need_dirs => {}, 
		deps => {},
		problems => {}
	};
	my $t = $db->{$pkgname};

	$plist->check_common_dirs($t);
}

sub parent_has_dir
{
	my ($state, $db, $t, $dir) = @_;

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

sub parent_has_problem
{
	my ($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_results
{
	my ($state, $db, $mtree) = @_;

	for my $pkgname (keys %$db) {
		my $t = $db->{$pkgname};
		for my $dir (keys(%{$t->{need_dirs}})) {
			next if $t->{dirs}->{$dir};
			next if $mtree->{$dir};
			next if parent_has_dir($state, $db, $t, $dir);
			$t->{problems}->{$dir} = 1;
		}
	}
}

sub show_results
{
	my ($state, $db, $mtree) = @_;

	for my $pkgname (sort 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) {
			$state->say("#1: #2", $pkgname, join(', ', sort @l));
		}
	}
}

my $state = OpenBSD::AddCreateDelete::State->new('check-common-dirs');
$state->handle_options('', '[-mx]');
if (@ARGV==0) {
	@ARGV=(<*.tgz>);
}
my $db = {};
my $mtree = {};

OpenBSD::Mtree::parse($mtree, '/usr/local', '/etc/mtree/BSD.local.dist');
OpenBSD::Mtree::parse($mtree, '/', '/etc/mtree/4.4BSD.dist');
OpenBSD::Mtree::parse($mtree, '/', '/etc/mtree/BSD.x11.dist');
$mtree->{'/usr/local/lib/X11'} = 1;
$mtree->{'/usr/local/include/X11'} = 1;
$mtree->{'/usr/local/lib/X11/app-defaults'} = 1;

$state->progress->for_list("Scanning packages", \@ARGV,
    sub {
    	my $pkgname = shift;
	my $true_package = $state->repo->find($pkgname);
	return unless $true_package;
	my $dir = $true_package->info;
	$true_package->close;
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
	rmtree($dir);
	analyze($plist, $db);
    });

$state->progress->set_header("Scanning extra dependencies");
$state->progress->message("");
my $notfound = {};
my $todo;
do {
	$todo = {};
	for my $pkg (keys %$db) {
		for my $dep (keys %{$db->{$pkg}{deps}}) {
			if (!defined $db->{$dep} && 
			    !defined $notfound->{$dep}) {
				$todo->{$dep} = 1;
			}
		}
	}
	for my $pkgname (keys %$todo) {
		my $true_package = $state->repo->find($pkgname);
		if ($true_package) {
			my $dir = $true_package->info;
			$true_package->close;
			my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
			rmtree($dir);
			analyze($plist, $db);
		} else {
			$notfound->{$pkgname} = 1;
	    }
    	}
} while (keys %$todo > 0);
$state->progress->next;
$state->progress->set_header("Building results");
$state->progress->message("");
build_results($state, $db, $mtree);
$state->progress->next;
show_results($state, $db);