#! /usr/bin/perl
# $OpenBSD: make-plist,v 1.57 2004/08/11 09:40:17 espie Exp $
# Copyright (c) 2004 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.

use strict;
use warnings;
use OpenBSD::PackingList;
use OpenBSD::PackingElement;
use OpenBSD::PackageLocator;
use OpenBSD::PackageInfo;
use File::Spec;
use File::Find;
use File::Compare;
use File::Basename;
use File::Temp;


my $base;
my @backsubst;
my $destdir = $ENV{'DESTDIR'};

sub var_backsubst
{
	local $_ = shift;
	for my $l (@backsubst) {
		my $v = $l->[1];
		my $r = $l->[0];
		s/\Q$v\E/$r/g;
	}
	return $_;
}

sub var_subst
{
	local $_ = shift;
	for my $l (@backsubst) {
		my $v = $l->[0];
		my $r = $l->[1];
		s/\Q$v\E/$r/g;
	}
	return $_;
}

package OpenBSD::PackingElement;
sub add_to_mtree
{
}

sub register
{
	my ($self, $plist, $files, $comments) = @_;

	$self->{plist} = $plist;
	my $fullname = $self->fullname();
	if (defined $fullname) {
		my $n = main::var_backsubst($fullname);
		$files->{$n} = $self;
	}
}

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}}) {
			$t->clone()->add_object($plist);
			$plist->{nonempty} = 1;
		}
	}
}

package OpenBSD::PackingElement::Fragment;
our @ISA=qw(OpenBSD::PackingElement);
sub copy_extra
{
	my ($self, $plist) = @_;

	$self->clone()->add_object($plist);
	if ($self->{name} eq "SHARED") {
		$plist->{hasshared} = 1;
	}
	$plist->{nonempty} = 1;
}

sub deduce_fragment
{
	my ($self, $pfragbase) = @_;
	return if $self->{name} eq "SHARED";
	my $n = $pfragbase.".".$self->{name};
	if (-f $n) {
		return $n;
	}
	return;
}

sub needs_keyword() { 0 }

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

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

sub deduce_fragment
{
	my ($self, $pfragbase) = @_;
	my $n = $pfragbase.".no-".$self->{name};
	if (-f $n) {
		return $n;
	}
	return;
}

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

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

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

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

package OpenBSD::PackingElement::Unexec;
sub register
{
	&OpenBSD::PackingElement::Exec::register;
}

package OpenBSD::PackingElement::Sampledir;
sub register
{
	&OpenBSD::PackingElement::Exec::register;
}

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

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

package OpenBSD::PackingElement::DirRm;
sub add_to_mtree
{
	&OpenBSD::PackingElement::DirBase::add_to_mtree;
}

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

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;
}

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;
}

package main;
sub get_type
{
	my $filename = shift;
	if (is_info($filename)) {
		return "info";
	} elsif (is_subinfo($filename)) {
		return "subinfo";
	} elsif (is_dir($filename)) {
		return "dir";
	} elsif (is_manpage($filename)) {
		return "manpage";
	} elsif (is_library($filename)) {
		return "library";
	} elsif (is_plugin($filename)) {
		return "plugin";
	} else {
		return "file";
	}
}

sub resolve_link
{
	my $filename = shift;
	if (-l $filename) {
		my $l = readlink($filename); 
		if ($l =~ m|^/|) {
			return $destdir.$l;
		} else {
			return File::Spec->catfile(dirname($filename),$l);
		}
	} 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_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$/;
	$filename = resolve_link($filename);
	open my $fh, '<', $filename or return 0;
	my $tag = <$fh>;
	chomp $tag;
	close $fh;
	if ($tag =~ /^This is .*, produced by [Mm]akeinfo version .* from/) {
		return 1;
	} else {
		return 0;
	}
}

