move parts of make-plist into a separate module to try to clean up the
mess a bit...
This commit is contained in:
espie
parent
46da5e857d
commit
4374ceee96
280
infrastructure/install/FS.pm
Normal file
280
infrastructure/install/FS.pm
Normal file
@ -0,0 +1,280 @@
|
||||
# $OpenBSD: FS.pm,v 1.1 2008/10/27 10:33:46 espie Exp $
|
||||
# Copyright (c) 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.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package FS;
|
||||
|
||||
my $destdir;
|
||||
use OpenBSD::Mtree;
|
||||
use File::Find;
|
||||
use File::Spec;
|
||||
use File::Basename;
|
||||
# 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;
|
||||
}
|
||||
|
||||
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
|
||||
{
|
||||
$destdir = shift;
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
@ -1,5 +1,5 @@
|
||||
#! /usr/bin/perl
|
||||
# $OpenBSD: make-plist,v 1.103 2008/10/26 16:24:22 espie Exp $
|
||||
# $OpenBSD: make-plist,v 1.104 2008/10/27 10:33:46 espie Exp $
|
||||
# Copyright (c) 2004-2008 Marc Espie <espie@openbsd.org>
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software for any
|
||||
@ -24,18 +24,16 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib $ENV{PORTSDIR}."/infrastructure";
|
||||
use lib $ENV{PORTSDIR}."/infrastructure/install";
|
||||
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::Compare;
|
||||
use File::Temp;
|
||||
use FS;
|
||||
|
||||
package OpenBSD::ReverseSubst;
|
||||
our @ISA = (qw(OpenBSD::Subst));
|
||||
@ -513,167 +511,6 @@ sub register
|
||||
|
||||
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.
|
||||
|
||||
@ -686,97 +523,6 @@ sub augment_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
|
||||
{
|
||||
@ -1082,7 +828,7 @@ sub handle_file
|
||||
|
||||
parse_args();
|
||||
|
||||
my $files = get_files();
|
||||
my $files = FS::get_files($destdir);
|
||||
|
||||
my @l = grab_all_lists($files);
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user