openbsd-ports/infrastructure/install/make-plist

#! /usr/bin/perl
# $OpenBSD: make-plist,v 1.102 2008/10/26 16:02:06 espie Exp $
# Copyright (c) 2004-2008 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.

# TODO
# - multi-package with conflicts don't work.
# (need to multi annotate files)
# - multi-packages with inter-dependencies incorrectly strip dirs
# (need to strip dirs in a smarter way ???)
# - sample dir/ gets added at the wrong location.

use strict;
use warnings;

use lib $ENV{PORTSDIR}."/infrastructure";
use OpenBSD::PackingList;
use OpenBSD::PackingElement;
use OpenBSD::PackageLocator;
use OpenBSD::PackageInfo;
use OpenBSD::Mtree;
use OpenBSD::Subst;
use File::Spec;
use File::Find;
use File::Compare;
use File::Basename;
use File::Temp;

package OpenBSD::ReverseSubst;
our @ISA = (qw(OpenBSD::Subst));

sub new
{
	bless {h => {}, r => [], l => {}}, shift;
}

sub hash
{
	my $self = shift;
	return $self->{h};
}

sub value
{
	my ($self, $k) = @_;
	return $self->{h}->{$k};
}	

sub add
{
	my ($self, $k, $v) = @_;
	if ($k =~ m/^LIB(.*)_VERSION$/) {
		$self->{l}->{$1} = $v;
	} else {
		push(@{$self->{r}}, $k) if $v ne '';
	}
	$k =~ s/^\^//;
	$self->{h}->{$k} = $v;
}

sub reverse
{
	my ($self, $_) = @_;
	for my $k (@{$self->{r}}) {
		if ($k =~ m/^\^(.*)$/) {
			$k = $1;
			my $v = $self->{h}->{$k};
			s/^\Q$v\E/\$\{\Q$k\E\}/g;
		} else {
			my $v = $self->{h}->{$k};
			s/\Q$v\E/\$\{\Q$k\E\}/g;
		}
	}
	return $_;
}

sub reverse_with_lib
{
	my ($self, $_) = @_;
	if (m/^(.*?)lib([^\/]+)\.so\.(\d+\.\d+)$/) {
		my ($path, $name, $version) = ($1, $2, $3);
		if (!defined $self->{l}->{$name}) {
			print STDERR "WARNING: unregistered shared lib: $name "
			. "(version: $version)\n";
		    $self->{l}->{$name} = $version;
		} elsif ($self->{l}->{$name} ne $version) {
			print STDERR "WARNING: version mismatch for lib: $name "
			. "($version vs. $self->{l}->{$name})\n";
		}
		return $self->reverse("${path}lib$name.so.")."\${LIB${name}_VERSION}";
	} else {
		return $self->reverse($_);
	}
}

package main;

# Plists use variable substitution, we have to be able to do it
# both ways to recognize existing entries.

my $base;
our $subst = new OpenBSD::ReverseSubst;
my $destdir = $ENV{'DESTDIR'};
my %known_libs;

die "No $destdir" unless -d $destdir;


my %prefix;
my %plistname;
my %mtree;
my @subs;
my $baseprefix=$ENV{PREFIX};
my $shared_only;
my $make = $ENV{MAKE};
my $portsdir = $ENV{PORTSDIR};


my $cached_tree = {};
sub build_mtree
{
	my ($sub, $deps) = @_;
	my $mtree = {};
	# add directories from dependencies
	my $stripped = {};
	for my $pkgpath (split /\s+/, $deps) {
		next if defined $stripped->{$pkgpath};
		$stripped->{$pkgpath} = 1;
		if (!defined $cached_tree->{$pkgpath}) {
			$cached_tree->{$pkgpath} = {};
			open my $fh, "cd $portsdir && env -i SUBDIR=$pkgpath ECHO_MSG=: $make print-plist |" or die "blech\n";
			augment_mtree($cached_tree->{$pkgpath}, $fh);
			close($fh);
		}
		print STDERR "Subpackage $sub: Stripping dirs from $pkgpath\n";
		for my $e (keys %{$cached_tree->{$pkgpath}}) {
			$mtree->{$e} = 1;
		}
	}
	return $mtree;
}

