xref: /titanic_41/usr/src/tools/scripts/validate_paths.pl (revision bbaa8b60dd95d714741fc474adad3cf710ef4efd)
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 (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27
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#	-n <name>
68#		String to use in place of file name when using stdin
69
70use strict;
71
72my ($opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b, $opt_n);
73my ($keywords, @exclude);
74
75sub usage {
76    die "usage: $0 [-r] [-m]\n",
77    "\t[-s/from/to/] [-e <pattern>] [-k <keyword>] [-b <base>]\n",
78    "\t[-n <name> ] [files...]\n";
79}
80
81# process the path list in a given file
82sub process_paths {
83    my ($FILE, $name) = @_;
84    my ($ignore, $file, $line);
85    $ignore = 0;
86    $line = 0;
87    while (<$FILE>) {
88	chomp;
89	$line++;
90	# Ignore comment lines
91	if (/^\s*#(.*)$/) {
92	    $ignore = ($1 =~ /$keywords/) if defined $keywords;
93	    next;
94	}
95	# Extract path as $1 from line
96	if (/^\s*([^#]+)#(.*)$/) {
97	    ($ignore = 0, next) if $ignore;
98	    $ignore = ($2 =~ /$keywords/) if defined $keywords;
99	    ($ignore = 0, next) if $ignore;
100	} elsif (/^\s*([^#]+)$/) {
101	    ($ignore = 0, next) if $ignore;
102	} else {
103	    # Ignore blank lines
104	    $ignore = 0;
105	    next;
106	}
107	# remove any trailing spaces from path
108	($file = $1) =~ s/[	 ]*$//;
109	# perform user-supplied substitutions
110	foreach my $pat (@opt_s) {
111	    eval '$file =~ s' . $pat;
112	}
113	# check if the given path is on the 'exclude' list
114	$ignore = 0;
115	foreach my $pat (@exclude) {
116	    ($ignore = 1, last) if $file =~ /$pat/;
117	}
118	if ($ignore == 0) {
119	    # construct the actual path to the file
120	    my $path = $opt_b . $file;
121	    # Expand any shell globs, if that feature is on.  Since
122	    # Perl's glob() is stateful, we use an array assignment
123	    # to get the first match and discard the others.
124	    ($path) = glob($path) if $opt_r;
125	    print "$name:$line: $file\n" unless !$opt_m && -e $path;
126	    print "  $path\n" if $opt_m;
127	}
128	$ignore = 0;
129    }
130}
131
132sub next_arg {
133    my ($arg) = @_;
134    if ($arg eq "") {
135	die "$0: missing argument for $_\n" if $#ARGV == -1;
136	$arg = shift @ARGV;
137    }
138    $arg;
139}
140
141# I'd like to use Perl's getopts here, but it doesn't handle repeated
142# options, and using comma separators is just too ugly.
143# This doesn't handle combined options (as in '-rm'), but I don't care.
144my $arg, $opt_r, $opt_m, @opt_s, @opt_e, @opt_k, $opt_b, $opt_n;
145while ($#ARGV >= 0) {
146    $_ = $ARGV[0];
147    last if /^[^-]/;
148    shift @ARGV;
149    $opt_n = "standard input";
150    last if /^--$/;
151    SWITCH: {
152	  /^-r/ && do { $opt_r = 1; last SWITCH; };
153	  /^-m/ && do { $opt_m = 1; last SWITCH; };
154	  if (/^-s(.*)$/) {
155	      $arg = next_arg($1);
156	      push @opt_s, $arg;
157	      last SWITCH;
158	  }
159	  if (/^-e(.*)$/) {
160	      $arg = next_arg($1);
161	      push @opt_e, $arg;
162	      last SWITCH;
163	  }
164	  if (/^-k(.*)$/) {
165	      $arg = next_arg($1);
166	      push @opt_k, $arg;
167	      last SWITCH;
168	  }
169	  if (/^-b(.*)$/) {
170	      $opt_b = next_arg($1);
171	      last SWITCH;
172	  }
173	  if (/^-n(.*)$/) {
174	      $opt_n = next_arg($1);
175	      last SWITCH;
176	  }
177	  print "$0: unknown option $_\n";
178	  usage();
179    }
180}
181
182# compile the 'exclude' regexps
183@exclude = map qr/$_/x, @opt_e;
184# if no keywords are given, then leave $keywords undefined
185if (@opt_k) {
186    # construct a regexp that matches the keywords specified
187    my $opt_k = join("|", @opt_k);
188    $keywords = qr/($opt_k)/xo;
189}
190$opt_b .= "/" if $opt_b =~ /[^\/]$/;
191
192my $file;
193
194if ($#ARGV < 0) {
195    process_paths(\*STDIN, $opt_n);
196} else {
197    foreach $file (@ARGV) {
198	if (! -e $file) {
199	    warn "$0: $file doesn't exist\n";
200	} elsif (! -f $file) {
201	    warn "$0: $file isn't a regular file\n";
202	} elsif (! -T $file) {
203	    warn "$0: $file isn't a text file\n";
204	} elsif (open FILE, "<$file") {
205	    process_paths(\*FILE, $file);
206	} else {
207	    warn "$0: $file: $!\n";
208	}
209    }
210}
211
212exit 0
213