xref: /onnv-gate/usr/src/tools/depcheck/make_pkg_db (revision 0:68f95e015346)

#!/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
}