sub parse_arg
{
	my $_ = shift;
	if (m/^DEPPATHS(-.*?)\=/) {
		$mtree{$1} = build_mtree($1, $');
		return;
	} 
	if (m/\=/) {
		$subst->parse_option($_);
	}
	if (m/^\^PREFIX(\-.*?)\=(.*)\/?$/) {
		$prefix{$1} = $2;
	} elsif (m/^PLIST(\-.*?)\=/) {
		$plistname{$1} = $';
	}
}

sub parse_env
{
}

sub parse_args
{
	for my $i (@ARGV) {
		parse_arg($i);
	}
	my $multi = $ENV{'MULTI_PACKAGES'};
	# Normalize
	$multi =~ s/^\s+//;
	$multi =~ s/\s+$//;
	@subs = split /\s+/, $multi;
	for my $sub (@subs) {
		if (!defined $prefix{$sub} || !defined $plistname{$sub} ||
		    !defined $mtree{$sub}) {
		    	die "Incomplete information for $sub";
		}
	}
	if (defined $ENV{'SHARED_ONLY'}) {
		if ($ENV{'SHARED_ONLY'} =~ m/^Yes$/i) {
			$shared_only = 1;
		}
	}
}

sub deduce_name
{
	my ($o, $frag, $not) = @_;

	my $noto = $o;
	my $nofrag = "no-$frag";

	$o =~ s/PFRAG\./PFRAG.$frag-/ or
	    $o =~ s/PLIST/PFRAG.$frag/;

	$noto =~ s/PFRAG\./PFRAG.no-$frag-/ or
	    $noto =~ s/PLIST/PFRAG.no-$frag/;
	if ($not) {
		return $noto;
    	} else {
		return $o;
	}
}


sub possible_subpackages
{
	my $filename= shift;

	my $l = [];
	for my $sub (@subs) {
		if ($filename =~ m/^\Q$prefix{$sub}\E\//) {
			push @$l, $sub;
		}
	}
	return $l;
}

# Fragments are new PackingElement unique to make-plist and pkg_create, 
# to handle %%thingy%%.
# (and so, make-plist will use a special PLIST reader)


# Method summary:
# add_to_mtree: new directory in dependent package
# register: known items and known comments
# copy_extra: stuff that can't be easily deduced but should be copied
# tag_along: set of items that associate themselves to this item
#   (e.g., @exec, @unexec, @sample...)
# clone_tags: copy tagged stuff over.
# deduce_fragment: find fragment file name from %%stuff%%

# note $plist->{nonempty}: set as soon as a plist holds anything
# but a cvstag.

package OpenBSD::PackingElement;
sub add_to_mtree
{
}

sub register
{
	my ($self, $plist) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
}

sub copy_extra
{
}

sub tag_along
{
	my ($self, $n) = @_;

	$self->{tags} = [] unless defined $self->{tags};
	push(@{$self->{tags}}, $n);
}

sub deduce_fragment
{
}

sub clone_tags
{
	my ($self, $plist) = @_;

	if (defined $self->{tags}) {
		for my $t (@{$self->{tags}}) {
			my $n = $t->clone();
			if ($n->isa("OpenBSD::PackingElement::Sample") || 
			    $n->isa("OpenBSD::PackingElement::SampleDir")) {
				main::handle_modes($plist, $n, $t);
			}
			$n->add_object($plist);
			$plist->{nonempty} = 1;
			if ($n->isa("OpenBSD::PackingElement::Fragment") && 
			    $n->{name} eq "SHARED") {
				$plist->{hasshared} = 1;
			}
		}
	}
}

package OpenBSD::PackingElement::EndFake;
sub register
{
	my ($self, $plist) = @_;
	$plist->{state}->{end_faked} = 1;
	$plist->{has_endfake} = 1;
}

package OpenBSD::PackingElement::Fragment;
our @ISA=qw(OpenBSD::PackingElement);
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	if (defined $plist->{state}->{lastobject}) {
	    $plist->{state}->{lastobject}->tag_along($self);
    	} else {
	    $plist->{tag_marker}->tag_along($self);
	}
	$self->{end_faked} = $plist->{state}->{end_faked};
}

sub deduce_fragment
{
	my ($self, $o) = @_;

	my $frag = $self->{name};
	return if $frag eq "SHARED";

	$o =~ s/PFRAG\./PFRAG.$frag-/ or
	    $o =~ s/PLIST/PFRAG.$frag/;

	return $o if -e $o;
}

sub needs_keyword() { 0 }

sub stringize
{
	return '%%'.shift->{name}.'%%';
}

