1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
eval '(exit $?0)' && eval 'exec perl -w "$0" ${1+"$@"}'
& eval 'exec perl -w "$0" $argv:q'
if 0;
use strict;
use warnings;
(my $ME = $0) =~ s|.*/||;
my $editor = $ENV{EDITOR} || 'vi';
$ENV{PATH} = '/bin:/usr/bin';
# Keywords allowed before the colon on the first line of a commit message:
# program names and a few general category names.
my @valid = qw(
arch base64 basename cat chcon chgrp chmod chown chroot cksum comm
cp csplit cut date dd df dir dircolors dirname du echo env expand
expr factor false fmt fold groups head hostid hostname id install
join kill link ln logname ls md5sum mkdir mkfifo mknod mktemp
mv nice nl nohup nproc od paste pathchk pinky pr printenv printf
ptx pwd readlink realpath rm rmdir runcon seq sha1sum sha224sum sha256sum
sha384sum sha512sum shred shuf sleep sort split stat stdbuf stty
su sum sync tac tail tee test timeout touch tr true truncate tsort
tty uname unexpand uniq unlink uptime users vdir wc who whoami yes
copy gnulib tests maint doc build scripts
);
my $v_or = join '|', @valid;
my $valid_regex = qr/^(?:$v_or)$/;
# Rewrite the $LOG_FILE (old contents in @$LINE_REF) with an additional
# a commented diagnostic "# $ERR" line at the top.
sub rewrite($$$)
{
my ($log_file, $err, $line_ref) = @_;
local *LOG;
open LOG, '>', $log_file
or die "$ME: $log_file: failed to open for writing: $!";
print LOG "# $err";
print LOG @$line_ref;
close LOG
or die "$ME: $log_file: failed to rewrite: $!\n";
}
sub re_edit($)
{
my ($log_file) = @_;
warn "Interrupt (Ctrl-C) to abort...\n";
system 'sh', '-c', "$editor $log_file";
($? & 127) || ($? >> 8)
and die "$ME: $log_file: the editor ($editor) failed, aborting\n";
}
sub bad_first_line($)
{
my ($line) = @_;
$line =~ /^[Vv]ersion \d/
and return '';
$line =~ /:/
or return 'missing colon on first line of log message';
# The token(s) before the colon on the first line must be on our list
# Tokens may be space- or comma-separated.
(my $pre_colon = $line) =~ s/:.*//;
my @word = split (/[ ,]/, $pre_colon);
my @bad = grep !/$valid_regex/, @word;
@bad
and return 'invalid first word(s) of summary line: ' . join (', ', @bad);
return '';
}
# Given a $LOG_FILE name and a \@LINE buffer,
# read the contents of the file into the buffer and analyze it.
# If the log message passes muster, return the empty string.
# If not, return a diagnostic.
sub check_msg($$)
{
my ($log_file, $line_ref) = @_;
local *LOG;
open LOG, '<', $log_file
or return "failed to open for reading: $!";
@$line_ref = <LOG>;
close LOG;
my @line = @$line_ref;
chomp @line;
# Don't filter out blank or comment lines; git does that already,
# and if we were to ignore them here, it could lead to committing
# with lines that start with "#" in the log.
# Filter out leading blank and comment lines.
# while (@line && $line[0] =~ /^(?:#.*|[ \t]*)$/) { shift @line; }
# Filter out blank and comment lines at EOF.
# while (@line && $line[$#line] =~ /^(?:#.*|[ \t]*)$/) { pop @line; }
@line == 0
and return 'no log message';
my $bad = bad_first_line $line[0];
$bad
and return $bad;
# Second line should be blank or not present.
2 <= @line && length $line[1]
and return 'second line must be empty';
# Limit line length to allow for the ChangeLog's leading TAB.
foreach my $line (@line)
{
72 < length $line && $line =~ /^[^#]/
and return 'line longer than 72';
}
my $buf = join ("\n", @line) . "\n";
$buf =~ m!https?://bugzilla\.redhat\.com/show_bug\.cgi\?id=(\d+)!s
and return "use shorter http://bugzilla.redhat.com/$1";
$buf =~ m!https?://debbugs\.gnu\.org/(?:cgi/bugreport\.cgi\?bug=)?(\d+)!s
and return "use shorter http://bugs.gnu.org/$1";
return '';
}
{
@ARGV == 1
or die;
my $log_file = $ARGV[0];
while (1)
{
my @line;
my $err = check_msg $log_file, \@line;
$err eq ''
and last;
$err = "$ME: $err\n";
warn $err;
# Insert the diagnostic as a comment on the first line of $log_file.
rewrite $log_file, $err, \@line;
re_edit $log_file;
# Stop if our parent is killed.
getppid() == 1
and last;
}
}
|
