OpenSolaris_b135/tools/depcheck/make_pkg_db
#!/usr/bin/perl
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License, Version 1.0 only
# (the "License"). You may not use this file except in compliance
# with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
# Copyright (c) 2000 by Sun Microsystems, Inc.
# All rights reserved.
#
# ident "%Z%%M% %I% %E% SMI"
$PkgDir = "/var/sadm/pkg"; # where to find the pkg directories
$PROGRAM_NAME = "make_pkg_db";
$DBM_DIR_CHARACTERIZATION = "directory for the dbm databases";
$INPUT_FILES_CHARACTERIZATION = "one or more files in /var/sadm/install/contents format";
$PKGDEFS_DIRECTORY = "package pool directory";
$Usage =
"Usage: $PROGRAM_NAME
[-ifiles <$INPUT_FILES_CHARACTERIZATION>]
[-pkgdef <$PKGDEFS_DIRECTORY>]
-dbdir <$DBM_DIR_CHARACTERIZATION>
[-h for help]\n";
$Help =
"This program initializes a set of dbm databases with information
from /var/sadm/install/contents or a user-defined package pool directory.
There is one required argument:
-dbdir <dir> the $DBM_DIR_CHARACTERIZATION
\nThe optional argument -h produces this message instead of any processing.
\nThe optional argument -ifiles is used for symbolic link resolution.
\nThe optional argument -pkgdef creates the databases based upon a package \npool directory instead of /var/sadm/install/contents on the local machine.
";
#
# check for perl5 -- we use things unavailable in perl4
#
die "Sorry, this program requires perl version 5.000 or up. You have $]. Stopping" if $] < 5.000;
#
# process arguments
#
$PKGDefs = "";
while (@ARGV) {
$arg = shift (@ARGV);
if ($arg eq "-h") {
print "$Help\n$Usage";
exit 0;
} elsif ($arg eq "-ifiles") {
while (($ARGV[0] !~ /^-/) && (@ARGV)){
push (@IFiles, shift(@ARGV));
}
} elsif ($arg eq "-dbdir") {
$DBDir = shift(@ARGV) unless ($ARGV[0] =~ /^-/);
} elsif ($arg eq "-pkgdef") {
$PKGDefs = shift(@ARGV) unless ($ARGV[0] =~ /^-/);
} else {
print STDERR "Unrecognized argument $arg. \n$Usage";
exit 1;
}
}
# make sure the package pool directory exists
if (($PKGDefs) && !(-d $PKGDefs)) {
print STDERR "Cannot open the directory $PKGDefs\n";
exit 1;
}
# Here we define the input files which will be parsed
if ($PKGDefs) {
$dirs = `ls $PKGDefs`;
@dirlist = split(/\s*\n\s*/, $dirs);
foreach $dir (@dirlist) {
push(@IFiles, "$PKGDefs/$dir/pkgmap");
}
reverse(@IFiles);
}
else {
push(@IFiles, "/var/sadm/install/contents");
}
if (!@IFiles) {
print STDERR "Required argument -ifiles missing. \n$Usage";
exit 1;
}
if (!$DBDir) {
print STDERR "Required argument -dbdir missing. \n$Usage";
exit 1;
}
$Struct = \%struct; # here is the structure we'll store everything in
#
# now open the dbm databases we will initialize
#
&yelp ("...initializing the databases\n");
unless (-d "$DBDir") {
&yelp("Creating directory $DBDir\n");
mkdir($DBDir, 0777);
}
# db for package names from the /var/sadm/pkg/foo/pkginfo files
dbmopen(%PKGNAMES, "$DBDir/PKGNAMES", 0644) || die"Cannot open dbm db $DBDir/PKGNAMES\n";
# db for entity file types
dbmopen(%FTYPE, "$DBDir/FTYPE", 0664) || die"Cannot open dbm db $DBDir/FTYPE\n";
# db for entity modes types
dbmopen(%MODE, "$DBDir/MODE", 0664) || die"Cannot open dbm db $DBDir/MODE\n";
# db for entity packages
dbmopen(%PKGS, "$DBDir/PKGS", 0664) || die"Cannot open dbm db $DBDir/PKGS\n";
# db for absolute link targets
dbmopen(%ABSLINK, "$DBDir/ABSLINK", 0664) || die"Cannot open dbm db $DBDir/ABSLINK\n";
undef %FTYPE; # remove existing records, if any
undef %MODE;
undef %PKGS;
undef %ABSLINK;
undef %PKGNAMES;
$Debug = 1; # print extra gibberish
#
# go make the package names db
#
&MakePackageNamesDB($PkgDir);
#
# read and parse each input file in contents file format
#
&yelp ("...making the FTYPE MODE and PKGS databases\n");
foreach $IFile (@IFiles) {
if ($PKGDefs) {
unless (-r $IFile) {
print STDERR "Could not open file: $IFile\n";
next;
}
@pkgname = split("/", $IFile);
$thisPkg = @pkgname[($#pkgname-1)];
$pkgInfo="$PKGDefs/$thisPkg/pkginfo";
$thisBaseDir="";
if (-r $pkgInfo) {
$BASEDIR = `grep '^BASEDIR' $pkgInfo`;
$BASEDIR =~ s/^BASEDIR=//;
chomp($BASEDIR);
$thisBaseDir = $BASEDIR;
}
}
open (IFILE, "$IFile") || die "cannot open input file $IFile\n";
# Tell the user what we are looking at UNLESS they are looking at a package
# pool. A package pool could have hundreds of entries which just creates
# a lot of useless (and confusing) output.
&yelp("...opening $IFile\n") unless ($PKGDefs);
while (<IFILE>) { # loop over file line-at-a-time
if ($PKGDefs) {
next if /^:/; # ignore these lines from a pkgmap
next if (/(\S+)\s+[i]\s+/);
}
else {
next if /^#/; # ignore comments
next if /^\s*$/; # ignore blanks
}
chop;
undef $FType;
undef $Mode;
$line=$_;
if ($PKGDefs) {
&ParsePkgmapEntry($line);
@Pkgs = $thisPkg;
}
else {
&ParseContentsEntry($_);
}
# if this entry was supplied by a earlier file, skip it
if ($FTYPE{$Entity} =~ /\w/) {
# don't bother complaining about directories, we know the same
# directory could exist in multiple packages
next if ($FTYPE{$Entity} eq "d");
if ($PKGDefs) {
# In the case where we are going through a package pool, we
# expect that a file may reside in multiple packages. If
# that is detected, we simply add this package to the list of
# packages for that file
$currPkgs = $PKGS{$Entity};
next if ($FTYPE{$Entity} eq "s");
$PKGS{$Entity} = "$currPkgs $thisPkg";
}
else {
# In the case where we are reading in from
# /var/sadm/install.contents, we do not expect to see any
# over-ridden files EXCEPT when the "-ifiles" option is used.
&yelp("...OVERRIDDEN: $line\n");
}
next;
} else {
$Package = join(" ",@Pkgs);# store supplying packages sep by " "
# This is a hack. In the case of directories like /bin which
# would belong in many packages, the $PKGS hash would not
# be able to handle such a long entry. So for directories, I
# just place the first package I find. For this tool, it doesn't
# matter since this tool does not report which directories come
# from which package.
if ($FType eq "d") {
@FirstPackage = split(" ", $Package);
$PKGS{$Entity} = $FirstPackage[0];
}
else {
$PKGS{$Entity} = $Package; # update PKGS database
}
}
#
# put what we need from this entry line into the dbs
#
&yelp ("***NO FILETYPE! IGNORING ENTRY: $_\n") unless $FType;
$FTYPE{$Entity} = $FType; # update the FTYPE database
#
# now collect the possible paths for each basename
#
($path, $base) = $Entity =~ /(.*\/)(.*)/;
push(@{$Struct->{"PATHS"}->{$base}}, $Entity);
if ($FType =~ /[ls]/) { # link
$rellinkent = "$Entity;$RelEntity";
push (@RelLinkEnts,$rellinkent); # make list of ents to resolve
} else {
$MODE{$Entity} = $Mode if $Mode ne ""; # update MODE database
}
}
close IFILE;
} # end foreach $IFile
#
# now convert the relative links into absolute ones
#
&yelp ("...making the ABSLINK database\n");
foreach $rellinkent (@RelLinkEnts) {
($Entity, $RelEntity) = split(/;/, $rellinkent);
$AbsLink = &GetAbsLink($Entity, $RelEntity);
$ABSLINK{$Entity} = $AbsLink;
}
#
# close the dbs -- we're done
#
dbmclose (FTYPE);
dbmclose (MODE);
dbmclose (PKGS);
dbmclose (ABSLINK);
dbmclose (PKGNAMES);
&yelp ("...DONE\n");
#===========================END OF MAIN====================================
sub GetAbsLink { # convert relative link to actual one
local ($entry, $rellink) = @_;
return $rellink if $rellink =~ /^\//; # just return if abs already
@RelPath = split(/\//,$rellink);
@EntryPath = split(/\//,$entry);
#
# get the filename part
#
undef @AbsPath;
@AbsPath = (pop(@RelPath)) if $RelPath[$#RelPath] =~ /w/;
pop @EntryPath;
#
# pop the relative path until a relative dir shows up
#
while (@RelPath) {
$relhere = pop(@RelPath);
if ($relhere =~ /\w/) { # there's a letter or number
unshift (@AbsPath, $relhere); # its a dirname; keep it
} elsif ($relhere =~ /^\.\.$/) { # its a .. pop up one dir
pop(@EntryPath);
} elsif ($relhere =~ /^\.$/) { # it's a . -- stop
last;
}
}
while (@EntryPath) { # complete the path
unshift(@AbsPath, pop(@EntryPath)); # ...from the remaining entry
}
$abspath = join("/", @AbsPath);
if (!$FTYPE{$abspath}) { # no installed entity !
# NICKI - for now
&yelp("***CANNOT FIND ABSOLUTE PATH $abspath FOR ENTRY: $entry=$rellink\n");
# &yelp("***CANNOT RESOLVE ABSOLUTE PATH $abspath\n");
# COMMENTED OUT BY NICKI
# $base = $rellink;
# $base =~ s/.*\///; # get basename we're looking for
# @cans = @{$Struct->{"PATHS"}->{$base}}; # get all entities ...
# $numcans = $#cans + 1; # ... with this base
# &yelp(" There are $numcans entries with this basename:\n");
# foreach $can (@cans) {
# &yelp(" $can\n");
# }
# $abspath = "";
}
return $abspath;
}
sub ParseContentsEntry {
#invocation: &ParseContentsEntry($l); # $l is a line in the file
local ($l) = @_;
#
# look for b or c entries, like:
# /devices/pseudo/openeepr@0:openprom c none 38 0 0640 root sys SUNWcsd
#
if (($Entity,$FType,$Class,$Maj,$Min,$Mode,$Owner,$Group,@Pkgs) =
($l =~ /^(\S+)\s+([bc])\s+(\w+)\s+([0-9]+)\s+([0-9]+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
#
# look for d entries, like
# /devices/pseudo d none 0755 root sys SUNWcsd
#
} elsif (($Entity,$FType,$Class,$Mode,$Owner,$Group,@Pkgs) =
($l =~ /^(\S+)\s+([d])\s+(\w+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
#
# look for f or e or v entries, like
# /etc/asppp.cf f none 0744 root sys 360 27915 801314234 SUNWapppr
#
} elsif (($Entity,$FType,$Class,$Mode,$Owner,$Group,
$Size,$Checksum,$Modtime,@Pkgs) =
($l =~ /^(\S+)\s+([fev])\s+(\w+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([0-9]+)\s+([0-9]+)\s+([0-9]+)\s+([A-Z].*)/)) {
#
# look for l or s entries, like
# /bin=./usr/bin s none SUNWcsr
#
} elsif (($Entity,$RelEntity,$FType,$Class,@Pkgs) =
($l =~ /^([^=]+)=(\S+)\s+([ls])\s+(\w+)\s+([A-Z].*)/)) {
} else {
print STDERR "Unrecognized entry in $IFile: $l\n";
}
}
sub ParsePkgmapEntry {
local ($line) = @_;
# for validation of input
$Unresolved = true;
# look for d entries, like
# 1 d root etc 775 root sys
if (($Part,$FType,$Class,$Entity,$Mode,$Owner,$Group) =
($line =~ /^(\S+)\s+([d])\s+(\w+)\s+(\S+)\s+(\d+)\s+(\w+)\s+(\w+)/)) {
# prepend a install root
if ($thisBaseDir eq "/") {
$Entity = "/$Entity";
}
else {
$Entity = "$thisBaseDir/$Entity";
}
$Unresolved = false;
}
# look for e,f or v entries, like
# 1 e master boot/solaris/devicedb/master 0644 root sys 75 5775 940882596
elsif (($Part,$FType,$Class,$Entity,$Mode,$Owner,$Group,$Size,$Checksum,$Modtime) =
($line =~ /^(\S+)\s+([efv])\s+(\w+)\s+(\S+)\s+(\d+)\s+(\w+)\s+(\w+)/)) {
# prepend a install root
if ($thisBaseDir eq "/") {
$Entity = "/$Entity";
}
else {
$Entity = "$thisBaseDir/$Entity";
}
$Unresolved = false;
}
elsif (($Part, $FType, $Class, $Entity, $RelEntity) =
($line =~ /^(\S+)\s+([ls])\s+(\w+)\s+(\S+)[=](\S+)/)) {
# prepend a install root
if ($thisBaseDir eq "/") {
$Entity = "/$Entity";
}
else {
$Entity = "$thisBaseDir/$Entity";
}
$Unresolved = false;
}
print ("UNRESOLVED: $line\n") if ($Unresolved eq true);
}
sub ParsePrototypeEntry {
#invocation: &ParsePrototypeEntry($l); # $l is a line in the file
local ($l) = @_;
#
# look for b or c entries, like:
# /devices/pseudo/openeepr@0:openprom c none 38 0 0640 root sys SUNWcsd
#
if (($Entity,$FType,$Class,$Maj,$Min,$Mode,$Owner,$Group,@Pkgs) =
($l =~ /^(\S+)\s+([bc])\s+(\w+)\s+([0-9]+)\s+([0-9]+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
#
# look for d entries, like
# d root etc 775 root sys
#
} elsif (($FType,$Class,$Entity,$Mode,$Owner,$Group) =
($l =~ /^([d])\s+(\w+)\s+(\S+)\s+([0-7]+)\s+(\w+)\s+(\w+)/)) {
#
# look for f or e or v entries, like
# e preserve etc/acct/holidays 664 bin bin
#
} elsif (($FType,$Class,$Entity,$Mode,$Owner,$Group) =
($l =~ /^([fev])\s+(\w+)\s+(\S+)\s+([0-7]+)\s+(\w+)\s+(\w+)/)) {
#
# look for l or s entries, like
# l root etc/rc2.d/S21perf=../../etc/init.d/perf
#
} elsif (($FType,$Class,$Entity,$RelEntity) =
($l =~ /^([ls])\s+(\w+)\s+([^=]+)=(\S+)/)) {
} else {
print STDERR "Unrecognized Prototype File entry: $l\n";
}
}
sub yelp {
local($String) = @_;
print "$String";
}
sub MakePackageNamesDB {
#invocation: &MakePackageNamesDB($PkgDir);
local ($PkgDir) = @_; # argument is parent directory of pkg dirs
#$PkgDir = "/var/sadm/pkg";
opendir(PKGDIR, "$PkgDir") || die "Cannot open package directory $PkgDir\n";
@Pkgs = grep(/^[A-Z]/,readdir(PKGDIR)); # list of all package directories
foreach $Pkg (@Pkgs) { # loop over 'em
$InfoFile = "$PkgDir/$Pkg/pkginfo"; # full name of the pkginfo file
if (-r $InfoFile) { # if we can read it
$str = `grep '^NAME=' $InfoFile`; # just grep the entry
$str =~ s/\s*\n$//; # trim trailing ws
$str =~ s/.*=\s*//; # trim leading NAME=
if ($str =~ /\w/) { # if the name has a letter or number in it
$PKGNAMES{$Pkg} = $str;
} else {
&yelp("***Cannot find usable NAME entry in $InfoFile\n");
}
} else {
&yelp("***Cannot find readable file $InfoFile\n");
}
} # end of loop over package directories
}