package OpenBSD::PackingElement::NoFragment;
our @ISA=qw(OpenBSD::PackingElement::Fragment);

sub deduce_fragment
{
	my ($self, $noto) = @_;
	my $frag = $self->{name};
	return if $frag eq "SHARED";

	$noto =~ s/PFRAG\./PFRAG.no-$frag-/ or
	    $noto =~ s/PLIST/PFRAG.no-$frag/;
	return $noto if -e $noto;
}

sub stringize
{
	return '!%%'.shift->{name}.'%%';
}

package OpenBSD::PackingElement::FileObject;
sub register
{
	my ($self, $plist, $files, $comments) = @_;

	$self->{plist} = $plist;
	$self->{end_faked} = $plist->{state}->{end_faked};
	my $fullname = $self->fullname;
	my $n = $main::subst->reverse($fullname);
	$files->{$n} = $self;
}

package OpenBSD::PackingElement::FileBase;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$plist->{state}->{lastobject} = $self;
	$self->SUPER::register($plist, $files, $comments);
}

package OpenBSD::PackingElement::Lib;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$plist->{state}->{lastobject} = $self;
	$self->{plist} = $plist;
	$self->{end_faked} = $plist->{state}->{end_faked};
	my $fullname = $self->fullname;
	my $n = $main::subst->reverse_with_lib($fullname);
	$files->{$n} = $self;
}

package OpenBSD::PackingElement::Dir;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$plist->{state}->{lastobject} = $self;
	$self->SUPER::register($plist, $files, $comments);
}

package OpenBSD::PackingElement::Sample;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
	if (defined $self->{copyfrom}) {
		$self->{copyfrom}->tag_along($self);
	} else {
		print "Bogus sample (unattached) detected\n";
	}
}

package OpenBSD::PackingElement::Sysctl;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
	if (defined $plist->{state}->{lastobject}) {
		$plist->{state}->{lastobject}->tag_along($self);
	} else {
		$plist->{tag_marker}->tag_along($self);
	}
}

package OpenBSD::PackingElement::ExeclikeAction;
sub register
{
	my ($self, $plist, $files, $comments, $existing) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
	if ($self->{expanded} =~ m/^install\-info\s+(?:\-\-delete\s+)?\-\-info\-dir=.*?\/info\s+(.*)$/) {
		my $iname = $1;
		if (defined $existing->{$iname} and $existing->{$iname} eq 'info') {
			return;
	    	}
	}
	if ($self->{expanded} =~ m/^mkdir\s+\-p\s+(.*)$/) {
		my $iname = $1;
		if (defined $existing->{$iname} and $existing->{$iname} eq 'directory') {
			return;
		}
	}
	if (defined $plist->{state}->{lastobject}) {
	    $plist->{state}->{lastobject}->tag_along($self);
    	} else {
	    $plist->{tag_marker}->tag_along($self);
	}
}

package OpenBSD::PackingElement::Sampledir;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
	if (defined $plist->{state}->{lastobject}) {
	    $plist->{state}->{lastobject}->tag_along($self);
    	} else {
	    $plist->{tag_marker}->tag_along($self);
	}
}

package OpenBSD::PackingElement::DirlikeObject;
sub add_to_mtree
{
	my ($self, $mtree) = @_;

	$mtree->{$self->fullname()} = 1;
}

package OpenBSD::PackingElement::Comment;
sub register
{
	my ($self, $plist, $files, $comments) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
	$self->{plist} = $plist;
	my $name = $self->{name};
	$comments->{$name} = $self;
	if ($name =~ m/^\@dir(?:rm)?\s+/) {
		$name = $'.'/';
		my $o = OpenBSD::PackingElement::Comment->new($name);
		# register @dirrm dir comment as dir/
		$comments->{$o->{name}} = $self;
	}
}

package OpenBSD::PackingElement::Extra;
sub copy_extra
{
	my ($self, $plist) = @_;

	if ($self->cwd() ne $plist->{state}->cwd()) {
	    OpenBSD::PackingElement::Cwd->add($plist, $self->cwd());
	}
	$self->clone()->add_object($plist);
	$plist->{nonempty} = 1;
}

sub register
{
	my ($self, $plist) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
}

package OpenBSD::PackingElement::ExtraUnexec;
sub copy_extra
{
	my ($self, $plist) = @_;

	# don't try to deal with cwd issues
	$self->clone()->add_object($plist);
	$plist->{nonempty} = 1;
}

