#! /usr/perl5/bin/perl -w

#

# Copyright (c) 2008, 2011, Oracle and/or its affiliates. All rights reserved.

#

# Permission is hereby granted, free of charge, to any person obtaining a

# copy of this software and associated documentation files (the "Software"),

# to deal in the Software without restriction, including without limitation

# the rights to use, copy, modify, merge, publish, distribute, sublicense,

# and/or sell copies of the Software, and to permit persons to whom the

# Software is furnished to do so, subject to the following conditions:

#

# The above copyright notice and this permission notice (including the next

# paragraph) shall be included in all copies or substantial portions of the

# Software.

#

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL

# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER

# DEALINGS IN THE SOFTWARE.

#

#

require 5.005;				# minimal Perl version required

use strict;				#

use diagnostics;			#

use File::Spec;				# pathname manipulation routines

use File::stat;				# Named results from stat() function

use English qw( -nomatchvars );

my $default_logfile = 'buildit-XW';

# Log file from new pkg(5) build (in same directory as $default_logfile)

my $default_ips_pkglogfile = 'make-pkgs';

# Log file from old SVR4 package build:

my $default_logpath = 'log/' . $default_logfile;

my $default_svr4_pkglogpath = 'proto-packages/logs/package_build';

my $logfile;

my $pkglog;

my $pkglog_type;	# 'ips' or 'svr4'

my $pkgvalidlog;

my $pkgfailed;

my $summary_only = 0;

if (defined $ARGV[0] && $ARGV[0] eq '-s') {

  $summary_only = 1;

  shift @ARGV;

}

if (defined $ARGV[0]) {

  if (-d $ARGV[0]) {

    $logfile = $ARGV[0] . '/' . $default_logpath;

  } elsif ($ARGV[0] =~ m{/make-pkgs$}ms) {

    $pkglog = $ARGV[0];

    $pkglog_type = 'ips';

  } elsif ($ARGV[0] =~ m{/check-pkgs$}ms) {

    $pkglog = $ARGV[0];

    $pkglog_type = 'validate';

  } elsif ($ARGV[0] =~ m{/package_build$}ms) {

    $pkglog = $ARGV[0];

    $pkglog_type = 'svr4';

  } else {

    $logfile = $ARGV[0];

  }

} elsif ( -f $default_logfile ) {

  $logfile = $default_logfile;

} elsif ( -f $default_logpath ) {

  $logfile = $default_logpath;

} else {

  my @dirtree = File::Spec->splitdir(

		  File::Spec->rel2abs(File::Spec->curdir()));

  # climb the tree, removing one parent at a time to find the logfile

  while (scalar(@dirtree) > 0) {

    $logfile = File::Spec->catfile( @dirtree, $default_logpath);

    last if ( -f $logfile);

#   print "$logfile not found\n";

    pop @dirtree;

  }

  if (scalar(@dirtree) == 0) {

    die "$default_logfile not found, please specify path to log\n";

  }

}

if (defined $logfile) {

  my $make_errors = 0;

  my $LOGFILE = check_make_log($logfile, \$make_errors);

  print "Build errors: ", $make_errors, "\n";

  my $printme = 0;

  # end of file stuff

  while (my $l = <$LOGFILE>) {

    if ($l =~ m{^Runtime: }) {

      print $l;

      next;

    }

    # Look for package build results

    if ($l =~ m{^result log is in (\S*)$}ims) {

      if ($1 =~ m{/package_build$}ms) {

	$pkglog = $1;

	$pkglog_type = 'svr4';

      } else {

	$pkglog_type = 'ips';

	$printme = 1;

	print "\n";

      }

    } elsif ($l =~ m{^Packages built:}ms) {

      print $l;

    } elsif ($l =~ m{^Package.* failed:\s+(\d+)}ms) {

      $pkgfailed = $1;

      print $l;

    }

    # print lines where messages about COPYING file errors appear

    # between "Copying package descriptions" & "Building packages"

    elsif ($l =~ m{Copying package descriptions}) {

      $printme = 1;

    } elsif ($l =~ m{Building packages}) {

      $printme = 0;

    }

    # Log for IPS packaging checks

    elsif ($l =~ m{Checking built packages}) {

	next;

    } elsif ($l =~ m{Package check log is in (\S*)$}ims) {

	$pkgvalidlog = $1;

    }

    # Print selected lines

    elsif ($printme == 1) {

      print $l;

    }

  }

  print "\n";

  close($LOGFILE);

}

# Input: string containing name of logfile

# Prints errors from make output log

# Returns open log file pointer for post-processing

