From 4374ceee9699593f7b73aeab134ac831ad0c2a7b Mon Sep 17 00:00:00 2001 From: espie Date: Mon, 27 Oct 2008 10:33:46 +0000 Subject: [PATCH] move parts of make-plist into a separate module to try to clean up the mess a bit... --- infrastructure/install/FS.pm | 280 ++++++++++++++++++++++++++++++ infrastructure/install/make-plist | 264 +--------------------------- 2 files changed, 285 insertions(+), 259 deletions(-) create mode 100644 infrastructure/install/FS.pm diff --git a/infrastructure/install/FS.pm b/infrastructure/install/FS.pm new file mode 100644 index 00000000000..0f84447ece2 --- /dev/null +++ b/infrastructure/install/FS.pm @@ -0,0 +1,280 @@ +# $OpenBSD: FS.pm,v 1.1 2008/10/27 10:33:46 espie Exp $ +# Copyright (c) 2008 Marc Espie +# +# 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; diff --git a/infrastructure/install/make-plist b/infrastructure/install/make-plist index 5ce7784e0ff..012488f383a 100755 --- a/infrastructure/install/make-plist +++ b/infrastructure/install/make-plist @@ -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 # # 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);