sub register
{
	my ($self, $plist) = @_;
	$self->{end_faked} = $plist->{state}->{end_faked};
}

package main;

# existing files are classified according to the following routine

sub get_type
{
	my $filename = shift;
	if (-d $filename && !-l $filename) {
		return "directory";
	} elsif (is_subinfo($filename)) {
		return "subinfo";
	} elsif (is_info($filename)) {
		return "info";
	} elsif (is_dir($filename)) {
		return "dir";
	} elsif (is_manpage($filename)) {
		return "manpage";
	} elsif (is_library($filename)) {
		return "library";
	} elsif (is_plugin($filename)) {
		return "plugin";
	} elsif (is_binary($filename)) {
		return "binary";
	} else {
		return "file";
	}
}

# symlinks are usually given in a DESTDIR setting, any operation
# beyond filename checking gets through resolve_link

sub resolve_link
{
	my $filename = shift;
	my $level = shift || 0;
	if (-l $filename) {
		my $l = readlink($filename); 
		if ($level++ > 14) {
			print STDERR "Symlink too deep: $filename\n";
			return $filename;
		}
		if ($l =~ m|^/|) {
			return $destdir.resolve_link($l, $level);
		} else {
			return resolve_link(File::Spec->catfile(dirname($filename),$l), $level);
		}
	} else {
		return $filename;
	}
}

sub is_shared_object
{
	my $filename = shift;
	$filename = resolve_link($filename);
	my $check=`/usr/bin/file $filename`;
	chomp $check;
	if ($check =~m/\: ELF (32|64)-bit (MSB|LSB) shared object\,/ ||
	    $check =~m/OpenBSD\/.* demand paged shared library/) {
	    	return 1;
	} else {
		return 0;
	}
}

sub is_library
{
	my $filename = shift;

	return 0 unless $filename =~ m/\/lib[^\/]*\.so\.\d+\.\d+$/;
	return is_shared_object($filename);
}

sub is_binary
{
	my $filename = shift;
	return 0 if -l $filename or ! -x $filename;
	my $check=`/usr/bin/file $filename`;
	chomp $check;
	if ($check =~m/\: ELF (32|64)-bit (MSB|LSB) executable\,.+ for OpenBSD\,/) {
	    	return 1;
	} else {
		return 0;
	}
}

sub is_plugin
{
	my $filename = shift;

	return 0 unless $filename =~ m/\.so$/;
	return is_shared_object($filename);
}

sub is_info
{
	my $filename = shift;
	return 0 unless $filename =~ m/\.info$/ or $filename =~ m/info\/[^\/]+$/;
	$filename = resolve_link($filename);
	open my $fh, '<', $filename or return 0;
	my $tag = <$fh>;
	return 0 unless defined $tag;
	chomp $tag;
	$tag.=<$fh>;
	close $fh;
	if ($tag =~ /^This is .*, produced by [Mm]akeinfo(?: version |-)?.*[\d\s]from/) {
		return 1;
	} else {
		return 0;
	}
}

sub is_manpage
{
	my $_ = shift;
	if (m,/man/(?:[^/]*?/)?man(.*?)/[^/]+\.\1[[:alpha:]]?(?:\.gz|\.Z)?$,) {
		return 1;
	}
	if (m,/man/(?:[^/]*?/)?man3p/[^/]+\.3(?:\.gz|\.Z)?$,) {
		return 1;
	}
	if (m,/man/(?:[^/]*/)?cat.*?/[^/]+\.0(?:\.gz|\.Z)?$,) {
		return 1;
	}
	if (m,/man/(?:[^/]*/)?(?:man|cat).*?/[^/]+\.tbl(?:\.gz|\.Z)?$,) {
		return 1;
	}
	return 0;
}

sub is_dir
{
	my $filename = shift;
	return 0 unless $filename =~ m/\/dir$/;
	$filename = resolve_link($filename);
	open my $fh, '<', $filename or return 0;
	my $tag = <$fh>;
	chomp $tag;
	$tag.=" ".<$fh>;
	chomp $tag;
	$tag.=" ".<$fh>;
	close $fh;
	if ($tag =~ /^(?:\-\*\- Text \-\*\-\s+)?This is the file .*, which contains the topmost node of the Info hierarchy/) {
		return 1;
	} else {
		return 0;
	}
}

