xref: /titanic_50/usr/src/tools/depcheck/make_pkg_db (revision c77a61a72b5ecdc507d6cf104142edd371a16c84) 
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
45from /var/sadm/install/contents or a user-defined package pool directory.
46There 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
60die "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
68while (@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
88if (($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
94if ($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}
105else {
106	push(@IFiles, "/var/sadm/install/contents");
107}
108
109if (!@IFiles) {
110    print STDERR "Required argument -ifiles missing. \n$Usage";
111    exit 1;
112}
113
114if (!$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
128unless (-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
134dbmopen(%PKGNAMES, "$DBDir/PKGNAMES", 0644) || die"Cannot open dbm db $DBDir/PKGNAMES\n";
135
136# db for entity file types
137dbmopen(%FTYPE, "$DBDir/FTYPE", 0664) || die"Cannot open dbm db $DBDir/FTYPE\n";
138
139# db for entity modes types
140dbmopen(%MODE, "$DBDir/MODE", 0664) || die"Cannot open dbm db $DBDir/MODE\n";
141
142# db for entity packages
143dbmopen(%PKGS, "$DBDir/PKGS", 0664) || die"Cannot open dbm db $DBDir/PKGS\n";
144
145# db for absolute link targets
146dbmopen(%ABSLINK, "$DBDir/ABSLINK", 0664) || die"Cannot open dbm db $DBDir/ABSLINK\n";
147
148
149undef %FTYPE;		# remove existing records, if any
150undef %MODE;
151undef %PKGS;
152undef %ABSLINK;
153undef %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");
168foreach $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};
234next 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");
291foreach $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
301dbmclose (FTYPE);
302dbmclose (MODE);
303dbmclose (PKGS);
304dbmclose (ABSLINK);
305dbmclose (PKGNAMES);
306
307&yelp ("...DONE\n");
308#===========================END OF MAIN====================================
309
310sub GetAbsLink {	# convert relative link to actual one
311local ($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
365sub ParseContentsEntry {
366#invocation: &ParseContentsEntry($l);	# $l is a line in the file
367local ($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
406sub ParsePkgmapEntry {
407local ($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
458sub ParsePrototypeEntry {
459#invocation: &ParsePrototypeEntry($l);	# $l is a line in the file
460local ($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
498sub yelp {
499local($String) = @_;
500    print "$String";
501}
502
503
504
505sub MakePackageNamesDB  {
506#invocation: &MakePackageNamesDB($PkgDir);
507local ($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}
528