sub check_make_log {

  my ($logfile, $error_count_ref) = @_;

  open my $LOGFILE, '<', $logfile

    or die "Can't open '$logfile': $OS_ERROR";

  print "Scanning $logfile for error messages...\n\n";

  my @steplines;

  my $found_error = 0;

  my $error_count = 0;

  while (my $l = <$LOGFILE>) {

    # Finished if we see the end line

    last if $l =~ m{Finished building the X Window System Consolidation}ms;

    # Clear saved lines for each new module/subdir

    if (($l =~ m{^\#\# making \S+ in \S+\.\.\.$}ms) ||	# open-src pattern

	($l =~ m{^dmake: Warning: Target `subdirs' not remade because of errors}ms) ||

	($l =~ m{^\#\# [[:upper:]][[:lower:]]+ing }ms) || # pkg pattern

	($l =~ m{^\S+ing( \S+)* in \S+\.\.\.$}ms)) {	# xc pattern

      @steplines = ();

      $found_error = 0;

    }

    # If we already hit an error, skip the rest of this module

    next if ($found_error != 0);

    # Add this line to the saved output, combine with previous if previous

    # ended with an \

    if (($#steplines >= 0) && ($steplines[$#steplines] =~ m{\\\Z}ms)) {

      $steplines[$#steplines] .= $l;

    } else {

      push @steplines, $l;

    }

    # Skip ahead to next line if this line ends with \

    next if ($l =~ m{\\\Z}ms);

    # Found a new error?

    if (($l =~ m{\*\*\* }ms) || ($l =~ m{^(d)?make: Fatal error}ms)) {

      $found_error = 1;

      $error_count++;

      next if ($summary_only);

      # Print section header

      print $steplines[0], "\n";

      my $lastmake;

      my $lastcommand = 1;

      my $lastplus = 0;

      # scan back to figure out how far back to print

      for my $ln (1..($#steplines - 1)) {

	my $sl = $steplines[$ln];

	#      print "lastmake: $lastmake, lastcom: $lastcommand, lastplus: $lastplus, line #$ln: $sl\n";

	if ($sl =~ m{\b(make|dmake|gmake)\b}ms) {

	  $lastmake = $ln;

	}

	if ($sl =~ m{\breturned\b}ms) {

	  # don't treat this as a command

	} elsif ($sl =~ m{\b(cc|gcc|CC|g\+\+|ld|gpatch|libtool|GEN|CCLD)\s+}ms) {

	  if ($sl !~ m{usage:}) {

	    $lastcommand = $ln;

	  }

	} elsif ($sl =~ m{^\+ }ms) {

	  # print from start of shell's set -x output, not end

	  if ($lastplus != ($ln - 1)) {

	    $lastcommand = $ln;

	  }

	  $lastplus = $ln;

	} elsif ($lastplus == ($ln - 1)) {

	  $lastcommand = $ln;

	}

      }

      #    print "lastmake: $lastmake, lastcommand: $lastcommand\n";

      if ($lastmake && ($lastmake < $lastcommand)) {

	print $steplines[$lastmake];

      }

      for my $ln ($lastcommand..$#steplines) {

	print $steplines[$ln];

      }

      print "\n", '-'x78, "\n";

    }

  }

  if (defined $error_count_ref) {

    ${$error_count_ref} = $error_count;

  }

  return $LOGFILE;

}

sub check_pkglog {

  my ($pl) = @_;

  if ( -f $pl ) {

    my $logfile_sb = stat($logfile);

    my $pkglog_sb = stat($pl);

    if ($logfile_sb->mtime > $pkglog_sb->mtime) {

      # Haven't rebuilt packages since last build, so no point reporting errors

      undef $pl;

    }

  } else {

    undef $pl;

  }

  return $pl;

}

# No packaging log found in build log, try to guess where it is

if (!defined($pkglog)) {

  my $path_to_check = $logfile;

  $path_to_check =~ s{$default_logfile}{$default_ips_pkglogfile}ms;

  $pkglog = check_pkglog($path_to_check);

  if (defined($pkglog)) {

    $pkglog_type = 'ips';

  } else {

    $pkglog_type = 'svr4';

    $path_to_check = $logfile;

    $path_to_check =~ s{$default_logpath}{$default_svr4_pkglogpath}ms;

    $pkglog = check_pkglog($path_to_check);

    if (!defined($pkglog)) {

      $path_to_check = $logfile;

      $path_to_check =~ s{($default_logpath).*$}{$default_svr4_pkglogpath}ms;

      $pkglog = check_pkglog($path_to_check);

    }

  }

}

if ((!defined($pkgfailed) || ($pkgfailed > 0)) && defined($pkglog)) {

  check_pkg_log($pkglog, $pkglog_type);

}

if (defined($pkgvalidlog)) {

  print "\nScanning $pkgvalidlog for package checking issues...\n\n";

  check_pkg_log($pkgvalidlog, 'validate');

}

sub check_pkg_log {

  my ($logfile, $logtype) = @_;

  if ($logtype eq 'svr4') {

    open my $PKGLOG, '<', $logfile

      or die "Can't open '$logfile': $OS_ERROR";

    my @pkglines;

    while (my $l = <$PKGLOG>) {

      # Clear saved lines for each new package

      if ($l =~ m{^[*]+ Making the \S+ package [*]+$}ms) {

	@pkglines = ();

      }

      # Warnings we can ignore

      next if $l =~ m{^WARNING: parameter \<PSTAMP\> set}ms;

      next if $l =~ m{^WARNING: parameter \<CLASSES\> set to "none"}ms;

      push @pkglines, $l;

      if (($l =~ m{(Packaging was not successful.|was not found ; skipping)}ms)

	  || ($l =~ m{^WARNING: }ms)) {

	print join('', @pkglines);

	@pkglines = ();

      }

    }

    close($PKGLOG);

  } elsif ($logtype eq 'ips') {

    my $ips_count_errors = 0;

    my $PKGLOG = check_make_log($logfile, \$ips_count_errors);

    seek($PKGLOG, 0, 0);  # reset to start reading from beginning of file

    my $ips_count_published = 0;

    while (my $l = <$PKGLOG>) {

      if ($l =~ m{Publishing .* to proto repository}) {

	$ips_count_published++;

      }

    }

    print "Packages published: $ips_count_published\n";

    print "Package build errors: $ips_count_errors\n";

  } elsif ($logtype eq 'validate') { # validate_pkg

    open my $PKGLOG, '<', $logfile

      or die "Can't open '$logfile': $OS_ERROR";

    my @pkglines;

    my $issue_count = 0;

    my $issue_type = "";

    my $publisher;

    while (my $l = <$PKGLOG>) {

      chomp($l);

      if ($l =~ m{^\#\# Running pkglint on the (\S+) repository}) {

	$publisher = $1;

      }

      # Clear saved lines for each new class of issue

      if (($l =~ m{^\S+ .*:+$}ms) || ($l =~ m{^\#\# })) {

	$issue_type = $l;

	$issue_count = 0;

	@pkglines = ();

	next;

      }

      # These issues print across two lines

      if ($issue_type eq

	  'Entries that differ between manifests and proto area:') 

        {

	  if ($l =~ m{^\s+manifests }) {

	    my $l2 = <$PKGLOG>;

	    chomp($l2);

	    # strip off prefixes for comparisons

	    my $compare1 = $l;

	    $compare1 =~ s{^\s+manifests }{};

	    my $compare2 = $l2;

	    $compare2 =~ s{^\s+proto area }{};

	    # Warnings we can ignore

	    if ($compare1 =~ m{^hardlink }) {

	      my $hl1 = $compare1;

	      my $hl2 = $compare2;

	      # validate_pkg doesn't like hardlinks to isaexec from our pkgs

	      $hl1 =~ s{ target=usr/lib/isaexec}{};

	      $hl2 =~ s{ target=\d+}{};

	      next if ($hl1 eq $hl2);

	    } elsif ($compare1 =~ m{^file }) {

	      my $f1 = $compare1;

	      my $f2 = $compare2;

	      $f1 =~ s{^file NOHASH }{ };

	      $f2 =~ s{^file \S+ }{ };

	      # We don't expect files in proto area to be chowned/chgrped

	      $f1 =~ s{ owner=root}{};

	      $f2 =~ s{ owner=owner}{};

	      $f1 =~ s{ group=\S+}{};

	      $f2 =~ s{ group=group}{};

	      # We don't expect files in proto area to be setuid/setgid

	      if ($f1 =~ m{mode=[24]555}) {

		$f1 =~ s{ mode=[24]555}{};

		$f2 =~ s{ mode=0555}{};

	      }

	      next if ($f1 eq $f2);

	    }

	    $l .= "\n" . $l2 . "\n";

	  }

	}

      # Skip warnings we can't do anything about (workaround for

      # https://defect.opensolaris.org/bz/show_bug.cgi?id=18346 )

      if ($l =~ m{^WARNING pkglint.manifest004}) {

	next unless $l =~ m{pkg://$publisher/};

      }

      # Skip informational messages from pkglint

      next if ($l =~ m{^INFO pkglint});

      # Group pkglint errors by type

      if ($l =~ m{^([A-Z]+ (?:pkglint|opensolaris)\S+)\s+(.*)$}) {

	my ($new_issue, $details) = ($1, $2);

	if ($issue_type eq $new_issue) {

	  push @pkglines, $details;

	  $issue_count++;

	} else {

	  print_valid_issue($issue_type, $issue_count, \@pkglines);

	  $issue_type = $new_issue;

	  $issue_count = 1;

	  @pkglines = ($details);

	}

      }

      elsif ($l =~ m{^$}) { # Blank lines separate validate_pkg sections

	print_valid_issue($issue_type, $issue_count, \@pkglines);

	$issue_type = "";

	$issue_count = 0;

	@pkglines = ();

      } else {

	push @pkglines, $l;

	$issue_count++;

      }

    }

    # print any final issues that weren't followed by a blank line

    print_valid_issue($issue_type, $issue_count, \@pkglines);

    close($PKGLOG);

  }

}

sub print_valid_issue

{

  my ($issue_type, $issue_count, $pkglines) = @_;

  if ($issue_count > 0) {

    if ($issue_type !~ m{:$}) {

      $issue_type .= ':';

    }

    if ($summary_only) {

      print $issue_type, ' ', $issue_count, "\n";

    } else {

      print join("\n", $issue_type, '', @{$pkglines}), "\n\n";

    }

  }

}