Cross Reference: /illumos-gate/usr/src/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
}