From 69c406f30530804d323330c2addaad54290ef3b8 Mon Sep 17 00:00:00 2001 From: Steffen Mueller Date: Tue, 26 Jan 2010 17:23:38 +0100 Subject: [PATCH] Porting/ tool: Check for bad commits against cpan/ Porting/check-cpan-pollution runs a series of tests to find potentially unsafe commits that change dual-lived modules and prints a summary. --- Porting/check-cpan-pollution | 195 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 195 insertions(+) create mode 100644 Porting/check-cpan-pollution diff --git a/Porting/check-cpan-pollution b/Porting/check-cpan-pollution new file mode 100644 index 0000000..fb2d50e --- /dev/null +++ b/Porting/check-cpan-pollution @@ -0,0 +1,195 @@ +#!perl +use strict; +use warnings; +use Getopt::Long qw/GetOptions/; +use Term::ANSIColor qw/color/; +use constant GITCMD => 'git'; + +sub usage { + print < []] + +Scans the commit logs for commits that are potentially, illegitimately +touching modules that are primarily maintained outside of the perl core. +Also checks for commits that span multiple distributions in cpan/ or dist/. +Ignores MANIFEST and Porting/Maintainers.pl. + +Skip the to go back indefinitely. defaults to +HEAD. + + -h/--help shows this help + -v/--verbose shows the output of "git show --stat " for each commit + -c/--color uses colored output +HERE + exit(1); +} + +our $Verbose = 0; +our $Color = 0; +GetOptions( + 'h|help' => \&usage, + 'v|verbose' => \$Verbose, + 'c|color|colour' => \$Color, +); + +my $start_commit = shift; +my $end_commit = shift; +$end_commit = 'HEAD' if not defined $end_commit; +my $commit_range_cmd = defined($start_commit) ? " $start_commit..$end_commit" : ""; + +# format: hash\0author\0committer\0short_msg +our $LogCmd = GITCMD() . q{ log --no-color -M -C --name-only '--pretty=format:%h%x00%an%x00%cn%x00%s'} . $commit_range_cmd; +our @ColumnSpec = qw(hash author committer commit_msg); + +open my $fh, '-|', $LogCmd + or die "Can't run '$LogCmd' to get the commit log: $!"; + +my ($safe_commits, $unsafe_commits) = parse_log($fh); + +if (@$unsafe_commits) { + my $header = "Potentially unsafe commits:"; + print color("red") if $Color; + print $header, "\n"; + print("=" x length($header), "\n\n") if $Verbose; + print color("reset") if $Color; + print_commit_info($_) foreach reverse @$unsafe_commits; + print "\n"; +} + +if (@$safe_commits) { + my $header = "Presumably safe commits:"; + print color("green") if $Color; + print $header, "\n"; + print("=" x length($header), "\n") if $Verbose; + print color("reset") if $Color; + print_commit_info($_) foreach reverse @$safe_commits; + print "\n"; +} + +exit(0); + + + +# single-line info about the commit at hand +sub print_commit_info { + my $commit = shift; + + my $author_info = "by $commit->{author}" + . ($commit->{author} eq $commit->{committer} + ? '' + : " committed by $commit->{committer}"); + + if ($Verbose) { + print color("yellow") if $Color; + my $header = "$commit->{hash} $author_info: $commit->{msg}"; + print "$header\n", ("-" x length($header)), "\n"; + print color("reset") if $Color; + + my $cmd = GITCMD() . ' show --stat ' . ($Color?'--color ':'') + . $commit->{hash}; + print `$cmd`; # make sure git knows this isn't a terminal + print "\n"; + } + else { + print color("yellow") if $Color; + print " $commit->{hash} $author_info: $commit->{msg}\n"; + print color("reset") if $Color; + } +} + + +# check whether the commit at hand is safe, unsafe or uninteresting +sub check_commit { + my $commit = shift; + my $safe = shift; + my $unsafe = shift; + + my @files = grep {$_ ne 'MANIFEST' and $_ ne 'Porting/Maintainers.pl'} + @{$commit->{files}}; + my @touching_cpan = grep {/^cpan\//} @files; + return if not @touching_cpan; + + # check for unsafe commits to cpan/ + my %touched_cpan_dirs; + $touched_cpan_dirs{$_}++ for grep {defined $_} + map {s/^cpan\/([^\/]*).*$/$1/; $_} + @touching_cpan; + + my $touches_multiple_cpan_dists = (keys(%touched_cpan_dirs) > 1); + + my $touches_others = @files - @touching_cpan; + + if (@touching_cpan) { + if ($touches_others) { + $commit->{msg} = 'Touched files under cpan/ and other locations'; + push @$unsafe, $commit; + } + elsif ($touches_multiple_cpan_dists) { + $commit->{msg} = 'Touched multiple directories under cpan/'; + push @$unsafe, $commit; + } + elsif ($commit->{commit_msg} =~ /(?:up(?:grad|dat)|import)(?:ed?|ing)/i) { + $commit->{msg} = 'Touched files under cpan/ with ' + . '"upgrading"-like commit message'; + push @$safe, $commit; + } + else { + $commit->{msg} = 'Touched files under cpan/ without ' + . '"upgrading"-like commit message'; + push @$unsafe, $commit; + } + } + + # check for unsafe commits to dist/ + my @touching_dist = grep {/^dist\//} @files; + my %touched_dist_dirs; + $touched_dist_dirs{$_}++ for grep {defined $_} + map {s/^dist\/([^\/]*).*$/$1/; $_} + @touching_dist; + $touches_others = @files - @touching_dist; + my $touches_multiple_dists = (keys(%touched_dist_dirs) > 1); + + if (@touching_dist) { + if ($touches_others) { + $commit->{msg} = 'Touched files under dist/ and other locations'; + push @$unsafe, $commit; + } + elsif ($touches_multiple_dists) { + $commit->{msg} = 'Touched multiple directories under cpan/'; + push @$unsafe, $commit; + } + } +} + +# given file handle, parse the git log output and put the resulting commit +# structure into safe/unsafe compartments +sub parse_log { + my $fh = shift; + my @safe_commits; + my @unsafe_commits; + my $commit; + while (defined(my $line = <$fh>)) { + chomp $line; + if (not $commit) { + next if $line =~ /^\s*$/; + my @cols = split /\0/, $line; + @cols == @ColumnSpec && !grep {!defined($_)} @cols + or die "Malformed commit header line: '$line'"; + $commit = { + files => [], + map {$ColumnSpec[$_] => $cols[$_]} (0..$#cols) + }; + next; + } + elsif ($line =~ /^\s*$/) { # within commit, blank line + check_commit($commit, \@safe_commits, \@unsafe_commits); + $commit = undef; + } + else { # within commit, non-blank (file) line + push @{$commit->{files}}, $line; + } + } + + return(\@safe_commits, \@unsafe_commits); +} + -- 2.7.4