sub is_manpage
{
	local $_ = shift;
	if (m,/man/(?:[^/]*?/)?man(.*?)/[^/]+\.\1(?:\.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$/;
	return 1;
}

sub is_subinfo
{
	my $filename = shift;
	return 0 unless $filename =~ m/^(.*\.info)\-\d+$/;
	return is_info($1);
}


# read an mtree file, and produce the corresponding directory hierarchy
sub parse_mtree 
{
		# start under current DESTDIR, usually
	my $current = "/";
	my %mtree;
	open my $file, '<', shift;
	while(<$file>) {
		chomp;
		s/^\s*//;
		next if /^\#/ || /^\//;
		s/\s.*$//;
		next if /^$/;
		if ($_ eq '..') {
			$current =~ s|/[^/]*$||;
			next;
		} else {
			$current.="/$_";
		}
		$_ = $current;
		while (s|/\./|/|)	{}
		$mtree{File::Spec->canonpath($_)} = 1;
	}
	close $file;
	return \%mtree;
}

sub augment_mtree
{
	my ($mtree, $pkgname) = @_;
        my $true_package = OpenBSD::PackageLocator->find($pkgname);
        return unless $true_package;
        my $dir = $true_package->info();
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS, \&OpenBSD::PackingList::DirrmOnly);
	for my $item (@{$plist->{items}}) {
		$item->add_to_mtree($mtree);
	}
        $true_package->close();
}

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

sub scan_destdir
{
	# compare all files against those dates
	my @date = (stat $ENV{INSTALL_PRE_COOKIE})[9, 10];
	my (%files, %dirs);
	my %occupied;
	my %okay_files=map { $_=>1 } split(/\s+/, $ENV{'OKAY_FILES'});

	find(
		sub {
			return if defined $okay_files{$File::Find::name};
			my @cdate = (lstat $_)[9, 10];
			if ($cdate[0] >= $date[0] || $cdate[1] >= $date[1]) {
				if (-d _) {
					$dirs{undest($File::Find::name)} = 1;
				} else {
					$files{undest($File::Find::name)} = get_type($File::Find::name);
				}
			} else {
				$occupied{undest($File::Find::dir)} = 1;
			}
		}, $destdir);
# occupied marks a dir that was already there... 
# so all parents had to be around too
	for my $d (keys %occupied) {
		while ($d ne '') {
			delete $dirs{$d} if defined $dirs{$d};
			$d =~ s|/.*?/?$||;
		}
	}
	return (\%dirs, \%files);
}

sub get_files
{
	my ($dirs, $files) = scan_destdir();

	my $mtree = parse_mtree($ENV{'MTREE_FILE'});
	# and directories for dependencies as well
	for my $pkg (split(/\s+/, $ENV{'DEPS'})) {
		print STDERR "Stripping dirs from $pkg\n";
		augment_mtree($mtree, $ENV{'PKGREPOSITORY'}."/$pkg.tgz");
	}
	# make sure mtree is removed 
	for my $d (keys %$mtree) {
		delete $dirs->{$d}
	}
	for my $d (keys %$dirs) {
		$files->{$d} = "directory";
	}
	return $files;
}

sub strip_base
{
	local($_)=shift;
	my $base = shift->{stripprefix};
	if (m/^\Q$base\E/) {
		$_ = $';
	}
	$_='/' if $_ eq '';
	return $_;
}

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

sub create_packinglist
{
	my ($filename, $prefix) = @_;

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

sub parse_original_plist
{
    my ($name, $prefix) = @_;
    my $plist = create_packinglist($name, $prefix);
    $plist->{tag_marker} = new OpenBSD::PackingElement('');
    $plist->fromfile($name, 
	sub {
	    my ($fh, $cont) = @_;
	    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}->{lastfile};
    for my $item (@{$plist->{items}}) {
    	$item->register($plist, $foundfiles, $foundcomments);
    }
    return $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);
	}
}

sub grab_all_lists
{
	my $prefixes = shift;
	my $prefix = $prefixes->{''};

	my @l = ();
	my $plistname=$ENV{'PLIST'};
	my $pfragname=$ENV{'PFRAG'};
	my $psharedname=$pfragname.".shared";
	# Subpackage rules... better way would be to ask bsd.port.mk directly
	my $altplistname = $plistname;
	$altplistname =~ s/PLIST.*$/PLIST/;

	my $plist = create_packinglist($plistname, $prefix);
	my $origplist = parse_original_plist($plistname, $prefix);
	replaces($origplist, $plist);
	push(@l, $plist);
	# Try to handle fragments
	for my $item (@{$origplist->{items}}) {
		my $fragname = $item->deduce_fragment($pfragname);
		next unless defined $fragname;
		my $pfrag = create_packinglist($fragname, $prefix);
		my $origpfrag = parse_original_plist($fragname, $prefix);
		replaces($origpfrag, $pfrag);
		push(@l, $pfrag);
	}

	my $pshared = create_packinglist($psharedname, $prefix);
	$plist->{shared} = $pshared;
	my $origshared = parse_original_plist($psharedname, $prefix);
	replaces($origshared, $pshared);
	push(@l, $pshared);

	my $multi = $ENV{'MULTI_PACKAGES'};
	# Normalize
	$multi =~ s/^\s+//;
	$multi =~ s/\s+$//;
	unless ($multi eq '') {
		for my $sub (split(/\s+/, $multi)) {
			my $o;
			my $n = create_packinglist("$plistname$sub", $prefixes->{$sub});
			$o = parse_original_plist("$plistname$sub", $prefixes->{$sub}) or
			    $o = parse_original_plist("$altplistname$sub", $prefixes->{$sub});
			replaces($o, $n);
			push(@l, $n);
			my $ns = create_packinglist("$psharedname$sub", $prefixes->{$sub});
			$n->{shared} = $ns;
			$o = parse_original_plist("$psharedname$sub", $prefixes->{$sub});
			replaces($o, $ns);
			push(@l, $ns);
		}
	}
	return @l;
}

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);
	} else {
		return OpenBSD::PackingElement::File->new($short);
	}
}

