478 lines
11 KiB
Perl
Executable File
478 lines
11 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
# $OpenBSD: make-plist,v 1.33 2004/06/29 01:28:26 mjc Exp $
|
|
|
|
# Copyright (c) 1999 Marc Espie
|
|
#
|
|
# Redistribution and use in source and binary forms, with or without
|
|
# modification, are permitted provided that the following conditions
|
|
# are met:
|
|
# 1. Redistributions of source code must retain the above copyright
|
|
# notice, this list of conditions and the following disclaimer.
|
|
# 2. Redistributions in binary form must reproduce the above copyright
|
|
# notice, this list of conditions and the following disclaimer in the
|
|
# documentation and/or other materials provided with the distribution.
|
|
#
|
|
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND
|
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE
|
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
# SUCH DAMAGE.
|
|
#
|
|
|
|
|
|
use strict;
|
|
|
|
|
|
use IO::File;
|
|
use File::Find;
|
|
use File::Spec;
|
|
use File::Temp qw/ tempdir /;
|
|
|
|
my $manual = 0;
|
|
my %out;
|
|
my @has_shared;
|
|
my ($plist, $pshared);
|
|
|
|
{
|
|
package Annotation;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
bless {}, $class;
|
|
}
|
|
|
|
sub add {
|
|
my $object = shift;
|
|
my $key = shift;
|
|
unless (defined $object->{$key}) {
|
|
$object->{$key} = [];
|
|
}
|
|
push(@{$object->{$key}}, @_);
|
|
}
|
|
}
|
|
|
|
my $annotated = new Annotation;
|
|
my $annotated_dir = new Annotation;
|
|
my $info_file = new Annotation;
|
|
|
|
sub annotate
|
|
{
|
|
my $oldfh = shift;
|
|
my $name = shift;
|
|
my $newfh = shift;
|
|
my $comment_printed = 0;
|
|
my ($mode, $owner, $group, $nocheck) = ('', '', '', '');
|
|
while(<$oldfh>) {
|
|
chomp;
|
|
if (m/^\@mode\s*/) {
|
|
$mode = $';
|
|
} elsif (m/^\@owner\s*/) {
|
|
$owner = $';
|
|
} elsif (m/^\@group\s*/) {
|
|
$group = $';
|
|
} elsif (m/^\@comment\s+no checksum$/) {
|
|
$nocheck = 1;
|
|
} elsif (m/^\@option no-default-conflict/||m/^\@pkgcfl/) {
|
|
printf $newfh "$_\n";
|
|
} elsif (m/^\@exec\s+/ || m/^\@unexec\s+/) {
|
|
$_=$';
|
|
# we don't warn for stuff we probably added...
|
|
next if m/^mkdir -p/||m/^install-info /;
|
|
$manual = 1;
|
|
} elsif (m/^\@comment\s+\$OpenBSD\:.*\$$/) {
|
|
print $newfh "$_\n";
|
|
$comment_printed = 1;
|
|
next;
|
|
} elsif (m/^\@comment\s+/) {
|
|
$_ = $';
|
|
if (m/^\@dirrm\s+/) {
|
|
$_ = $';
|
|
$annotated_dir->add($_, [ $name, $newfh, 'comment']);
|
|
next;
|
|
} else {
|
|
$annotated->add($_, [ $name, $newfh, 'comment'] );
|
|
}
|
|
next;
|
|
} elsif (m/^\@dirrm\s+/) {
|
|
$_=$';
|
|
$annotated_dir->add($_, [ $name, $newfh ]);
|
|
next;
|
|
} elsif (m/^\@/) {
|
|
next;
|
|
} elsif (m/^\!?\%\%(.*)\%\%/) {
|
|
my $frag = $1;
|
|
if ($frag ne "SHARED") {
|
|
print $newfh "$_\n";
|
|
$manual = 1;
|
|
}
|
|
} elsif (m/\$\{.*\}/) {
|
|
$manual = 1;
|
|
}
|
|
|
|
if ("$mode$owner$group$nocheck" ne '') {
|
|
$annotated->add($_, [ $name, $newfh, $mode, $owner, $group, $nocheck ]);
|
|
$nocheck = '';
|
|
} else {
|
|
$annotated->add($_, [ $name, $newfh ]);
|
|
}
|
|
if (m/\.info$/) {
|
|
$info_file->add($_, [ $name, $newfh ]);
|
|
}
|
|
}
|
|
print $newfh "\@comment \$OpenBSD\$\n" unless $comment_printed;
|
|
}
|
|
|
|
# read an mtree file, and produce the corresponding directory hierarchy
|
|
sub parse_mtree
|
|
{
|
|
# start under current DESTDIR, usually
|
|
my $current = shift;
|
|
local(*FILE);
|
|
my %mtree;
|
|
open FILE, $ENV{MTREE_FILE};
|
|
while(<FILE>) {
|
|
chomp;
|
|
s/^\s*//;
|
|
next if /^\#/ || /^\//;
|
|
s/\s.*$//;
|
|
next if /^$/;
|
|
if ($_ eq '..') {
|
|
$current =~ s|/[^/]*$||;
|
|
next;
|
|
} else {
|
|
$current.="/$_";
|
|
}
|
|
$_ = $current;
|
|
while (s|/\./|/|) {}
|
|
$mtree{$_} = 1;
|
|
}
|
|
close FILE;
|
|
return \%mtree;
|
|
}
|
|
|
|
# prefix to remove from everything
|
|
my $base = $ENV{PREFIX};
|
|
my @backsubst;
|
|
|
|
sub strip
|
|
{
|
|
local($_) = shift;
|
|
s|^\Q$base\E/||;
|
|
for my $l (@backsubst) {
|
|
my $v = $l->[1];
|
|
my $r = $l->[0];
|
|
s/\Q$v\E/$r/g;
|
|
}
|
|
# If the resulting name is arch-dependent, we warn.
|
|
# We don't fix it automatically, as this may need special handling.
|
|
if (m/i386|m68k|sparc/) {
|
|
print STDERR "make-plist: generated plist contains arch-dependent\n";
|
|
print STDERR "\t$_\n";
|
|
}
|
|
return $_;
|
|
}
|
|
|
|
sub add_info
|
|
{
|
|
my ($header, $info_dir) = @_;
|
|
for my $d (sort (keys %$info_dir) ) {
|
|
for my $f (sort @{$info_dir->{$d}}) {
|
|
my $d2 = strip($d);
|
|
my $f2 = "$d2/$f";
|
|
if (defined $info_file->{$f2}) {
|
|
for my $l (@{$info_file->{$f2}}) {
|
|
$l->[1]->print("$header --info-dir=\%D/$d2 \%D/$f2\n");
|
|
}
|
|
} else {
|
|
$out{$plist}->print("$header --info-dir=\%D/$d2 \%D/$f2\n");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub augment_mtree
|
|
{
|
|
my ($mtree, $dst, $pkg) = @_;
|
|
my $basepath;
|
|
local(*FILE);
|
|
system("tar zxqf $pkg +CONTENTS");
|
|
open(FILE, '<', '+CONTENTS') or
|
|
die "Error in dependent package $pkg\n";
|
|
while (<FILE>) {
|
|
chomp;
|
|
if (m/^\@dirrm\s+/) {
|
|
die "Badly formed package: $pkg\n";
|
|
}
|
|
if (m/^\@cwd\s+/) {
|
|
$basepath = $';
|
|
last;
|
|
}
|
|
}
|
|
unless (defined $basepath and
|
|
File::Spec->file_name_is_absolute($basepath)) {
|
|
die "Badly formed package: $pkg\n";
|
|
}
|
|
while (<FILE>) {
|
|
chomp;
|
|
if (m/^\@dirrm\s+/) {
|
|
my $filename= File::Spec->catfile($dst, $basepath, $');
|
|
$mtree->{$filename} = $pkg;
|
|
}
|
|
}
|
|
close(FILE);
|
|
unlink('+CONTENTS');
|
|
}
|
|
|
|
sub handle_file
|
|
{
|
|
my $fname = strip(shift);
|
|
my $out = shift;
|
|
my $string = "$fname\n";
|
|
|
|
if (defined $annotated->{$fname}) {
|
|
for my $l (@{$annotated->{$fname}}) {
|
|
if (@$l == 3) {
|
|
$l->[1]->print("\@comment $string");
|
|
} elsif (@$l == 2) {
|
|
$l->[1]->print($string);
|
|
} else {
|
|
my ($outname, $fh, $mode, $owner, $group, $nocheck) = @$l;
|
|
if ($mode ne '') {
|
|
$string="\@mode $mode\n$string\@mode\n";
|
|
}
|
|
if ($owner ne '') {
|
|
$string="\@owner $owner\n$string\@owner\n";
|
|
}
|
|
if ($group ne '') {
|
|
$string="\@group $group\n$string\@group\n";
|
|
}
|
|
if ($nocheck ne '') {
|
|
$string="\@comment no checksum\n$string";
|
|
}
|
|
print $fh $string;
|
|
}
|
|
}
|
|
} else {
|
|
print $out $string;
|
|
}
|
|
}
|
|
|
|
sub may_annotate_and_move
|
|
{
|
|
my $p = shift;
|
|
|
|
if (-e $p) {
|
|
if (defined $out{$p}) {
|
|
die "File handle for $p already exists";
|
|
}
|
|
my $fh = new IO::File "<$p";
|
|
rename($p, "$p.orig") or die "Can't rename $p to $p.orig";
|
|
my $newfh = new IO::File ">$p";
|
|
annotate($fh, $p, $newfh);
|
|
close $fh;
|
|
$out{$p} = $newfh;
|
|
return 1;
|
|
} else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
|
|
my (%newdir, %occupied, %ldconfig, %has_stuff, %info_dir, @files, @libfiles);
|
|
die "Update bsd.port.mk" if @ARGV == 0;
|
|
my $plistdir = shift;
|
|
die "Update bsd.port.mk" if -f $plistdir;
|
|
die "Update bsd.port.mk"
|
|
unless defined $ENV{'DEPS'} and defined $ENV{'PKGREPOSITORY'};
|
|
die "Update bsd.port.mk"
|
|
unless defined $ENV{'PLIST'} and defined $ENV{'PFRAG'};
|
|
$plist = $ENV{'PLIST'};
|
|
$pshared = $ENV{'PFRAG'}.'.shared';
|
|
if (-e "$plist.orig" or -e "$pshared.orig") {
|
|
die "You must clean up old files first";
|
|
}
|
|
|
|
my $destdir = $ENV{DESTDIR};
|
|
|
|
my $mtree = parse_mtree($destdir);
|
|
|
|
# and directories for dependencies as well
|
|
my $tmpdir = tempdir( CLEANUP => 1);
|
|
chdir($tmpdir);
|
|
for my $pkg (split(/\s+/, $ENV{'DEPS'})) {
|
|
augment_mtree($mtree, $destdir, $ENV{'PKGREPOSITORY'}."/$pkg.tgz");
|
|
}
|
|
|
|
may_annotate_and_move($plist);
|
|
may_annotate_and_move($pshared) and push(@has_shared, $out{$plist});
|
|
|
|
|
|
# Subpackage rules... better way would be to ask bsd.port.mk directly
|
|
my $plist2 = $plist;
|
|
$plist2 =~ s/PLIST.*$/PLIST/;
|
|
|
|
my $multi = $ENV{'MULTI_PACKAGES'};
|
|
# Normalize
|
|
$multi =~ s/^\s+//;
|
|
$multi =~ s/\s+$//;
|
|
unless ($multi eq '') {
|
|
for my $sub (split(/\s+/, $multi)) {
|
|
may_annotate_and_move("$plist$sub") or
|
|
may_annotate_and_move("$plist2$sub");
|
|
may_annotate_and_move("$pshared$sub") and push(@has_shared, $out{"$plist$sub"});
|
|
}
|
|
}
|
|
|
|
for (@ARGV) {
|
|
if (m/\=/) {
|
|
my $back = $`;
|
|
my $v = $';
|
|
push(@backsubst, ["\${$back}", $v]) if $v ne '';
|
|
}
|
|
}
|
|
|
|
my ($name, $fh);
|
|
while (($name, $fh) = each %out) {
|
|
}
|
|
|
|
# compare all files against those dates
|
|
my @date = (stat $ENV{INSTALL_PRE_COOKIE})[9, 10];
|
|
|
|
my %okay_files=map { $_=>1 } split(/\s+/, $ENV{'OKAY_FILES'});
|
|
|
|
# check the installation directory, try to make certain there is
|
|
# no file or directory outside of $base
|
|
find(
|
|
sub {
|
|
if ($File::Find::name eq $base) {
|
|
$File::Find::prune = 1;
|
|
return;
|
|
}
|
|
if (-d $_) {
|
|
return if $File::Find::name eq $destdir;
|
|
if (defined $mtree->{$File::Find::name}) {
|
|
return;
|
|
} else {
|
|
print STDERR "Bogus directory: $File::Find::name\n";
|
|
}
|
|
} else {
|
|
return if defined $okay_files{$File::Find::name};
|
|
print STDERR "Bogus file: $File::Find::name\n";
|
|
}
|
|
}, $destdir);
|
|
|
|
# recursive traversal: mark specific `info' dirs, `ldconfig' dirs,
|
|
# and potentially modified dirs
|
|
|
|
find(
|
|
sub {
|
|
my @cdate = (lstat $_)[9, 10];
|
|
if ($cdate[0] >= $date[0] || $cdate[1] >= $date[1]) {
|
|
$has_stuff{$File::Find::dir} = 1;
|
|
if (-d _) {
|
|
$newdir{$File::Find::name} = 1;
|
|
} else {
|
|
if (/\.so(?:\.\d+\.\d+)?$/) {
|
|
$ldconfig{$File::Find::dir} = 1;
|
|
push(@libfiles, $File::Find::name);
|
|
} else {
|
|
push(@files, $File::Find::name);
|
|
if (/\.info$/) {
|
|
my $d = $File::Find::dir;
|
|
$info_dir{$d} = [] unless defined $info_dir{$d};
|
|
push(@{$info_dir{$d}}, $_);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
$occupied{$File::Find::dir} = 1;
|
|
}
|
|
}, $base);
|
|
|
|
|
|
# occupied marks a dir that was already there...
|
|
# so all parents had to be around too
|
|
for my $d (keys %occupied) {
|
|
while ($d ne '') {
|
|
undef $newdir{$d} if defined $newdir{$d};
|
|
$d =~ s|/.*?/?$||;
|
|
}
|
|
}
|
|
|
|
# make sure mtree is removed
|
|
for my $d (keys %$mtree) {
|
|
undef $newdir{$d}
|
|
}
|
|
|
|
unless (defined $out{$plist}) {
|
|
$out{$plist} = new IO::File ">$plist";
|
|
$out{$plist}->print("\@comment \$OpenBSD\$\n");
|
|
}
|
|
|
|
add_info('@unexec install-info --delete', \%info_dir);
|
|
|
|
for my $f (sort @files) {
|
|
handle_file($f, $out{$plist}) unless ($f =~ m|/dir$|) && (defined $info_dir{$`});
|
|
}
|
|
|
|
for my $fh (@has_shared) {
|
|
$fh->print("\%\%SHARED\%\%\n");
|
|
}
|
|
|
|
|
|
if (@libfiles > 0) {
|
|
unless (defined $out{$pshared}) {
|
|
$out{$pshared} = new IO::File ">$pshared";
|
|
$out{$pshared}->print("\@comment \$OpenBSD\$\n");
|
|
}
|
|
|
|
$out{$plist}->print("\%\%SHARED\%\%\n") if @has_shared == 0;
|
|
for my $f (sort @libfiles) {
|
|
handle_file(strip($f), $out{$pshared});
|
|
}
|
|
for my $d (sort (keys %ldconfig)) {
|
|
if (defined $newdir{$d}) {
|
|
$out{$pshared}->print("NEWDYNLIBDIR(\%D/", strip($d), ")\n");
|
|
} else {
|
|
$out{$pshared}->print("DYNLIBDIR(\%D/", strip($d), ")\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
for my $d (sort { $b cmp $a } (grep { $newdir{$_} } (keys %newdir) ) ) {
|
|
my $dname = strip($d);
|
|
if (defined $annotated_dir->{$dname}) {
|
|
for my $l (@{$annotated_dir->{$dname}}) {
|
|
if (!$has_stuff{$d}) {
|
|
$l->[1]->print("\@exec mkdir -p \%D/$dname\n");
|
|
}
|
|
if (@$l == 3) {
|
|
$l->[1]->print("\@comment \@dirrm $dname\n");
|
|
} else {
|
|
$l->[1]->print("\@dirrm $dname\n");
|
|
}
|
|
}
|
|
} else {
|
|
# case of new directory that does not hold anything: it's marked
|
|
# for removal, but it must exist first
|
|
if (!$has_stuff{$d}) {
|
|
$out{$plist}->print("\@exec mkdir -p \%D/$dname\n");
|
|
}
|
|
$out{$plist}->print("\@dirrm $dname\n");
|
|
}
|
|
}
|
|
|
|
add_info('@exec install-info', \%info_dir);
|
|
|
|
if ($manual) {
|
|
print STDERR "make plist: subst/frag/exec/unexec spotted in original file\n";
|
|
print STDERR "\tMay require manual intervention\n";
|
|
}
|