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 }