find-build-errors revision 970
493N/A#! /usr/perl5/bin/perl -w
493N/A
493N/A#
970N/A# Copyright (c) 2008, 2010, Oracle and/or its affiliates. All rights reserved.
493N/A#
493N/A# Permission is hereby granted, free of charge, to any person obtaining a
919N/A# copy of this software and associated documentation files (the "Software"),
919N/A# to deal in the Software without restriction, including without limitation
919N/A# the rights to use, copy, modify, merge, publish, distribute, sublicense,
919N/A# and/or sell copies of the Software, and to permit persons to whom the
919N/A# Software is furnished to do so, subject to the following conditions:
919N/A#
919N/A# The above copyright notice and this permission notice (including the next
919N/A# paragraph) shall be included in all copies or substantial portions of the
919N/A# Software.
919N/A#
919N/A# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
919N/A# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
919N/A# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
919N/A# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
919N/A# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
919N/A# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
919N/A# DEALINGS IN THE SOFTWARE.
493N/A#
493N/A#
493N/A
493N/Arequire 5.005; # minimal Perl version required
493N/Ause strict; #
493N/Ause diagnostics; #
493N/Ause File::Spec; # pathname manipulation routines
493N/Ause File::stat; # Named results from stat() function
493N/Ause English qw( -nomatchvars );
493N/A
493N/Amy $default_logfile = 'buildit-XW';
970N/A# Log file from new pkg(5) build (in same directory as $default_logfile)
970N/Amy $default_ips_pkglogfile = 'make-pkgs';
970N/A# Log file from old SVR4 package build:
493N/Amy $default_logpath = 'log/' . $default_logfile;
970N/Amy $default_svr4_pkglogpath = 'proto-packages/logs/package_build';
493N/Amy $logfile;
493N/Amy $pkglog;
970N/Amy $pkglog_type; # 'ips' or 'svr4'
493N/Amy $pkgfailed;
970N/Amy $summary_only = 0;
970N/A
970N/Aif (defined $ARGV[0] && $ARGV[0] eq '-s') {
970N/A $summary_only = 1;
970N/A shift @ARGV;
970N/A}
493N/A
493N/Aif (defined $ARGV[0]) {
493N/A if (-d $ARGV[0]) {
493N/A $logfile = $ARGV[0] . '/' . $default_logpath;
970N/A } elsif ($ARGV[0] =~ m{/make-pkgs$}ms) {
970N/A $pkglog = $ARGV[0];
970N/A $pkglog_type = 'ips';
970N/A } elsif ($ARGV[0] =~ m{/check-pkgs$}ms) {
970N/A $pkglog = $ARGV[0];
970N/A $pkglog_type = 'validate';
493N/A } elsif ($ARGV[0] =~ m{/package_build$}ms) {
493N/A $pkglog = $ARGV[0];
970N/A $pkglog_type = 'svr4';
493N/A } else {
493N/A $logfile = $ARGV[0];
493N/A }
493N/A} elsif ( -f $default_logfile ) {
493N/A $logfile = $default_logfile;
493N/A} elsif ( -f $default_logpath ) {
493N/A $logfile = $default_logpath;
493N/A} else {
493N/A my @dirtree = File::Spec->splitdir(
493N/A File::Spec->rel2abs(File::Spec->curdir()));
493N/A
493N/A # climb the tree, removing one parent at a time to find the logfile
493N/A while (scalar(@dirtree) > 0) {
493N/A $logfile = File::Spec->catfile( @dirtree, $default_logpath);
493N/A last if ( -f $logfile);
493N/A# print "$logfile not found\n";
493N/A pop @dirtree;
493N/A }
493N/A
493N/A if (scalar(@dirtree) == 0) {
493N/A die "$default_logfile not found, please specify path to log\n";
493N/A }
493N/A}
493N/A
493N/Aif (defined $logfile) {
970N/A my $make_errors = 0;
970N/A my $LOGFILE = check_make_log($logfile, \$make_errors);
970N/A
970N/A print "Build errors: ", $make_errors, "\n";
970N/A
970N/A my $printme = 0;
970N/A
970N/A # end of file stuff
970N/A while (my $l = <$LOGFILE>) {
970N/A if ($l =~ m{^Runtime: }) {
970N/A print $l;
970N/A next;
970N/A }
970N/A
970N/A # Look for package build results
970N/A if ($l =~ m{^result log is in (\S*)$}ims) {
970N/A $pkglog = $1;
970N/A if ($1 =~ m{/package_build$}ms) {
970N/A $pkglog_type = 'svr4';
970N/A } else {
970N/A $pkglog_type = 'ips';
970N/A }
970N/A } elsif ($l =~ m{^Packages built:}ms) {
970N/A print $l;
970N/A } elsif ($l =~ m{^Package.* failed:\s+(\d+)}ms) {
970N/A $pkgfailed = $1;
970N/A print $l;
970N/A }
970N/A # print lines where messages about COPYING file errors appear
970N/A # between "Copying package descriptions" & "Building packages"
970N/A elsif ($l =~ m{Copying package descriptions}) {
970N/A $printme = 1;
970N/A } elsif ($l =~ m{Building packages}) {
970N/A $printme = 0;
970N/A }
970N/A elsif ($printme == 1) {
970N/A print $l;
970N/A }
970N/A }
970N/A print "\n";
970N/A
970N/A close($LOGFILE);
970N/A}
970N/A
970N/A# Input: string containing name of logfile
970N/A# Prints errors from make output log
970N/A# Returns open log file pointer for post-processing
970N/Asub check_make_log {
970N/A my ($logfile, $error_count_ref) = @_;
970N/A
493N/A open my $LOGFILE, '<', $logfile
493N/A or die "Can't open '$logfile': $OS_ERROR";
493N/A
493N/A print "Scanning $logfile for error messages...\n\n";
493N/A
493N/A my @steplines;
493N/A my $found_error = 0;
970N/A my $error_count = 0;
493N/A
493N/A while (my $l = <$LOGFILE>) {
493N/A # Finished if we see the end line
493N/A last if $l =~ m{Finished building the X Window System Consolidation}ms;
493N/A
493N/A # Clear saved lines for each new module/subdir
493N/A if (($l =~ m{^\#\# making \S+ in \S+\.\.\.$}ms) || # open-src pattern
810N/A ($l =~ m{^dmake: Warning: Target `subdirs' not remade because of errors}ms) ||
970N/A ($l =~ m{^\#\# [[:upper:]][[:lower:]]+ing }ms) || # pkg pattern
493N/A ($l =~ m{^\S+ing( \S+)* in \S+\.\.\.$}ms)) { # xc pattern
493N/A @steplines = ();
493N/A $found_error = 0;
493N/A }
493N/A
493N/A # If we already hit an error, skip the rest of this module
493N/A next if ($found_error != 0);
493N/A
493N/A # Add this line to the saved output, combine with previous if previous
493N/A # ended with an \
493N/A if (($#steplines >= 0) && ($steplines[$#steplines] =~ m{\\\Z}ms)) {
493N/A $steplines[$#steplines] .= $l;
493N/A } else {
493N/A push @steplines, $l;
493N/A }
493N/A
493N/A # Skip ahead to next line if this line ends with \
493N/A next if ($l =~ m{\\\Z}ms);
493N/A
493N/A # Found a new error?
970N/A if (($l =~ m{\*\*\* }ms) || ($l =~ m{^(d)?make: Fatal error}ms)) {
493N/A $found_error = 1;
970N/A $error_count++;
970N/A
970N/A next if ($summary_only);
493N/A
493N/A # Print section header
493N/A print $steplines[0], "\n";
493N/A
493N/A my $lastmake;
493N/A my $lastcommand = 1;
493N/A my $lastplus = 0;
493N/A
493N/A # scan back to figure out how far back to print
493N/A for my $ln (1..($#steplines - 1)) {
493N/A my $sl = $steplines[$ln];
493N/A
493N/A # print "lastmake: $lastmake, lastcom: $lastcommand, lastplus: $lastplus, line #$ln: $sl\n";
810N/A if ($sl =~ m{\b(make|dmake|gmake)\b}ms) {
493N/A $lastmake = $ln;
493N/A }
493N/A
493N/A if ($sl =~ m{\breturned\b}ms) {
493N/A # don't treat this as a command
810N/A } elsif ($sl =~ m{\b(cc|gcc|CC|g\+\+|ld|gpatch|libtool|GEN|CCLD)\s+}ms) {
493N/A if ($sl !~ m{usage:}) {
493N/A $lastcommand = $ln;
493N/A }
493N/A } elsif ($sl =~ m{^\+ }ms) {
493N/A # print from start of shell's set -x output, not end
493N/A if ($lastplus != ($ln - 1)) {
493N/A $lastcommand = $ln;
493N/A }
493N/A $lastplus = $ln;
493N/A } elsif ($lastplus == ($ln - 1)) {
493N/A $lastcommand = $ln;
493N/A }
493N/A }
493N/A
493N/A # print "lastmake: $lastmake, lastcommand: $lastcommand\n";
493N/A if ($lastmake && ($lastmake < $lastcommand)) {
493N/A print $steplines[$lastmake];
493N/A }
493N/A
493N/A for my $ln ($lastcommand..$#steplines) {
493N/A print $steplines[$ln];
493N/A }
493N/A print "\n", '-'x78, "\n";
493N/A }
493N/A }
493N/A
970N/A if (defined $error_count_ref) {
970N/A ${$error_count_ref} = $error_count;
493N/A }
493N/A
970N/A return $LOGFILE;
493N/A}
493N/A
493N/Asub check_pkglog {
493N/A my ($pl) = @_;
493N/A
493N/A if ( -f $pl ) {
493N/A my $logfile_sb = stat($logfile);
493N/A my $pkglog_sb = stat($pl);
493N/A
970N/A if ($logfile_sb->mtime > $pkglog_sb->mtime) {
493N/A # Haven't rebuilt packages since last build, so no point reporting errors
493N/A undef $pl;
493N/A }
493N/A } else {
493N/A undef $pl;
493N/A }
493N/A
493N/A return $pl;
493N/A}
493N/A
493N/A# No packaging log found in build log, try to guess where it is
493N/Aif (!defined($pkglog)) {
493N/A my $path_to_check = $logfile;
970N/A $path_to_check =~ s{$default_logfile}{$default_ips_pkglogfile}ms;
493N/A
493N/A $pkglog = check_pkglog($path_to_check);
493N/A
970N/A if (defined($pkglog)) {
970N/A $pkglog_type = 'ips';
970N/A } else {
970N/A $pkglog_type = 'svr4';
970N/A
493N/A $path_to_check = $logfile;
970N/A $path_to_check =~ s{$default_logpath}{$default_svr4_pkglogpath}ms;
493N/A
493N/A $pkglog = check_pkglog($path_to_check);
970N/A if (!defined($pkglog)) {
970N/A $path_to_check = $logfile;
970N/A $path_to_check =~ s{($default_logpath).*$}{$default_svr4_pkglogpath}ms;
970N/A
970N/A $pkglog = check_pkglog($path_to_check);
970N/A }
493N/A }
493N/A}
493N/A
970N/A
493N/Aif ((!defined($pkgfailed) || ($pkgfailed > 0)) && defined($pkglog)) {
970N/A if ($pkglog_type eq 'svr4') {
970N/A open my $PKGLOG, '<', $pkglog
970N/A or die "Can't open '$pkglog': $OS_ERROR";
970N/A
970N/A my @pkglines;
970N/A
970N/A while (my $l = <$PKGLOG>) {
970N/A # Clear saved lines for each new package
970N/A if ($l =~ m{^[*]+ Making the \S+ package [*]+$}ms) {
970N/A @pkglines = ();
970N/A }
970N/A
970N/A # Warnings we can ignore
970N/A next if $l =~ m{^WARNING: parameter \<PSTAMP\> set}ms;
970N/A next if $l =~ m{^WARNING: parameter \<CLASSES\> set to "none"}ms;
970N/A
970N/A push @pkglines, $l;
493N/A
970N/A if (($l =~ m{(Packaging was not successful.|was not found ; skipping)}ms)
970N/A || ($l =~ m{^WARNING: }ms)) {
970N/A print join('', @pkglines);
970N/A @pkglines = ();
970N/A }
970N/A }
970N/A close($PKGLOG);
970N/A } elsif ($pkglog_type eq 'ips') {
970N/A my $ips_count_errors = 0;
970N/A my $PKGLOG = check_make_log($pkglog, \$ips_count_errors);
493N/A
970N/A seek($PKGLOG, 0, 0); # reset to start reading from beginning of file
970N/A
970N/A my $ips_count_published = 0;
970N/A
970N/A while (my $l = <$PKGLOG>) {
970N/A if ($l =~ m{Publishing .* to proto repository}) {
970N/A $ips_count_published++;
970N/A }
493N/A }
493N/A
970N/A print "Packages published: $ips_count_published\n";
970N/A print "Package build errors: $ips_count_errors\n";
970N/A } elsif ($pkglog_type eq 'validate') { # validate_pkg
970N/A open my $PKGLOG, '<', $pkglog
970N/A or die "Can't open '$pkglog': $OS_ERROR";
970N/A
970N/A my @pkglines;
970N/A my $issue_count = 0;
970N/A my $issue_type = "";
970N/A
970N/A while (my $l = <$PKGLOG>) {
970N/A chomp($l);
970N/A
970N/A # Clear saved lines for each new class of issue
970N/A if ($l =~ m{^\S+ .*:+$}ms) {
970N/A $issue_type = $l;
970N/A $issue_count = 0;
970N/A @pkglines = ();
970N/A next;
970N/A }
702N/A
970N/A # These issues print across two lines
970N/A if ($issue_type eq
970N/A 'Entries that differ between manifests and proto area:')
970N/A {
970N/A if ($l =~ m{^\s+manifests }) {
970N/A my $l2 = <$PKGLOG>;
970N/A chomp($l2);
970N/A
970N/A # strip off prefixes for comparisons
970N/A my $compare1 = $l;
970N/A $compare1 =~ s{^\s+manifests }{};
970N/A my $compare2 = $l2;
970N/A $compare2 =~ s{^\s+proto area }{};
970N/A
970N/A # Warnings we can ignore
970N/A if ($compare1 =~ m{^hardlink }) {
970N/A my $hl1 = $compare1;
970N/A my $hl2 = $compare2;
970N/A
970N/A # validate_pkg doesn't like hardlinks to isaexec from our pkgs
970N/A $hl1 =~ s{ target=usr/lib/isaexec}{};
970N/A $hl2 =~ s{ target=\d+}{};
702N/A
970N/A next if ($hl1 eq $hl2);
970N/A
970N/A } elsif ($compare1 =~ m{^file }) {
970N/A my $f1 = $compare1;
970N/A my $f2 = $compare2;
970N/A
970N/A $f1 =~ s{^file NOHASH }{ };
970N/A $f2 =~ s{^file \S+ }{ };
970N/A
970N/A # We don't expect files in proto area to be chowned/chgrped
970N/A $f1 =~ s{ owner=root}{};
970N/A $f2 =~ s{ owner=owner}{};
970N/A $f1 =~ s{ group=\S+}{};
970N/A $f2 =~ s{ group=group}{};
970N/A
970N/A # We don't expect files in proto area to be setuid/setgid
970N/A if ($f1 =~ m{mode=[24]555}) {
970N/A $f1 =~ s{ mode=[24]555}{};
970N/A $f2 =~ s{ mode=0555}{};
970N/A }
970N/A
970N/A next if ($f1 eq $f2);
970N/A }
970N/A
970N/A $l .= "\n" . $l2 . "\n";
970N/A }
970N/A }
970N/A
970N/A if ($l =~ m{^$}) { # Blank lines separate sections
970N/A if ($issue_count > 0) {
970N/A if ($summary_only) {
970N/A print $issue_type, ' ', $issue_count, "\n";
970N/A } else {
970N/A print join("\n", $issue_type, '', @pkglines), "\n\n";
970N/A }
970N/A }
970N/A @pkglines = ();
970N/A } else {
970N/A push @pkglines, $l;
970N/A $issue_count++;
970N/A }
970N/A
493N/A }
970N/A close($PKGLOG);
493N/A }
493N/A}