sub is_subinfo
{
	my $filename = shift;
	if ($filename =~ m/^(.*\.info)\-\d+$/ or
	    $filename =~ m/^(.*info\/[^\/]+)\-\d+$/) {
		return is_info($1);
	}
	if ($filename =~ m/^(.*)\.\d+in$/) {
		return is_info("$1.info");
	}
	return 0;
}


# add dependent package directories to the set of directories that don't
# need registration.

sub augment_mtree
{
	my ($mtree, $fh) = @_;
	my $plist = OpenBSD::PackingList->read($fh, \&OpenBSD::PackingList::DirrmOnly) or die "couldn't read packing-list\n";
	for my $item (@{$plist->{items}}) {
		$item->add_to_mtree($mtree);
	}
}

sub undest
{
	my $filename=shift;
	if ($filename =~ m/^\Q$destdir\E/) {
		$filename = $';
	}
	$filename='/' if $filename eq '';
	return $filename;
}

# check that $fullname is not the only entry in its directory
sub has_other_entry
{
	my $fullname = shift;
	use Symbol;

	my $dir = gensym;
	opendir($dir, dirname($fullname)) or return 0;
	while (my $e = readdir($dir)) {
		next if $e eq '.' or $e eq '..';
	    	next if $e eq basename($fullname);
		return 1;
	}
	return 0;
}

# zap directories going up if there is nothing but that filename.
# used to zap .perllocal, dir, and other stuff.
sub zap_dirs
{
	my ($dirs, $fullname) = @_;
	return if has_other_entry($fullname);
	my $d = dirname($fullname);
	return if $d eq $destdir;
	delete $dirs->{undest($d)};
	zap_dirs($dirs, $d);
}

# find all objects that need registration, mark them according to type.
sub scan_destdir
{
	my %files;
	my %okay_files=map { $_=>1 } split(/\s+/, $ENV{'OKAY_FILES'});
	use Config;

	my $installsitearch = $Config{'installsitearch'};
	my $archname = $Config{'archname'};
	my $installprivlib = $Config{'installprivlib'};
	my $installarchlib = $Config{'installarchlib'};

	find(
		sub {
			return if defined $okay_files{$File::Find::name};
			my $type = get_type($File::Find::name);
			if ($type eq "dir" or
			    $type eq 'subinfo' or
			    $File::Find::name =~ m,\Q$installsitearch\E/auto/.*/\.packlist$, or
			    $File::Find::name =~ m,\Q$installarchlib/perllocal.pod\E$, or
			    $File::Find::name =~ m,\Q$installsitearch/perllocal.pod\E$, or
			    $File::Find::name =~ m,\Q$installprivlib/$archname/perllocal.pod\E$,) {
			    	zap_dirs(\%files, $File::Find::name);
				return;
			}
			return if $File::Find::name =~ m/pear\/lib\/\.(?:filemap|lock)$/;
			my $path = undest($File::Find::name);
			$path =~ s,^/etc/X11/app-defaults\b,/usr/local/lib/X11/app-defaults,;
			$files{$path} = get_type($File::Find::name);
		}, $destdir);
	zap_dirs(\%files, $destdir.'/etc/X11/app-defaults');
	return \%files;
}

# build a hash of files needing registration
sub get_files
{
	my $files = scan_destdir();
	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, '/usr/X11R6', '/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;

	# make sure main mtree is removed 
	for my $d (keys %$mtree) {
		delete $files->{$d}
	}
	return $files;
}

# full file name to file name in plist context
sub strip_base
{
	my $_ = shift;
	my $base = shift->{stripprefix};
	if (m/^\Q$base\E/) {
		$_ = $';
	}
	$_='/' if $_ eq '';
	return $_;
}

my ($foundfiles, $foundcomments) = ({}, {});

# Basic packing-list with a known prefix
sub create_packinglist
{
	my ($filename, $sub) = @_;

	my $prefix = $prefix{$sub};
	my $plist = new OpenBSD::PackingList;
	$plist->{filename} = $filename;
	$plist->{mtree} = $mtree{$sub};
	$plist->{state}->set_cwd($prefix);
	$prefix.='/' unless $prefix =~ m|/$|;
	$plist->{stripprefix} = $prefix;
	return $plist;
}

