Home | History | Annotate | Download | only in scripts
      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 2003 Sun Microsystems, Inc.  All rights reserved.
     25 # Use is subject to license terms.
     26 #
     27 #ident	"%Z%%M%	%I%	%E% SMI"
     28 
     29 # Given either a list of files containing paths on the command line or
     30 # a set of paths on standard input, validate that the paths actually
     31 # exist, and complain if they do not.  This is invoked by nightly to
     32 # verify the contents of various control files used by the ON build
     33 # process.
     34 #
     35 # Command line options:
     36 #
     37 #	-m	Show the matches (for debug).
     38 #
     39 #	-r	Allow shell globs in the paths.  Unless otherwise
     40 #		flagged by a keyword (see -k) or exclusion (see -e),
     41 #		it is an error if no files match the expression at
     42 #		all.
     43 #
     44 #	-s/from/to/
     45 #		Perform a substitution on all of the paths in the
     46 #		file.  This substitution is performed after stripping
     47 #		any in-line comments but before any exclusion matching
     48 #		is done.  The option may include any legal Perl
     49 #		substitution expression and may be repeated to give
     50 #		multiple expressions.
     51 #
     52 #	-e <pattern>
     53 #		Exclude paths matching the given pattern from the
     54 #		"must exist" rule.  These paths will not be checked.
     55 #		Option may include any legal Perl regular expression,
     56 #		and may be repeated to give multiple patterns.
     57 #
     58 #	-k <keyword>
     59 #		Exclude paths if there is either an in-line comment
     60 #		containing the given keyword, or the preceding line
     61 #		consists of only a comment containing that keyword.
     62 #		Option may be repeated to provide multiple keywords.
     63 #
     64 #	-b <base>
     65 #		Base directory for relative paths tested.
     66 
     67 use strict;
     68 
     69 my ($opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b);
     70 my ($keywords, @exclude);
     71 
     72 sub usage {
     73     die "usage: $0 [-r] [-m]\n",
     74     "\t[-s/from/to/] [-e <pattern>] [-k <keyword>] [-b <base>]\n",
     75     "\t[files...]\n";
     76 }
     77 
     78 # process the path list in a given file
     79 sub process_paths {
     80     my ($FILE, $name) = @_;
     81     my ($ignore, $file, $line);
     82     $ignore = 0;
     83     $line = 0;
     84     while (<$FILE>) {
     85 	chomp;
     86 	$line++;
     87 	# Ignore comment lines
     88 	if (/^\s*#(.*)$/) {
     89 	    $ignore = ($1 =~ /$keywords/) if defined $keywords;
     90 	    next;
     91 	}
     92 	# Extract path as $1 from line
     93 	if (/^\s*([^#]+)#(.*)$/) {
     94 	    ($ignore = 0, next) if $ignore;
     95 	    $ignore = ($2 =~ /$keywords/) if defined $keywords;
     96 	    ($ignore = 0, next) if $ignore;
     97 	} elsif (/^\s*([^#]+)$/) {
     98 	    ($ignore = 0, next) if $ignore;
     99 	} else {
    100 	    # Ignore blank lines
    101 	    $ignore = 0;
    102 	    next;
    103 	}
    104 	# remove any trailing spaces from path
    105 	($file = $1) =~ s/[	 ]*$//;
    106 	# perform user-supplied substitutions
    107 	foreach my $pat (@opt_s) {
    108 	    eval '$file =~ s' . $pat;
    109 	}
    110 	# check if the given path is on the 'exclude' list
    111 	$ignore = 0;
    112 	foreach my $pat (@exclude) {
    113 	    ($ignore = 1, last) if $file =~ /$pat/;
    114 	}
    115 	if ($ignore == 0) {
    116 	    # construct the actual path to the file
    117 	    my $path = $opt_b . $file;
    118 	    # Expand any shell globs, if that feature is on.  Since
    119 	    # Perl's glob() is stateful, we use an array assignment
    120 	    # to get the first match and discard the others.
    121 	    ($path) = glob($path) if $opt_r;
    122 	    print "$name:$line: $file\n" unless !$opt_m && -e $path;
    123 	    print "  $path\n" if $opt_m;
    124 	}
    125 	$ignore = 0;
    126     }
    127 }
    128 
    129 sub next_arg {
    130     my ($arg) = @_;
    131     if ($arg eq "") {
    132 	die "$0: missing argument for $_\n" if $#ARGV == -1;
    133 	$arg = shift @ARGV;
    134     }
    135     $arg;
    136 }
    137 
    138 # I'd like to use Perl's getopts here, but it doesn't handle repeated
    139 # options, and using comma separators is just too ugly.
    140 # This doesn't handle combined options (as in '-rm'), but I don't care.
    141 my $arg, $opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b;
    142 while ($#ARGV >= 0) {
    143     $_ = $ARGV[0];
    144     last if /^[^-]/;
    145     shift @ARGV;
    146     last if /^--$/;
    147     SWITCH: {
    148 	  /^-r/ && do { $opt_r = 1; last SWITCH; };
    149 	  /^-m/ && do { $opt_m = 1; last SWITCH; };
    150 	  if (/^-s(.*)$/) {
    151 	      $arg = next_arg($1);
    152 	      push @opt_s, $arg;
    153 	      last SWITCH;
    154 	  }
    155 	  if (/^-e(.*)$/) {
    156 	      $arg = next_arg($1);
    157 	      push @opt_e, $arg;
    158 	      last SWITCH;
    159 	  }
    160 	  if (/^-k(.*)$/) {
    161 	      $arg = next_arg($1);
    162 	      push @opt_k, $arg;
    163 	      last SWITCH;
    164 	  }
    165 	  if (/^-b(.*)$/) {
    166 	      $opt_b = next_arg($1);
    167 	      last SWITCH;
    168 	  }
    169 	  print "$0: unknown option $_\n";
    170 	  usage();
    171     }
    172 }
    173 
    174 # compile the 'exclude' regexps
    175 @exclude = map qr/$_/x, @opt_e;
    176 # if no keywords are given, then leave $keywords undefined
    177 if (@opt_k) {
    178     # construct a regexp that matches the keywords specified
    179     my $opt_k = join("|", @opt_k);
    180     $keywords = qr/($opt_k)/xo;
    181 }
    182 $opt_b .= "/" if $opt_b =~ /[^\/]$/;
    183 
    184 my $file;
    185 
    186 if ($#ARGV < 0) {
    187     process_paths(\*STDIN, "standard input");
    188 } else {
    189     foreach $file (@ARGV) {
    190 	if (! -e $file) {
    191 	    warn "$0: $file doesn't exist\n";
    192 	} elsif (! -f $file) {
    193 	    warn "$0: $file isn't a regular file\n";
    194 	} elsif (! -T $file) {
    195 	    warn "$0: $file isn't a text file\n";
    196 	} elsif (open FILE, "<$file") {
    197 	    process_paths(\*FILE, $file);
    198 	} else {
    199 	    warn "$0: $file: $!\n";
    200 	}
    201     }
    202 }
    203 
    204 exit 0
    205