usr/src/tools/depcheck/make_pkg_db

   1 #!/usr/bin/perl
   2 #
   3 # CDDL HEADER START
   4 #
   5 # The contents of this file are subject to the terms of the
   6 # Common Development and Distribution License, Version 1.0 only
   7 # (the "License").  You may not use this file except in compliance
   8 # with the License.
   9 #
  10 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  11 # or http://www.opensolaris.org/os/licensing.
  12 # See the License for the specific language governing permissions
  13 # and limitations under the License.
  14 #
  15 # When distributing Covered Code, include this CDDL HEADER in each
  16 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  17 # If applicable, add the following below this CDDL HEADER, with the
  18 # fields enclosed by brackets "[]" replaced with your own identifying
  19 # information: Portions Copyright [yyyy] [name of copyright owner]
  20 #
  21 # CDDL HEADER END
  22 #
  23 #
  24 # Copyright (c) 2000 by Sun Microsystems, Inc.
  25 # All rights reserved.
  26 #
  27
  28 # ident "%Z%%M% %I%     %E% SMI"
  29
  30 $PkgDir = "/var/sadm/pkg";      # where to find the pkg directories
  31 $PROGRAM_NAME = "make_pkg_db";
  32 $DBM_DIR_CHARACTERIZATION = "directory for the dbm databases";
  33 $INPUT_FILES_CHARACTERIZATION = "one or more files in /var/sadm/install/contents format";
  34 $PKGDEFS_DIRECTORY = "package pool directory";
  35
  36 $Usage =
  37 "Usage: $PROGRAM_NAME
  38   [-ifiles <$INPUT_FILES_CHARACTERIZATION>]
  39   [-pkgdef <$PKGDEFS_DIRECTORY>]
  40   -dbdir <$DBM_DIR_CHARACTERIZATION>
  41   [-h for help]\n";
  42
  43 $Help =
  44 "This program initializes a set of dbm databases with information
  45 from /var/sadm/install/contents or a user-defined package pool directory.
  46 There is one required argument:
  47
  48         -dbdir  <dir>                   the $DBM_DIR_CHARACTERIZATION
  49
  50 \nThe optional argument -h produces this message instead of any processing.
  51 \nThe optional argument -ifiles is used for symbolic link resolution.
  52 \nThe optional argument -pkgdef creates the databases based upon a package \npool directory instead of /var/sadm/install/contents on the local machine.
  53 ";
  54
  55
  56 #
  57 # check for perl5 -- we use things unavailable in perl4
  58 #
  59
  60 die "Sorry, this program requires perl version 5.000 or up. You have $]. Stopping" if $] < 5.000;
  61
  62 #
  63 # process arguments
  64 #
  65
  66 $PKGDefs = "";
  67
  68 while (@ARGV) {
  69     $arg = shift (@ARGV);
  70     if ($arg eq "-h") {
  71         print "$Help\n$Usage";
  72         exit 0;
  73     } elsif ($arg eq "-ifiles") {
  74         while (($ARGV[0] !~ /^-/) && (@ARGV)){
  75             push (@IFiles, shift(@ARGV));
  76         }
  77     } elsif ($arg eq "-dbdir") {
  78         $DBDir = shift(@ARGV) unless ($ARGV[0] =~ /^-/);
  79     } elsif ($arg eq "-pkgdef") {
  80         $PKGDefs = shift(@ARGV) unless ($ARGV[0] =~ /^-/);
  81     } else {
  82         print STDERR "Unrecognized argument $arg. \n$Usage";
  83         exit 1;
  84     }
  85 }
  86
  87 # make sure the package pool directory exists
  88 if (($PKGDefs) && !(-d $PKGDefs)) {
  89         print STDERR "Cannot open the directory $PKGDefs\n";
  90         exit 1;
  91 }
  92
  93 # Here we define the input files which will be parsed
  94 if ($PKGDefs) {
  95
  96         $dirs = `ls $PKGDefs`;
  97         @dirlist = split(/\s*\n\s*/, $dirs);
  98
  99         foreach $dir (@dirlist) {
 100                 push(@IFiles, "$PKGDefs/$dir/pkgmap");
 101         }
 102
 103         reverse(@IFiles);
 104 }
 105 else {
 106         push(@IFiles, "/var/sadm/install/contents");
 107 }
 108
 109 if (!@IFiles) {
 110     print STDERR "Required argument -ifiles missing. \n$Usage";
 111     exit 1;
 112 }
 113
 114 if (!$DBDir) {
 115     print STDERR "Required argument -dbdir missing. \n$Usage";
 116     exit 1;
 117 }
 118
 119 $Struct = \%struct;     # here is the structure we'll store everything in
 120
 121
 122
 123 #
 124 # now open the dbm databases we will initialize
 125 #
 126 &yelp ("...initializing the databases\n");
 127
 128 unless (-d "$DBDir") {
 129         &yelp("Creating directory $DBDir\n");
 130         mkdir($DBDir, 0777);
 131 }
 132
 133 # db for package names from the /var/sadm/pkg/foo/pkginfo files
 134 dbmopen(%PKGNAMES, "$DBDir/PKGNAMES", 0644) || die"Cannot open dbm db $DBDir/PKGNAMES\n";
 135
 136 # db for entity file types
 137 dbmopen(%FTYPE, "$DBDir/FTYPE", 0664) || die"Cannot open dbm db $DBDir/FTYPE\n";
 138
 139 # db for entity modes types
 140 dbmopen(%MODE, "$DBDir/MODE", 0664) || die"Cannot open dbm db $DBDir/MODE\n";
 141
 142 # db for entity packages
 143 dbmopen(%PKGS, "$DBDir/PKGS", 0664) || die"Cannot open dbm db $DBDir/PKGS\n";
 144
 145 # db for absolute link targets
 146 dbmopen(%ABSLINK, "$DBDir/ABSLINK", 0664) || die"Cannot open dbm db $DBDir/ABSLINK\n";
 147
 148
 149 undef %FTYPE;           # remove existing records, if any
 150 undef %MODE;
 151 undef %PKGS;
 152 undef %ABSLINK;
 153 undef %PKGNAMES;
 154
 155 $Debug = 1;                             # print extra gibberish
 156
 157 #
 158 # go make the package names db
 159 #
 160
 161 &MakePackageNamesDB($PkgDir);
 162
 163 #
 164 # read and parse each input file in contents file format
 165 #
 166
 167 &yelp ("...making the FTYPE MODE and PKGS databases\n");
 168 foreach $IFile (@IFiles) {
 169     if ($PKGDefs) {
 170        unless (-r $IFile) {
 171            print STDERR "Could not open file: $IFile\n";
 172            next;
 173        }
 174
 175        @pkgname = split("/", $IFile);
 176        $thisPkg = @pkgname[($#pkgname-1)];
 177        $pkgInfo="$PKGDefs/$thisPkg/pkginfo";
 178        $thisBaseDir="";
 179        if (-r $pkgInfo) {
 180             $BASEDIR = `grep '^BASEDIR' $pkgInfo`;
 181             $BASEDIR =~ s/^BASEDIR=//;
 182             chomp($BASEDIR);
 183             $thisBaseDir = $BASEDIR;
 184        }
 185     }
 186
 187     open (IFILE, "$IFile") || die "cannot open input file $IFile\n";
 188
 189     # Tell the user what we are looking at UNLESS they are looking at a package
 190     # pool.  A package pool could have hundreds of entries which just creates
 191     # a lot of useless (and confusing) output.
 192     &yelp("...opening $IFile\n") unless ($PKGDefs);
 193
 194     while (<IFILE>) {   # loop over file line-at-a-time
 195         if ($PKGDefs) {
 196                 next if /^:/;           # ignore these lines from a pkgmap
 197                 next if (/(\S+)\s+[i]\s+/);
 198         }
 199         else {
 200                 next if /^#/;           # ignore comments
 201                 next if /^\s*$/;        # ignore blanks
 202         }
 203
 204
 205         chop;
 206         undef $FType;
 207         undef $Mode;
 208
 209         $line=$_;
 210
 211         if ($PKGDefs) {
 212                 &ParsePkgmapEntry($line);
 213                 @Pkgs = $thisPkg;
 214         }
 215         else {
 216                 &ParseContentsEntry($_);
 217         }
 218
 219         # if this entry was supplied by a earlier file, skip it
 220
 221         if ($FTYPE{$Entity} =~ /\w/) {
 222
 223             # don't bother complaining about directories, we know the same
 224             # directory could exist in multiple packages
 225             next if ($FTYPE{$Entity} eq "d");
 226
 227             if ($PKGDefs) {
 228                  # In the case where we are going through a package pool, we
 229                  # expect that a file may reside in multiple packages.  If
 230                  # that is detected, we simply add this package to the list of
 231                  # packages for that file
 232
 233                  $currPkgs = $PKGS{$Entity};
 234 next if ($FTYPE{$Entity} eq "s");
 235                  $PKGS{$Entity} = "$currPkgs $thisPkg";
 236             }
 237             else {
 238                  # In the case where we are reading in from
 239                  # /var/sadm/install.contents, we do not expect to see any
 240                  # over-ridden files EXCEPT when the "-ifiles" option is used.
 241                  &yelp("...OVERRIDDEN: $line\n");
 242             }
 243             next;
 244         } else {
 245             $Package = join(" ",@Pkgs);# store supplying packages sep by " "
 246
 247             # This is a hack.  In the case of directories like /bin which
 248             # would belong in many packages, the $PKGS hash would not
 249             # be able to handle such a long entry.  So for directories, I
 250             # just place the first package I find.  For this tool, it doesn't
 251             # matter since this tool does not report which directories come
 252             # from which package.
 253
 254             if ($FType eq "d") {
 255                 @FirstPackage = split(" ", $Package);
 256                 $PKGS{$Entity} = $FirstPackage[0];
 257             }
 258             else {
 259                 $PKGS{$Entity} = $Package; # update PKGS database
 260             }
 261         }
 262
 263         #
 264         # put what we need from this entry line into the dbs
 265         #
 266
 267         &yelp ("***NO FILETYPE! IGNORING ENTRY: $_\n") unless $FType;
 268         $FTYPE{$Entity} = $FType;       # update the FTYPE database
 269
 270         #
 271         # now collect the possible paths for each basename
 272         #
 273
 274         ($path, $base) = $Entity =~ /(.*\/)(.*)/;
 275         push(@{$Struct->{"PATHS"}->{$base}}, $Entity);
 276         if ($FType =~ /[ls]/) {                 # link
 277             $rellinkent = "$Entity;$RelEntity";
 278             push (@RelLinkEnts,$rellinkent);    # make list of ents to resolve
 279         } else {
 280             $MODE{$Entity} = $Mode if $Mode ne "";      # update MODE database
 281         }
 282     }
 283     close IFILE;
 284 } # end foreach $IFile
 285
 286 #
 287 # now convert the relative links into absolute ones
 288 #
 289
 290 &yelp ("...making the ABSLINK database\n");
 291 foreach $rellinkent (@RelLinkEnts) {
 292     ($Entity, $RelEntity) = split(/;/, $rellinkent);
 293     $AbsLink = &GetAbsLink($Entity, $RelEntity);
 294     $ABSLINK{$Entity} = $AbsLink;
 295 }
 296
 297 #
 298 # close the dbs -- we're done
 299 #
 300
 301 dbmclose (FTYPE);
 302 dbmclose (MODE);
 303 dbmclose (PKGS);
 304 dbmclose (ABSLINK);
 305 dbmclose (PKGNAMES);
 306
 307 &yelp ("...DONE\n");
 308 #===========================END OF MAIN====================================
 309
 310 sub GetAbsLink {        # convert relative link to actual one
 311 local ($entry, $rellink) = @_;
 312
 313     return $rellink if $rellink =~ /^\//;       # just return if abs already
 314
 315     @RelPath = split(/\//,$rellink);
 316     @EntryPath = split(/\//,$entry);
 317
 318     #
 319     # get the filename part
 320     #
 321
 322     undef @AbsPath;
 323     @AbsPath = (pop(@RelPath)) if $RelPath[$#RelPath] =~ /w/;
 324     pop @EntryPath;
 325
 326     #
 327     # pop the relative path until a relative dir shows up
 328     #
 329
 330     while (@RelPath) {
 331         $relhere = pop(@RelPath);
 332         if ($relhere =~ /\w/) {                 # there's a letter or number
 333             unshift (@AbsPath, $relhere);       # its a dirname; keep it
 334         } elsif ($relhere =~ /^\.\.$/) {        # its a .. pop up one dir
 335             pop(@EntryPath);
 336         } elsif ($relhere =~ /^\.$/) {          # it's a . -- stop
 337             last;
 338         }
 339     }
 340
 341     while (@EntryPath) {                        # complete the path
 342         unshift(@AbsPath, pop(@EntryPath));     # ...from the remaining entry
 343     }
 344     $abspath = join("/", @AbsPath);
 345     if (!$FTYPE{$abspath}) {                    # no installed entity !
 346 # NICKI - for now
 347         &yelp("***CANNOT FIND ABSOLUTE PATH $abspath FOR ENTRY: $entry=$rellink\n");
 348 #       &yelp("***CANNOT RESOLVE ABSOLUTE PATH $abspath\n");
 349
 350 # COMMENTED OUT BY NICKI
 351 #       $base = $rellink;
 352 #       $base =~ s/.*\///;                      # get basename we're looking for
 353 #       @cans = @{$Struct->{"PATHS"}->{$base}}; # get all entities ...
 354 #       $numcans = $#cans + 1;                          # ... with this base
 355
 356 #       &yelp("   There are $numcans entries with this basename:\n");
 357 #       foreach $can (@cans) {
 358 #           &yelp("       $can\n");
 359 #       }
 360 #       $abspath = "";
 361     }
 362     return $abspath;
 363 }
 364
 365 sub ParseContentsEntry {
 366 #invocation: &ParseContentsEntry($l);   # $l is a line in the file
 367 local ($l) = @_;
 368
 369     #
 370     # look for b or c entries, like:
 371     #  /devices/pseudo/openeepr@0:openprom c none 38 0 0640 root sys SUNWcsd
 372     #
 373
 374     if (($Entity,$FType,$Class,$Maj,$Min,$Mode,$Owner,$Group,@Pkgs) =
 375       ($l =~ /^(\S+)\s+([bc])\s+(\w+)\s+([0-9]+)\s+([0-9]+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
 376
 377     #
 378     # look for d entries, like
 379     #   /devices/pseudo d none 0755 root sys SUNWcsd
 380     #
 381
 382     } elsif  (($Entity,$FType,$Class,$Mode,$Owner,$Group,@Pkgs) =
 383       ($l =~ /^(\S+)\s+([d])\s+(\w+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
 384
 385     #
 386     # look for f or e  or v entries, like
 387     #   /etc/asppp.cf f none 0744 root sys 360 27915 801314234 SUNWapppr
 388     #
 389
 390     } elsif  (($Entity,$FType,$Class,$Mode,$Owner,$Group,
 391       $Size,$Checksum,$Modtime,@Pkgs) =
 392       ($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].*)/)) {
 393
 394     #
 395     # look for l or s entries, like
 396     #   /bin=./usr/bin s none SUNWcsr
 397     #
 398
 399     } elsif  (($Entity,$RelEntity,$FType,$Class,@Pkgs) =
 400       ($l =~ /^([^=]+)=(\S+)\s+([ls])\s+(\w+)\s+([A-Z].*)/)) {
 401     } else {
 402         print STDERR "Unrecognized entry in $IFile: $l\n";
 403     }
 404 }
 405
 406 sub ParsePkgmapEntry {
 407 local ($line) = @_;
 408
 409         # for validation of input
 410         $Unresolved = true;
 411
 412         # look for d entries, like
 413         # 1 d root etc 775 root sys
 414
 415         if (($Part,$FType,$Class,$Entity,$Mode,$Owner,$Group) =
 416                 ($line =~ /^(\S+)\s+([d])\s+(\w+)\s+(\S+)\s+(\d+)\s+(\w+)\s+(\w+)/)) {
 417                 # prepend a install root
 418                 if ($thisBaseDir eq "/") {
 419                         $Entity = "/$Entity";
 420                 }
 421                 else {
 422                         $Entity = "$thisBaseDir/$Entity";
 423                 }
 424                 $Unresolved = false;
 425         }
 426
 427         # look for e,f or v entries, like
 428         # 1 e master boot/solaris/devicedb/master 0644 root sys 75 5775 940882596
 429
 430         elsif (($Part,$FType,$Class,$Entity,$Mode,$Owner,$Group,$Size,$Checksum,$Modtime) =
 431                 ($line =~ /^(\S+)\s+([efv])\s+(\w+)\s+(\S+)\s+(\d+)\s+(\w+)\s+(\w+)/)) {
 432
 433                 # prepend a install root
 434                 if ($thisBaseDir eq "/") {
 435                         $Entity = "/$Entity";
 436                 }
 437                 else {
 438                         $Entity = "$thisBaseDir/$Entity";
 439                 }
 440                 $Unresolved = false;
 441         }
 442         elsif  (($Part, $FType, $Class, $Entity, $RelEntity) =
 443                 ($line =~ /^(\S+)\s+([ls])\s+(\w+)\s+(\S+)[=](\S+)/)) {
 444
 445                 # prepend a install root
 446                 if ($thisBaseDir eq "/") {
 447                         $Entity = "/$Entity";
 448                 }
 449                 else {
 450                         $Entity = "$thisBaseDir/$Entity";
 451                 }
 452                 $Unresolved = false;
 453         }
 454
 455         print ("UNRESOLVED: $line\n") if ($Unresolved eq true);
 456 }
 457
 458 sub ParsePrototypeEntry {
 459 #invocation: &ParsePrototypeEntry($l);  # $l is a line in the file
 460 local ($l) = @_;
 461
 462     #
 463     # look for b or c entries, like:
 464     #  /devices/pseudo/openeepr@0:openprom c none 38 0 0640 root sys SUNWcsd
 465     #
 466
 467     if (($Entity,$FType,$Class,$Maj,$Min,$Mode,$Owner,$Group,@Pkgs) =
 468       ($l =~ /^(\S+)\s+([bc])\s+(\w+)\s+([0-9]+)\s+([0-9]+)\s+([0-7]+)\s+([a-z]+)\s+([a-z]+)\s+([A-Z].*)/)) {
 469
 470     #
 471     # look for d entries, like
 472     #   d root etc 775 root sys
 473     #
 474
 475     } elsif  (($FType,$Class,$Entity,$Mode,$Owner,$Group) =
 476       ($l =~ /^([d])\s+(\w+)\s+(\S+)\s+([0-7]+)\s+(\w+)\s+(\w+)/)) {
 477
 478     #
 479     # look for f or e  or v entries, like
 480     #   e preserve etc/acct/holidays 664 bin bin
 481     #
 482
 483     } elsif  (($FType,$Class,$Entity,$Mode,$Owner,$Group) =
 484       ($l =~ /^([fev])\s+(\w+)\s+(\S+)\s+([0-7]+)\s+(\w+)\s+(\w+)/)) {
 485
 486     #
 487     # look for l or s entries, like
 488     #   l root etc/rc2.d/S21perf=../../etc/init.d/perf
 489     #
 490
 491     } elsif  (($FType,$Class,$Entity,$RelEntity) =
 492       ($l =~ /^([ls])\s+(\w+)\s+([^=]+)=(\S+)/)) {
 493     } else {
 494         print STDERR "Unrecognized Prototype File entry: $l\n";
 495     }
 496 }
 497
 498 sub yelp {
 499 local($String) = @_;
 500     print "$String";
 501 }
 502
 503
 504
 505 sub MakePackageNamesDB  {
 506 #invocation: &MakePackageNamesDB($PkgDir);
 507 local ($PkgDir) = @_;           # argument is parent directory of pkg dirs
 508
 509     #$PkgDir = "/var/sadm/pkg";
 510     opendir(PKGDIR, "$PkgDir") || die "Cannot open package directory $PkgDir\n";
 511     @Pkgs = grep(/^[A-Z]/,readdir(PKGDIR));     # list of all package directories
 512     foreach $Pkg (@Pkgs) {      # loop over 'em
 513         $InfoFile = "$PkgDir/$Pkg/pkginfo";     # full name of the pkginfo file
 514         if (-r $InfoFile) {     # if we can read it
 515             $str = `grep '^NAME=' $InfoFile`;   # just grep the entry
 516             $str =~ s/\s*\n$//; # trim trailing ws
 517             $str =~ s/.*=\s*//; # trim leading NAME=
 518             if ($str =~ /\w/) { # if the name has a letter or number in it
 519                 $PKGNAMES{$Pkg} = $str;
 520             } else {
 521                 &yelp("***Cannot find usable NAME entry in $InfoFile\n");
 522             }
 523         } else {
 524             &yelp("***Cannot find readable file $InfoFile\n");
 525         }
 526     } # end of loop over package directories
 527 }