#! /usr/bin/perl -ws # # Copyright (C) 2004 Internet Systems Consortium, Inc. ("ISC") # Copyright (C) 2000, 2001 Internet Software Consortium. # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH # REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY # AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, # INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM # LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # PERFORMANCE OF THIS SOFTWARE. # $Id: check-sources.pl,v 1.7.206.1 2004/03/06 13:16:22 marka Exp $ # Rudimentary, primarily for use by the developers. # This just evolved with no serious attempt at making it # bulletproof or foolproof. Or pretty even. Probably would # have done it differently if it were actually designed as opposed # to just growing as a multi-tentacled thing as various messages # were either added or selectively silenced. use strict; use vars qw($help $debug); sub sortdir() { if (-d $::a) { if (-d $::b) { return ($::a cmp $::b); } else { return (-1); } } elsif (-d $::b) { return (1); } else { return ($::a cmp $::b); } } sub do_dir($$) { my($predir, $dir) = @_; my $newdir = $predir ne "" ? "$predir/$dir" : $dir; print "================> $newdir\n"; unless (chdir("$dir")) { print "cd $newdir: $1\n"; return; } unless (opendir(DIR, ".")) { print "opendir $predir/$dir: $!\n"; return; } foreach my $entry (sort sortdir readdir(DIR)) { next if $entry =~ /^\.\.?$/; if (-d $entry) { do_dir($newdir, $entry); next; } next if $entry !~ /\.o$/; do_file($entry); } closedir(DIR); chdir("..") or die "major malfunction: can't chdir to parent dir: $!\n"; print "================> $predir\n"; } sub do_file($) { my $objfile = $_[0]; my ($file, $savesource, $saveobj); my ($config_h, $cpp_if, $prefix, $elided, $comment, $prefix_extend, $body); unless ($objfile =~ /\.o$/) { print "$0: skipping non-object file $objfile\n"; return; } ($file = $objfile) =~ s%\.o$%.c%; ($savesource = $file) =~ s%$%.save%; ($saveobj = $objfile) =~ s%$%.save%; if (-f $savesource) { print "$savesource exists, skipping\n"; return; } unless (-f $file) { print "$file does not exist, skipping\n"; return; } rename($file, $savesource); rename($objfile, $saveobj); open(SOURCE, "< $savesource"); $_ = join('', ); close(SOURCE); $prefix = ''; print "$file begin\n" if $debug; while (1) { eval { # Note that only '#include <...>' is checked, not '#include "..."'. # 1 23 4 5 6 78 if (m%(\A\Q$prefix\E((.*\n)*?))(\#include\s+(<.*?>)(.*)\n)((.*\n)*)%) { $elided = $5; $prefix_extend = $2 . $4; $comment = $6; $body = $1 . $7; } else { print "$file end\n" if $debug; $elided = ""; # stop processing this file. } }; if ($@ ne "") { print "$file processing failed: $@\n"; last; } last if $elided eq ""; print STDERR "$file checking $elided\n" if $debug; if (! $config_h) { $config_h = 1; if ($elided ne "") { print "$file should include before any other\n"; } } # Always required. next if $elided eq ""; # Can mark in the header file when a #include should stay even # though it might not appear that way otherwise. next if $comment =~ /require|provide|extend|define|contract|explicit/i; if ($elided eq "") { next if m%snprintf%m; } open(SOURCE, "> $file"); print SOURCE "$body"; close(SOURCE); print "$file elided $elided, compiling\n" if $debug; if (compile($objfile) == 0) { if (! defined($cpp_if)) { $cpp_if = /^#if/m; print "$file has CPP #if(def), doublecheck elision recommendations.\n" if $cpp_if; } print "$file does not need $elided\n"; } elsif ($elided eq "") { print "$file prefer to \n"; } } continue { $prefix .= $prefix_extend; } rename($savesource, $file); rename($saveobj, $objfile); } sub compile($) { my $obj = $_[0]; unless ($obj =~ /\.o$/) { warn "$obj: not a .o object file\n"; return; } my $output = $debug ? "/dev/tty" : "/dev/null"; open(COMPILE, "make -e $obj 2>&1 >$output |"); my $stderr_lines = join('', ); print $stderr_lines if $debug; close(COMPILE); unlink($obj); return ($stderr_lines ne ""); } sub main() { $| = 1; $0 =~ s%.*/%%; die "Usage: $0 [-debug]\n" if $help; unless (-f 'configure' && -f 'Makefile') { die "$0: run from top of bind9 source tree, after configure has run\n"; } print "========================\n"; print "building initial objects\n"; print "========================\n"; # XXX bleah unless (system("make") == 0) { die "make all failed, couldn't be sure all objects were generated.\n"; } unless (system("cd bin/tests && make -k all_tests") == 0) { warn "make all_tests failed, but pressging on anyway\n"; } print <