# grab original packing list, killing some stuff that is no longer needed.
sub parse_original_plist
{
    my ($name, $sub, $files, $all_plists, $parent) = @_;
    my $plist = create_packinglist($name, $sub);
    # place holder for extra stuff that comes before any file
    $plist->{tag_marker} = new OpenBSD::PackingElement('');
    # special reader for fragments
    $plist->fromfile($name, 
	sub {
	    my ($fh, $cont) = @_;
	    my $_;
	    while (<$fh>) {
		    if (m/^\%\%(.*)\%\%$/) {
		    	OpenBSD::PackingElement::Fragment->add($plist, $1);
		    } elsif (m/^\!\%\%(.*)\%\%$/) {
		    	OpenBSD::PackingElement::NoFragment->add($plist, $1);
		    } elsif (m/^(?:NEW)?DYNLIBDIR\(.*\)$/) {
		    	next;
		    } else {
			    &$cont($_);
		    }
	    }
	}
    ) or return;

    delete $plist->{state}->{lastobject};
    if (!defined $parent) {
    	$parent = 0;
    }
    $plist->{state}->{end_faked} = $parent;
    for my $item (@{$plist->{items}}) {
    	$item->register($plist, $foundfiles, $foundcomments, $files);
    }
    # Try to handle fragments
    for my $item (@{$plist->{items}}) {
	    my $fragname = $item->deduce_fragment($name);
	    next unless defined $fragname;
	    my $pfrag = create_packinglist($fragname, $sub);
	    $pfrag->{isfrag} = 1;
	    push(@$all_plists, $pfrag);
	    my $origpfrag = parse_original_plist($fragname, $sub, $files, $all_plists, $item->{end_faked});
	    replaces($origpfrag, $pfrag);
    }
    return $plist;
}
	
# link original and new plist
sub replaces
{
	my ($orig, $n) = @_;
	if (defined $orig) {
		$n->{original} = $orig;
		$orig->{replacement} = $n;
		$n->{filename} = $orig->{filename};
		$orig->{tag_marker}->clone_tags($n);
		if (defined $orig->{has_endfake}) {
			$n->{has_endfake} = 1;
		}
	}
}

sub grab_all_lists
{
	my ($files) = @_;

	my $l = [];
	for my $sub (@subs) {
		my $o;
		my $n = create_packinglist($plistname{$sub}, $sub);
		push(@$l, $n);
		$o = parse_original_plist($plistname{$sub}, $sub, $files, $l);
		replaces($o, $n);
		my $frag = deduce_name($plistname{$sub}, "shared", 0);
		my $ns = create_packinglist($frag, $sub);
		$n->{shared} = $ns;
		$o = parse_original_plist($frag, $sub, $files, $l);
		replaces($o, $ns);
		push(@$l, $ns);
	}
	return @$l;
}

# new object according to type, just copy over some stuff for now
sub create_object
{
	my ($type, $short, $item) = @_;

	if ($type eq "directory") {
		if (defined $item) {
			if ($item->isa("OpenBSD::PackingElement::Mandir")) {
			    return OpenBSD::PackingElement::Mandir->new($short);
			} elsif ($item->isa("OpenBSD::PackingElement::Fontdir")) {
			    return OpenBSD::PackingElement::Fontdir->new($short);
			}
		}
		return OpenBSD::PackingElement::Dir->new($short);
	} elsif ($type eq "manpage") {
		return OpenBSD::PackingElement::Manpage->new($short);
	} elsif ($type eq "dir" || $type eq "subinfo") {
		return undef;
	} elsif ($type eq "info") {
		return OpenBSD::PackingElement::InfoFile->new($short);
	} elsif ($type eq "library") {
		return OpenBSD::PackingElement::Lib->new($short);
	} elsif ($type eq "binary") {
		return OpenBSD::PackingElement::Binary->new($short);
	} else {
		if (defined $item) {
			if ($item->isa("OpenBSD::PackingElement::Shell")) {
				return OpenBSD::PackingElement::Shell->new($short);
		    	}
		}
		return OpenBSD::PackingElement::File->new($short);
	}
}

