1076 lines
26 KiB
Perl
Executable File
1076 lines
26 KiB
Perl
Executable File
#! /usr/bin/perl
|
|
# $OpenBSD: make-plist,v 1.68 2005/07/04 10:46:05 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.
|
|
|
|
# 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 OpenBSD::PackingList;
|
|
use OpenBSD::PackingElement;
|
|
use OpenBSD::PackageLocator;
|
|
use OpenBSD::PackageInfo;
|
|
use OpenBSD::Mtree;
|
|
use File::Spec;
|
|
use File::Find;
|
|
use File::Compare;
|
|
use File::Basename;
|
|
use File::Temp;
|
|
|
|
|
|
# Plists use variable substitution, we have to be able to do it
|
|
# both ways to recognize existing entries.
|
|
|
|
my $base;
|
|
my @backsubst;
|
|
my $destdir = $ENV{'DESTDIR'};
|
|
|
|
die "No $destdir" unless -d $destdir;
|
|
|
|
sub var_backsubst
|
|
{
|
|
local $_ = shift;
|
|
for my $l (@backsubst) {
|
|
my $v = $l->[1];
|
|
my $r = $l->[0];
|
|
if ($r eq '${SYSCONFDIR}') {
|
|
s/^\Q$v\E/$r/;
|
|
} else {
|
|
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 $_;
|
|
}
|
|
|
|
# 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 zap_comment
|
|
{
|
|
my ($self, $foundcomments, $p) = @_;
|
|
|
|
my $s = $self->fullstring();
|
|
if (defined $foundcomments->{$s} and $foundcomments->{$s}->{plist} == $p) {
|
|
delete $foundcomments->{$s};
|
|
}
|
|
}
|
|
|
|
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::var_backsubst($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::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";
|
|
} 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;
|
|
if (-l $filename) {
|
|
my $l = readlink($filename);
|
|
if ($l =~ m|^/|) {
|
|
return $destdir.resolve_link($l);
|
|
} else {
|
|
return resolve_link(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$/ or $filename =~ m/info\/[^\/]+$/;
|
|
$filename = resolve_link($filename);
|
|
open my $fh, '<', $filename or return 0;
|
|
my $tag = <$fh>;
|
|
chomp $tag;
|
|
$tag.=<$fh>;
|
|
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[[:alpha:]]?(?:\.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, $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;
|
|
}
|
|
|
|
# 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));
|
|
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;
|
|
# add directories from dependencies, insist on having the real package.
|
|
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 $files->{$d}
|
|
}
|
|
return $files;
|
|
}
|
|
|
|
# full file name to file name in plist context
|
|
sub strip_base
|
|
{
|
|
local($_)=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, $prefix) = @_;
|
|
|
|
my $plist = new OpenBSD::PackingList;
|
|
$plist->{filename} = $filename;
|
|
$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, $prefix, $files, $all_plists, $parent) = @_;
|
|
my $plist = create_packinglist($name, $prefix);
|
|
# 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) = @_;
|
|
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, $prefix);
|
|
$pfrag->{isfrag} = 1;
|
|
push(@$all_plists, $pfrag);
|
|
my $origpfrag = parse_original_plist($fragname, $prefix, $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;
|
|
}
|
|
}
|
|
}
|
|
|
|
# old packing-lists used to hold comments to avoid fragments...
|
|
sub no_comments
|
|
{
|
|
my ($f, $orig) = @_;
|
|
return unless defined $f and defined $orig;
|
|
for my $item (@{$f->{items}}) {
|
|
$item->zap_comment($foundcomments, $orig);
|
|
}
|
|
}
|
|
|
|
|
|
sub grab_all_lists
|
|
{
|
|
my ($prefixes, $files) = @_;
|
|
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);
|
|
push(@$l, $plist);
|
|
my $origplist = parse_original_plist($plistname, $prefix, $files, $l);
|
|
replaces($origplist, $plist);
|
|
|
|
my $pshared = create_packinglist($psharedname, $prefix);
|
|
push(@$l, $pshared);
|
|
$plist->{shared} = $pshared;
|
|
my $origshared = parse_original_plist($psharedname, $prefix, $files);
|
|
replaces($origshared, $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});
|
|
push(@$l, $n);
|
|
$o = parse_original_plist("$plistname$sub", $prefixes->{$sub}, $l) or
|
|
$o = parse_original_plist("$altplistname$sub", $prefixes->{$sub}, $files, $l);
|
|
replaces($o, $n);
|
|
no_comments($o, $origplist);
|
|
my $ns = create_packinglist("$psharedname$sub", $prefixes->{$sub});
|
|
$n->{shared} = $ns;
|
|
$o = parse_original_plist("$psharedname$sub", $prefixes->{$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);
|
|
} else {
|
|
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 = 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);
|
|
if ($pass == 0 and $item->{end_faked} == 1) {
|
|
return;
|
|
}
|
|
if ($pass == 1 and $item->{end_faked} == 0) {
|
|
return;
|
|
}
|
|
} else {
|
|
# otherwise, look for the first matching prefix in plist to produce
|
|
# an entry
|
|
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 ($short =~ /\.orig$/) {
|
|
print STDERR "make-plist: generated plist may contain patched file\n";
|
|
print STDERR "\t$short\n";
|
|
}
|
|
if (($type eq 'library' || $type eq 'plugin') && (!defined $item) && !$shared_only) {
|
|
$p->{wantshared} = 1;
|
|
$p = $p->{shared};
|
|
}
|
|
handle_modes($p, $item, $o);
|
|
$o->add_object($p);
|
|
$p->{nonempty} = 1;
|
|
|
|
# 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, $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)) {
|
|
if (defined $orig->{$listname}) {
|
|
for my $o (@{$orig->{$listname}}) {
|
|
$o->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, 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");
|
|
}
|
|
$plist->tofile($plist->{filename});
|
|
}
|
|
}
|
|
}
|