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 67use strict; 68 69my ($opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b); 70my ($keywords, @exclude); 71 72sub 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 79sub 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 129sub 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. 141my $arg, $opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b; 142while ($#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 177if (@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 184my $file; 185 186if ($#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 204exit 0 205