# `restate' packing-list according to current mode settings.
# for now, we copy over stuff from old items.
sub handle_modes
{
	my ($plist, $item, $o) = @_;
	my ($mode, $owner, $group) = ('', '', '');
	my ($oldmode, $oldowner, $oldgroup) = ($plist->{state}->{mode}, $plist->{state}->{owner}, $plist->{state}->{group});
	$oldmode = '' unless defined $oldmode;
	$oldowner = '' unless defined $oldowner;
	$oldgroup = '' unless defined $oldgroup;

	if (defined $item) {
		if (defined $item->{nochecksum}) {
			$o->{nochecksum} = 1;
		}
		if (defined $item->{ignore}) {
			$o->{ignore} = 1;
		}
		if (defined $item->{mode}) {
			$mode = $item->{mode};
		}
		if (defined $item->{owner}) {
			$owner = $item->{owner};
		}
		if (defined $item->{group}) {
			$group = $item->{group};
		}
	}
	if ($mode ne $oldmode) {
		OpenBSD::PackingElement::Mode->add($plist, $mode);
	}
	if ($owner ne $oldowner) {
		OpenBSD::PackingElement::Owner->add($plist, $owner);
	}
	if ($group ne $oldgroup) {
		OpenBSD::PackingElement::Group->add($plist, $group);
	}
}

# find out where a file belongs, and insert all corresponding things
# into the right packing-list.
sub handle_file
{
	my ($i, $type, $foundfiles, $foundcomments, $allplists, $shared_only, $pass) = @_;

	my $default = $allplists->[0];
	my $k;
	
	if ($type eq 'library') {
		$k = $subst->reverse_with_lib($i);
	} else {
		$k = $subst->reverse($i);
	}
	my $short;
	my $p;
	my $item;

	my $possible = possible_subpackages($i);
	if (@$possible == 0) {
		print "Bogus element outside of every prefix: $i\n";
		return;
	}
	# find out accurate prefix: if file is part of an existing plist,
	# don't look further
	if (defined $foundfiles->{$k}) {
		$item = $foundfiles->{$k};
		$p = $item->{plist}->{replacement};
		if ($type eq 'directory' && $p->{mtree}->{$i}) {
			undef $p;
		} else {
			$short = strip_base($i, $p);
			if ($pass == 0 and $item->{end_faked} == 1) {
				return;
			}
			if ($pass == 1 and $item->{end_faked} == 0) {
				return;
			}
		}
	}
	if (!defined $p) {
	# otherwise, look for the first matching prefix in plist to produce
	# an entry
		for my $try (@$allplists) {
			my $s2 = strip_base($i, $try);
			if ($type eq 'directory' and $try->{mtree}->{$i}) {
				next;
			}
			unless ($s2 =~ m|^/|) {
				$p = $try;
				$short = $s2;
				if ($p ne $default) {
					print "Element $i going to ", $p->{filename}, " based on prefix\n";
				}
				last;
			}
		}
	}
				
	if (!defined $p) {
		return;
	}
	if ($type eq 'library') {
		$short = $subst->reverse_with_lib($short);
	} else {
		$short = $subst->reverse($short);
	}
	# If the resulting name is arch-dependent, we warn.
	# We don't fix it automatically, as this may need special handling.
	if ($short =~ m/i386|m68k|sparc/) {
	    print STDERR "make-plist: generated plist contains arch-dependent\n"; 
	    print STDERR "\t$short\n";
	}

	my $o = create_object($type, $short, $item);
	return unless defined $o;
	my $s = $o->fullstring();
	# 
	if ($foundcomments->{$s}) {
		$foundcomments->{$s}->{accounted_for} = 1;
		$o = OpenBSD::PackingElement::Comment->new($s);
		$p = $foundcomments->{$s}->{plist}->{replacement};
		$o->add_object($p);
		$p->{nonempty} = 1;
	} else {
		if ($short =~ /\.orig$/) {
			print STDERR "make-plist: generated plist may contain patched file\n";
			print STDERR "\t$short\n";
		}
		if ($short =~ /\/\.[^\/]*\.swp$/) {
			print STDERR "make-plist: generated plist may contain vim swap file\n";
			print STDERR "\t$short\n";
		}
		if ($short =~ /\~$/) {
			print STDERR "make-plist: generated plist may contain emacs temp file\n";
			print STDERR "\t$short\n";
		}
		if (($type eq 'library' || $type eq 'plugin') && (!defined $item) && !$shared_only) {
			$p->{wantshared} = 1;
			$p = $p->{shared};
			if ($pass == 1) {
				return;
			}
		}
		handle_modes($p, $item, $o);
		$o->add_object($p);
		$p->{nonempty} = 1;

		# Copy properties from source item
		if (defined $item) {
			$item->clone_tags($p);
		}
	}
}

parse_args();

my $files = get_files();

my @l = grab_all_lists($files);