sub handle_file
{
	my ($i, $type, $foundfiles, $foundcomments, $allplists, $shared_only) = @_;

	my $default = $allplists->[0];
	my $k = var_backsubst($i);
	my $short;
	my $p;
	my $item;

	# 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};
		$short = strip_base($i, $p);
	} else {
	# otherwise, look for the first matching prefix in plist to produce
		for my $try (@$allplists) {
			my $s2 = strip_base($i, $try);
			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) {
		print "Bogus element outside of base: $i\n";
		return;
	}
	$short = var_backsubst($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 (($type eq 'library' || $type eq 'plugin') && (!defined $item) && !$shared_only) {
			$p->{wantshared} = 1;
			$p = $p->{shared};
		}
		if (defined $item) {
			if (defined $item->{mode}) {
				OpenBSD::PackingElement::Mode->add($p, $item->{mode});
			}
			if (defined $item->{owner}) {
				OpenBSD::PackingElement::Owner->add($p, $item->{owner});
			}
			if (defined $item->{group}) {
				OpenBSD::PackingElement::Group->add($p, $item->{group});
			}
			if (defined $item->{nochecksum}) {
				$o->{nochecksum} = 1;
			}
			if (defined $item->{ignore}) {
				$o->{ignore} = 1;
			}
		}
		$o->add_object($p);
		$p->{nonempty} = 1;
		if (defined $item) {
			if (defined $item->{mode}) {
				OpenBSD::PackingElement::Mode->add($p, '');
			}
			if (defined $item->{owner}) {
				OpenBSD::PackingElement::Owner->add($p, '');
			}
			if (defined $item->{group}) {
				OpenBSD::PackingElement::Group->add($p, '');
			}
		}

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

my %prefix;

while ($ARGV[0] =~ m/^PREFIX(-.*?)\=/) {
	my ($sub, $v) = ($1, $');
	$prefix{$sub} = $v;
	shift @ARGV;
}
$prefix{''}=$ENV{'TRUEPREFIX'};
	
for (@ARGV) {
	if (m/\=/) {
		my $back = $`;
		my $v = $';
		push(@backsubst, ["\${$back}", $v]) if $v ne '';
	}
}


my $files = get_files();

my @l = grab_all_lists(\%prefix);

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;
		}
		if (defined $orig->{pkgcfl}) {
			for my $cfl (@{$orig->{pkgcfl}}) {
				$cfl->clone()->add_object($plist);
				$plist->{nonempty} = 1;
			}
		}
	}
}

my $shared_only;
if (defined $ENV{'SHARED_ONLY'}) {
	if ($ENV{'SHARED_ONLY'} =~ m/^Yes$/i) {
		$shared_only = 1;
	}
}

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

# 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} && !$default->{hasshared}) {
	OpenBSD::PackingElement::Fragment->add($default, "SHARED");
}

while (my ($k, $v) = each %$foundcomments) {
	next if defined $v->{accounted_for};
	print "Not accounted for: \@comment $k\n";
}


{
	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) {
				print $plist->{filename}, " empty\n";
				$something_changed = 1;
				$plist->{changed} = 1;
			}
		}
	}

	if ($something_changed) {
		for my $plist (@l) {
			my $orig = $plist->{original};
			if (defined $orig) {
				die $orig->{filename}.".orig present" 
				    if -e $orig->{filename}.".orig";
			}
		}
	}
	for my $plist (@l) {
		my $orig = $plist->{original};
		if ($plist->{changed}) {

			if (defined $orig) {
				rename($orig->{filename}, $orig->{filename}.".orig");
			}
			$plist->tofile($plist->{filename});
		}
	}
}