for my $plist (@l) {
	my $orig = $plist->{original};
	if (defined $orig and 
	    defined $orig->{cvstags}) {
		for my $tag (@{$orig->{cvstags}}) {
			$tag->clone()->add_object($plist);
		}
	} else {
	    OpenBSD::PackingElement::CVSTag->add($plist, '$OpenBSD'.'$');
	}
	# copy properties over
	if (defined $orig) {

		if (defined $orig->{'no-default-conflict'}) {
			OpenBSD::PackingElement::NoDefaultConflict->add($plist);
			$plist->{nonempty} = 1;
		}
		for my $listname (qw(pkgcfl conflict groups users 
		    pkgpath incompatibility updateset module)) {
			if (defined $orig->{$listname}) {
				for my $o (@{$orig->{$listname}}) {
					$o->clone()->add_object($plist);
					$plist->{nonempty} = 1;
				}
			}
		}
	}
}

for my $i (sort keys %$files) {
	handle_file($i, $files->{$i}, $foundfiles, $foundcomments, \@l, $shared_only, 0);
}

my $need_second_pass = 0;

for my $plist (@l) {
	if (defined $plist->{has_endfake}) {
		OpenBSD::PackingElement::EndFake->add($plist);
		$need_second_pass = 1;
	}
}

if ($need_second_pass) {
	for my $i (sort keys %$files) {
		handle_file($i, $files->{$i}, $foundfiles, $foundcomments, \@l, $shared_only, 1);
	}
}

# Copy extra stuff
for my $plist (@l) {
	my $orig = $plist->{original};
	next unless defined $orig;
	for my $i (@{$orig->{items}}) {
		$i->copy_extra($plist);
	}
}

my $default = $l[0];
if (($default->{wantshared} || (defined $default->{shared}) && $default->{shared}->{nonempty}) && !$default->{hasshared}) {
	unshift(@{$default->{items}}, OpenBSD::PackingElement::Fragment->new("SHARED"));
	$default->{nonempty} = 1;
}

for my $k (sort keys %$foundcomments) {
	next if defined $foundcomments->{$k}->{accounted_for};
	print "Not accounted for: \@comment $k\n";
}

# write new info over, as joe user.
# first we write out everything in /tmp
# then we signal if something changed
# if that's the case, we die if orig files exist, or we copy stuff over.

{
	local ($), $>);

	if (defined $ENV{'GROUP'}) {
		$) = $ENV{'GROUP'};
	}
	if (defined $ENV{'OWNER'}) {
		$> = $ENV{'OWNER'};
	}
	
	my $dir = File::Temp::tempdir ( CLEANUP => 1);
	$dir.='/';

	# write out everything
	for my $plist (@l) {
		if (!$plist->{nonempty}) {
			next;
		}
		$plist->tofile($dir.basename($plist->{filename}));
	}

	my $something_changed = 0;
	for my $plist (@l) {
		my $orig = $plist->{original};
		if ($plist->{nonempty}) {
			if (defined $orig) {
				if (compare($dir.basename($plist->{filename}), $orig->{filename}) != 0) {
					print $plist->{filename}, " changed\n";
					$something_changed = 1;
					$plist->{changed} = 1;
				}
			} else {
				print $plist->{filename}, " is new\n";
				$something_changed = 1;
				$plist->{changed} = 1;
			}
		} else {
			if (defined $orig) {
				if ($plist->{isfrag}) {
					print $plist->{filename}, " empty fragment: NOT writing it\n";
				} else {
					print $plist->{filename}, " empty\n";
					$something_changed = 1;
					$plist->{changed} = 1;
				}
			}
		}
	}

	my $letsdie = 0;
	if ($something_changed) {
		for my $plist (@l) {
			my $orig = $plist->{original};
			if (defined $orig) {
				if (-e $orig->{filename}.".orig") {
				    print $orig->{filename}.".orig present\n";
				    $letsdie = 1;
				}
			}
		}
	}
	if ($letsdie) {
		exit(1);
	}
	for my $plist (@l) {
		my $orig = $plist->{original};
		if ($plist->{changed}) {

			if (defined $orig) {
				rename($orig->{filename}, $orig->{filename}.".orig") or 
				    die "Can't rename file ", $orig->{filename}, "\n";
			}
			$plist->tofile($plist->{filename}) or 
			    die "Can't write plist: ", $plist->{filename}, "\n";
		}
	}
}