20
22
# specific language governing permissions and limitations
21
23
# under the License.
25
use Carp qw/croak confess carp cluck/;
23
27
use Term::ReadKey qw/ReadMode ReadKey/;
28
use File::Basename qw/basename dirname/;
29
use File::Copy qw/copy move/;
24
30
use File::Temp qw/tempfile/;
25
use POSIX qw/ctermid/;
32
use IPC::Open3 qw/open3/;
33
use POSIX qw/ctermid strftime isprint isspace/;
34
use Text::Wrap qw/wrap/;
37
############### Start of reading values from environment ###############
41
# TODO: document which are interpreted by sh and which should point to binary.
27
42
my $SVN = $ENV{SVN} || 'svn'; # passed unquoted to sh
43
my $SHELL = $ENV{SHELL} // '/bin/sh';
45
my $EDITOR = $ENV{SVN_EDITOR} // $ENV{VISUAL} // $ENV{EDITOR} // 'ed';
46
my $PAGER = $ENV{PAGER} // 'less' // 'cat';
51
AutoCommitApproveds => 1, # used by nightly commits (svn-role)
52
Conflicts => 2, # used by the hourly conflicts-detection buildbot
56
my $YES = ($ENV{YES} // "0") =~ /^(1|yes|true)$/i; # batch mode: eliminate prompts, add sleeps
57
my $MAY_COMMIT = ($ENV{MAY_COMMIT} // "false") =~ /^(1|yes|true)$/i;
58
my $MODE = ($YES ? ($MAY_COMMIT ? Mode::AutoCommitApproveds : Mode::Conflicts )
59
: Mode::Interactive );
63
my $DEBUG = (exists $ENV{DEBUG}); # 'set -x', etc
65
# Force all these knobs to be usable via @sh.
66
my @sh = qw/false true/;
67
die if grep { ($sh[$_] eq 'true') != !!$_ } $DEBUG, $MAY_COMMIT, $VERBOSE, $YES;
69
# Username for entering votes.
70
my $SVN_A_O_REALM = '<https://svn.apache.org:443> ASF Committers';
71
my ($AVAILID) = $ENV{AVAILID} // do {
72
local $_ = `$SVN auth svn.apache.org:443 2>/dev/null`; # TODO: pass $SVN_A_O_REALM
73
($? == 0 && /Auth.*realm: \Q$SVN_A_O_REALM\E\nUsername: (.*)/) ? $1 : undef
75
local $/; # slurp mode
77
my $dir = "$ENV{HOME}/.subversion/auth/svn.simple/";
78
my $filename = Digest->new("MD5")->add($SVN_A_O_REALM)->hexdigest;
79
open $fh, '<', "$dir/$filename"
80
and <$fh> =~ /K 8\nusername\nV \d+\n(.*)/
85
unless (defined $AVAILID) {
86
unless ($MODE == Mode::Conflicts) {
87
warn "Username for commits (of votes/merges) not found; "
88
."it will be possible to review nominations but not to commit votes "
90
warn "Press the 'any' key to continue...\n";
91
die if $MODE == Mode::AutoCommitApproveds; # unattended mode; can't prompt.
98
############## End of reading values from the environment ##############
29
101
my $STATUS = './STATUS';
102
my $STATEFILE = './.backports1';
30
103
my $BRANCHES = '^/subversion/branches';
32
my $YES = $ENV{YES}; # batch mode: eliminate prompts, add sleeps
33
my $WET_RUN = qw[false true][1]; # don't commit
34
my $DEBUG = qw[false true][0]; # 'set -x', etc
104
my $TRUNK = '^/subversion/trunk';
105
$ENV{LC_ALL} = "C"; # since we parse 'svn info' output and use isprint()
109
# TODO: can $MERGED_SOMETHING be removed and references to it replaced by scalar(@MERGES_TODAY) ?
110
# alternately, does @MERGES_TODAY need to be purged whenever $MERGED_SOMETHING is reset?
111
# The scalar is only used in interactive runs, but the array is used in
112
# svn-role batch mode too.
114
my $MERGED_SOMETHING = 0;
119
my ($major, $minor, $patch) = `$SVN --version -q` =~ /^(\d+)\.(\d+)\.(\d+)/;
120
1e6*$major + 1e3*$minor + $patch;
39
122
$SVN .= " --non-interactive" if $YES or not defined ctermid;
40
123
$SVNq = "$SVN -q ";
41
$SVNq =~ s/-q// if $DEBUG eq 'true';
124
$SVNq =~ s/-q// if $DEBUG;
128
my $basename = basename $0;
47
Run this from the root of your release branch (e.g., 1.6.x) working copy.
49
For each entry in STATUS, you will be prompted whether to merge it.
52
If you accept the prompt, $basename will revert all local changes and will
53
commit the merge immediately.
130
backport.pl: a tool for reviewing, merging, and voting on STATUS entries.
132
Normally, invoke this with CWD being the root of the stable branch (e.g.,
135
Usage: test -e \$d/STATUS && cd \$d && \\
136
backport.pl [PATTERN]
137
(where \$d is a working copy of branches/1.8.x)
139
Alternatively, invoke this via a symlink named "b" placed at the same directory
140
as the STATUS file, in which case the CWD doesn't matter (the script will cd):
142
Usage: ln -s /path/to/backport.pl \$d/b && \\
144
(where \$d is a working copy of branches/1.8.x)
146
In either case, the ./STATUS file should be at HEAD. If it has local mods,
147
they will be preserved through 'revert' operations but included in 'commit'
150
If PATTERN is provided, only entries which match PATTERN are considered. The
151
sense of "match" is either substring (fgrep) or Perl regexp (with /msi).
153
In interactive mode (the default), you will be prompted once per STATUS entry.
154
At a prompt, you have the following options:
156
y: Run a merge. It will not be committed.
157
WARNING: This will run 'update' and 'revert -R ./'.
158
l: Show logs for the entries being nominated.
159
v: Show the full entry (the prompt only shows an abridged version).
160
q: Quit the "for each nomination" loop.
161
±1: Enter a +1 or -1 vote
162
You will be prompted to commit your vote at the end.
163
±0: Enter a +0 or -0 vote
164
You will be prompted to commit your vote at the end.
165
a: Move the entry to the "Approved changes" section.
166
When both approving and voting on an entry, approve first: for example,
167
to enter a third +1 vote, type "a" "+" "1".
168
e: Edit the entry in $EDITOR.
169
You will be prompted to commit your edits at the end.
170
N: Move to the next entry. Cache the entry in '$STATEFILE' and do not
171
prompt for it again (even across runs) until it is changed.
172
: Move to the next entry, without adding the current one to the cache.
173
(That's a space character, ASCII 0x20.)
175
After running a merge, you have the following options:
179
N: Move to the next entry.
181
To commit a merge, you have two options: either answer 'y' to the second prompt
182
to open a shell, and manually run 'svn commit' therein; or set \$MAY_COMMIT=1
183
in the environment before running the script, in which case answering 'y'
184
to the first prompt will not only run the merge but also commit it.
186
There are two batch modes. The first mode is used by the nightly svn-role
187
mergebot. It is enabled by setting \$YES and \$MAY_COMMIT to '1' in the
188
environment. In this mode, the script will iterate the "Approved changes:"
189
section and merge and commit each entry therein. To prevent an entry from
190
being auto-merged, veto it or move it to a new section named "Approved, but
193
The second batch mode is used by the hourly conflicts detector bot. It is
194
triggered by having \$YES defined in the environment to '1' and \$MAY_COMMIT
195
undefined. In this mode, the script will locally merge every nomination
196
(including unapproved and vetoed ones), and complain to stderr if the merge
197
failed due to a conflict. This mode never commits anything.
199
The hourly conflicts detector bot turns red if any entry produced a merge
200
conflict. When entry A depends on entry B for a clean merge, put a "Depends:"
201
header on entry A to instruct the bot not to turn red due to A. (The header
202
is not parsed; only its presence or absence matters.)
204
Both batch modes also perform a basic sanity-check on entries that declare
205
backport branches (via the "Branch:" header): if a backport branch is used, but
206
at least one of the revisions enumerated in the entry title had not been merged
207
from $TRUNK to the branch root, the hourly bot will turn red and
208
nightly bot will skip the entry and email its admins. (The nightly bot does
209
not email the list on failure, since it doesn't use buildbot.)
55
211
The 'svn' binary defined by the environment variable \$SVN, or otherwise the
56
212
'svn' found in \$PATH, will be used to manage the working copy.
217
my $availid = $AVAILID // "(your username)";
218
my $basename = basename $0;
220
nominate.pl: a tool for adding entries to STATUS.
222
Usage: $0 "foo r42 bar r43 qux 45." "\$Some_justification"
231
to STATUS. Backport branches are detected automatically.
233
The STATUS file in the current directory is used (unless argv[0] is "n", in
234
which case the STATUS file in the directory of argv[0] is used; the intent
235
is to create a symlink named "n" in the branch wc root).
238
# TODO: Optionally add a "Notes" section.
239
# TODO: Look for backport branches named after issues.
240
# TODO: Do a dry-run merge on added entries.
241
# TODO: Do a dry-run merge on interactively-edited entries in backport.pl
244
# If $AVAILID is undefined, warn about it and return true.
247
# $_[0] is a string for inclusion in generated error messages.
248
sub warned_cannot_commit {
249
my $caller_error_string = shift;
250
return 0 if defined $AVAILID;
252
warn "$0: $caller_error_string: unable to determine your username via \$AVAILID or svnauth(1) or ~/.subversion/auth/";
257
Digest->new("MD5")->add(@_)->hexdigest
260
sub digest_entry($) {
261
# Canonicalize the number of trailing EOLs to two. This matters when there's
262
# on empty line after the last entry in Approved, for example.
264
s/\n*\z// and $_ .= "\n\n";
61
local $\; # disable 'perl -l' effects
64
# TODO: this part was written by trial-and-error
66
my $answer = (ReadKey 0);
68
return ($answer =~ /^y/i) ? 1 : 0;
275
$answer = (ReadKey 0);
277
die if $@ or not defined $answer;
278
# Swallow terminal escape codes (e.g., arrow keys).
279
unless (isprint $answer or isspace $answer) {
280
$answer = (ReadKey -1) while defined $answer;
281
# TODO: provide an indication that the keystroke was sensed and ignored.
283
} until defined $answer and (isprint $answer or isspace $answer);
288
die "$0: called prompt() in non-interactive mode!" if $YES;
289
my $answer = $getchar->();
290
$answer .= $getchar->() if exists $args{extra} and $answer =~ $args{extra};
291
say "" unless $args{dontprint};
292
return $args{verbose}
294
: ($answer =~ /^y/i) ? 1 : 0;
297
# Bourne-escape a string.
299
# >>> shell_escape(q[foo'bar]) eq q['foo'\''bar']
303
local $_ = $_; # the LHS $_ is mutable; the RHS $_ may not be.
307
wantarray ? @reply : $reply[0]
310
sub shell_safe_path_or_url($) {
312
return (m{^[A-Za-z0-9._:+/-]+$} and !/^-|^[+]/);
315
# Shell-safety-validating wrapper for File::Temp::tempfile
317
my ($fh, $fn) = tempfile();
318
croak "Tempfile name '$fn' not shell-safe; aborting"
319
unless shell_safe_path_or_url $fn;
323
# The first argument is a shell script. Run it and return the shell's
324
# exit code, and stdout and stderr as references to arrays of lines.
325
sub run_in_shell($) {
327
my $pid = open3 \*SHELL_IN, \*SHELL_OUT, \*SHELL_ERR, qw#/bin/sh#;
328
# open3 raises exception when it fails; no need to error check
330
print SHELL_IN $script;
333
# Read loop: tee stdout,stderr to arrays.
334
my $select = IO::Select->new(\*SHELL_OUT, \*SHELL_ERR);
335
my (@readable, $outlines, $errlines);
336
while (@readable = $select->can_read) {
337
for my $fh (@readable) {
339
$select->remove($fh) if eof $fh or not defined $line;
340
next unless defined $line;
342
if ($fh == \*SHELL_OUT) {
343
push @$outlines, $line;
346
if ($fh == \*SHELL_ERR) {
347
push @$errlines, $line;
352
waitpid $pid, 0; # sets $?
353
return $?, $outlines, $errlines;
357
# EXPECTED_ERROR_P is subref called with EXIT_CODE, OUTLINES, ERRLINES,
358
# expected to return TRUE if the error should be considered fatal (cause
359
# backport.pl to exit non-zero) or not. It may be undef for default behaviour.
74
my ($logmsg_fh, $logmsg_filename) = tempfile();
75
my ($mergeargs, $pattern);
77
my $backupfile = "backport_pl.$$.tmp";
361
my %entry = %{ +shift };
362
my $expected_error_p = shift // sub { 0 }; # by default, errors are unexpected
363
my $parno = $entry{parno} - scalar grep { $_->{parno} < $entry{parno} } @MERGES_TODAY;
365
my ($logmsg_fh, $logmsg_filename) = my_tempfile();
368
my $shell_escaped_branch = shell_escape($entry{branch})
369
if defined($entry{branch});
79
371
if ($entry{branch}) {
80
# NOTE: This doesn't escape the branch into the pattern.
81
$pattern = sprintf '\V\(%s branch(es)?\|branches\/%s\|Branch(es)?:\n *%s\)', $entry{branch}, $entry{branch}, $entry{branch};
82
$mergeargs = "--reintegrate $BRANCHES/$entry{branch}";
83
print $logmsg_fh "Reintegrate the $entry{header}:";
372
if ($SVNvsn >= 1_008_000) {
373
@mergeargs = shell_escape "$BRANCHES/$entry{branch}";
374
say $logmsg_fh "Merge $entry{header}:";
376
@mergeargs = shell_escape qw/--reintegrate/, "$BRANCHES/$entry{branch}";
377
say $logmsg_fh "Reintegrate $entry{header}:";
85
380
} elsif (@{$entry{revisions}}) {
86
$pattern = '^ [*] \V' . 'r' . $entry{revisions}->[0];
87
$mergeargs = join " ", (map { "-c$_" } @{$entry{revisions}}), '^/subversion/trunk';
88
if (@{$entry{revisions}} > 1) {
89
print $logmsg_fh "Merge the $entry{header} from trunk:";
92
print $logmsg_fh "Merge r$entry{revisions}->[0] from trunk:";
381
@mergeargs = shell_escape(
382
($entry{accept} ? "--accept=$entry{accept}" : ()),
383
(map { "-c$_" } @{$entry{revisions}}),
385
'^/subversion/trunk',
388
"Merge $entry{header} from trunk",
389
$entry{accept} ? ", with --accept=$entry{accept}" : "",
96
393
die "Don't know how to call $entry{header}";
98
print $logmsg_fh $_ for @{$entry{entry}};
395
say $logmsg_fh $_ for @{$entry{entry}};
99
396
close $logmsg_fh or die "Can't close $logmsg_filename: $!";
398
my $reintegrated_word = ($SVNvsn >= 1_008_000) ? "merged" : "reintegrated";
101
399
my $script = <<"EOF";
107
$SVN diff > $backupfile
110
$SVNq merge $mergeargs
111
$VIM -e -s -n -N -i NONE -u NONE -c '/$pattern/normal! dap' -c wq $STATUS
406
$SVNq merge @mergeargs
407
if [ "`$SVN status -q | wc -l`" -eq 1 ]; then
408
if [ -n "`$SVN diff | perl -lne 'print if s/^(Added|Deleted|Modified): //' | grep -vx svn:mergeinfo`" ]; then
409
# This check detects STATUS entries that name non-^/subversion/ revnums.
410
# ### Q: What if we actually commit a mergeinfo fix to trunk and then want
411
# ### to backport it?
412
# ### A: We don't merge it using the script.
413
echo "Bogus merge: includes only svn:mergeinfo changes!" >&2
417
if $sh[$MAY_COMMIT]; then
418
# Remove the approved entry. The sentinel is important when the entry being
419
# removed is the very last one in STATUS, and in that case it has two effects:
420
# (1) keeps STATUS from ending in a run of multiple empty lines;
421
# (2) makes the \x{7d}k motion behave the same as in all other cases.
423
# Use a tempfile because otherwise backport_main() would see the "sentinel paragraph".
424
# Since backport_main() has an open descriptor, it will continue to see
425
# the STATUS inode that existed when control flow entered backport_main();
426
# since we replace the file on disk, when this block of code runs in the
427
# next iteration, it will see the new contents.
429
(echo; echo; echo "sentinel paragraph") >> $STATUS.t
430
$VIM -e -s -n -N -i NONE -u NONE -c ':0normal! $parno\x{7d}kdap' -c wq $STATUS.t
431
$VIM -e -s -n -N -i NONE -u NONE -c '\$normal! dap' -c wq $STATUS.t
113
433
$SVNq commit -F $logmsg_filename
434
elif ! $sh[$YES]; then
435
echo "Would have committed:"
438
echo 'M STATUS (not shown in the diff)'
117
439
cat $logmsg_filename
445
# STATUS has been edited and the change has been committed
446
push @MERGES_TODAY, \%entry;
121
449
$script .= <<"EOF" if $entry{branch};
122
450
reinteg_rev=\`$SVN info $STATUS | sed -ne 's/Last Changed Rev: //p'\`
451
if $sh[$MAY_COMMIT]; then
124
452
# Sleep to avoid out-of-order commit notifications
125
if [ -n "\$YES" ]; then sleep 15; fi
126
$SVNq rm $BRANCHES/$entry{branch} -m "Remove the '$entry{branch}' branch, reintegrated in r\$reinteg_rev."
127
if [ -n "\$YES" ]; then sleep 1; fi
129
echo "Removing reintegrated '$entry{branch}' branch"
453
if $sh[$YES]; then sleep 15; fi
454
$SVNq rm $BRANCHES/$shell_escaped_branch -m "Remove the '"$shell_escaped_branch"' branch, $reintegrated_word in r\$reinteg_rev."
455
if $sh[$YES]; then sleep 1; fi
456
elif ! $sh[$YES]; then
457
echo "Would remove $reintegrated_word '"$shell_escaped_branch"' branch"
133
open SHELL, '|-', qw#/bin/sh# or die $!;
135
close SHELL or warn "$0: sh($?): $!";
137
unlink $backupfile if -z $backupfile;
138
unlink $logmsg_filename unless $? or $!;
461
# Include the time so it's easier to find the interesting backups.
462
my $backupfile = strftime "backport_pl.%Y%m%d-%H%M%S.$$.tmp", localtime;
463
die if -s $backupfile;
464
system("$SVN diff > $backupfile") == 0
465
or die "Saving a backup diff ($backupfile) failed ($?): $!";
466
if (-z $backupfile) {
469
warn "Local mods saved to '$backupfile'\n";
472
# If $MAY_COMMIT, then $script will edit STATUS anyway.
473
revert(verbose => 0, discard_STATUS => $MAY_COMMIT);
476
my ($exit_code, $outlines, $errlines) = run_in_shell $script;
478
die "system() failed to spawn subshell ($!); aborting";
480
unless ($exit_code == 0) {
481
warn "$0: subshell exited with code $exit_code (in '$entry{header}') "
482
."(maybe due to 'set -e'?)";
484
# If we're committing, don't attempt to guess the problem and gracefully
485
# continue; just abort.
487
die "Lost track of paragraph numbers; aborting";
490
# Record the error, unless the caller wants not to.
491
$ERRORS{$entry{id}} = [\%entry, "subshell exited with code $exit_code"]
492
unless $expected_error_p->($exit_code, $outlines, $errlines);
495
unlink $logmsg_filename unless $exit_code;
500
# "branches/1.8.x-r42",
501
# "branches/1.8.x-r42/",
502
# "subversion/branches/1.8.x-r42",
503
# "subversion/branches/1.8.x-r42/",
504
# "^/subversion/branches/1.8.x-r42",
505
# "^/subversion/branches/1.8.x-r42/",
508
# Works for any branch name that doesn't include slashes.
141
509
sub sanitize_branch {
142
510
local $_ = shift;
518
sub logsummarysummary {
521
$entry->{logsummary}->[0], ('[...]' x (0 < $#{$entry->{logsummary}}))
149
524
# TODO: may need to parse other headers too?
150
525
sub parse_entry {
152
531
my (@revisions, @logsummary, $branch, @votes);
155
# strip first three spaces
534
# strip spaces to match up with the indention
535
$_[0] =~ s/^( *)\* //;
536
my $indentation = ' ' x (length($1) + 2);
537
s/^$indentation// for @_;
539
# Ignore trailing spaces: it is not significant on any field, and makes the
160
$branch = sanitize_branch $1 if $_[0] =~ /^(\S*) branch$/;
161
while ($_[0] =~ /^r/) {
162
while ($_[0] =~ s/^r(\d+)(?:$|[,; ]+)//) {
544
$branch = sanitize_branch $1
546
if $_[0] =~ /^(\S*) branch$/ or $_[0] =~ m#branches/(\S+)#;
547
while ($_[0] =~ /^(?:r?\d+[,; ]*)+$/) {
548
push @revisions, ($_[0] =~ /(\d+)/g);
169
push @logsummary, shift until $_[0] =~ /^\s*\w+:/ or not defined $_[0];
554
push @logsummary, shift
555
} until $_[0] =~ /^\s*[][\w]+:/ or not defined $_[0];
172
558
unshift @votes, pop until $_[-1] =~ /^\s*Votes:/ or not defined $_[-1];
561
# depends, branch, notes
562
# Ignored headers: Changes[*]
177
shift and next unless $_[0] =~ s/^\s*Branch(es)?:\s*//;
178
$branch = sanitize_branch (shift || shift || die "Branch header found without value");
568
if (s/^Branch:\s*//) {
569
$branch = sanitize_branch ($_ || shift || die "Branch header found without value");
571
if (s/^Notes:\s*//) {
573
$notes .= shift while @_ and $_[0] !~ /^\w/;
574
my %accepts = map { $_ => 1 } ($notes =~ /--accept[ =]([a-z-]+)/g);
575
given (scalar keys %accepts) {
577
when (1) { $accept = [keys %accepts]->[0]; }
579
warn "Too many --accept values at '",
580
logsummarysummary({ logsummary => [@logsummary] }),
181
588
# Compute a header.
183
$header = "r$revisions[0] group" if @revisions;
184
$header = "$branch branch" if $branch;
185
warn "No header for [@lines]" unless $header;
591
$header = "the $branch branch";
593
} elsif (@revisions == 1) {
594
$header = "r$revisions[0]";
595
$id = "r$revisions[0]";
596
} elsif (@revisions) {
597
$header = "the r$revisions[0] group";
598
$id = "r$revisions[0]";
600
die "Entry '$raw' has neither revisions nor branch";
602
my $header_start = ($header =~ /^the/ ? ucfirst($header) : $header);
604
warn "Entry has both branch '$branch' and --accept=$accept specified\n"
605
if $branch and $accept;
188
608
revisions => [@revisions],
189
609
logsummary => [@logsummary],
190
610
branch => $branch,
191
611
header => $header,
612
header_start => $header_start,
192
615
votes => [@votes],
193
616
entry => [@lines],
619
digest => digest_entry($raw),
620
parno => $parno, # $. from backport_main()
625
# Edits $_[0] in an editor.
626
# $_[1] is used in error messages.
627
die "$0: called edit_string() in non-interactive mode!" if $YES;
631
my $trailing_eol = $args{trailing_eol};
632
my ($fh, $fn) = my_tempfile();
634
$fh->flush or die $!;
635
system("$EDITOR -- $fn") == 0
636
or warn "\$EDITOR failed editing $name: $! ($?); "
637
."edit results ($fn) ignored.";
639
$rv =~ s/\n*\z// and $rv .= ("\n" x $trailing_eol) if defined $trailing_eol;
644
my ($state, $approved, $votes) = @_;
645
# TODO: use votesarray instead of votescheck
646
my (%approvedcheck, %votescheck);
647
my $raw_approved = "";
649
return unless %$approved or %$votes;
651
# If $AVAILID is undef, we can only process 'edit' pseudovotes; handle_entry() is
652
# supposed to prevent numeric (±1,±0) votes from getting to this point.
653
die "Assertion failed" if not defined $AVAILID
654
and grep { $_ ne 'edit' } map { $_->[0] } values %$votes;
659
open STATUS, "<", $STATUS;
660
open VOTES, ">", "$STATUS.$$.tmp";
662
$had_empty_line = /\n\n\z/;
663
my $key = digest_entry $_;
665
$approvedcheck{$key}++ if exists $approved->{$key};
666
$votescheck{$key}++ if exists $votes->{$key};
668
unless (exists $votes->{$key} or exists $approved->{$key}) {
673
unless (exists $votes->{$key}) {
675
entry => $approved->{$key},
683
# We have a vote, and potentially an approval.
685
my ($vote, $entry) = @{$votes->{$key}};
689
approval => (exists $approved->{$key}),
693
if ($vote eq 'edit') {
694
local $_ = $entry->{raw};
695
$votesarray[-1]->{digest} = digest_entry $_;
696
(exists $approved->{$key}) ? ($raw_approved .= $_) : (print VOTES);
700
s/^(\s*\Q$vote\E:.*)/"$1, $AVAILID"/me
701
or s/(.*\w.*?\n)/"$1 $vote: $AVAILID\n"/se;
702
$_ = edit_string $_, $entry->{header}, trailing_eol => 2
704
$votesarray[-1]->{digest} = digest_entry $_;
705
(exists $approved->{$key}) ? ($raw_approved .= $_) : (print VOTES);
708
print VOTES "\n" if $raw_approved and !$had_empty_line;
709
print VOTES $raw_approved;
711
warn "Some vote chunks weren't found: ",
713
map $votes->{$_}->[1]->{id},
714
grep { !$votescheck{$_} } keys %$votes
715
if scalar(keys %$votes) != scalar(keys %votescheck);
716
warn "Some approval chunks weren't found: ",
718
map $approved->{$_}->{id},
719
grep { !$approvedcheck{$_} } keys %$approved
720
if scalar(keys %$approved) != scalar(keys %approvedcheck);
721
prompt "Press the 'any' key to continue...\n", dontprint => 1
722
if scalar(keys %$approved) != scalar(keys %approvedcheck)
723
or scalar(keys %$votes) != scalar(keys %votescheck);
724
move "$STATUS.$$.tmp", $STATUS;
727
my @sentences = map {
728
my $words_vote = ", approving" x $_->{approval};
729
my $words_edit = " and approve" x $_->{approval};
732
( $_->{vote} eq 'edit'
733
? "Edit$words_edit the $_->{entry}->{id} entry"
734
: "Vote $_->{vote} on $_->{entry}->{header}$words_vote"
738
: # exists only in $approved
739
"Approve $_->{entry}->{header}."
743
: "* STATUS:\n" . join "", map " $_\n", @sentences;
746
system "$SVN diff -- $STATUS";
747
printf "[[[\n%s%s]]]\n", $logmsg, ("\n" x ($logmsg !~ /\n\z/));
748
if (prompt "Commit these votes? ") {
749
my ($logmsg_fh, $logmsg_filename) = my_tempfile();
750
print $logmsg_fh $logmsg;
752
system("$SVN commit -F $logmsg_filename -- $STATUS") == 0
753
or warn("Committing the votes failed($?): $!") and return;
754
unlink $logmsg_filename;
756
# Add to state votes that aren't '+0' or 'edit'
757
$state->{$_->{digest}}++ for grep
758
+{ qw/-1 t -0 t +1 t/ }->{$_->{vote}},
763
sub check_local_mods_to_STATUS {
764
if (`$SVN status -q $STATUS`) {
765
die "Local mods to STATUS file $STATUS" if $YES;
766
warn "Local mods to STATUS file $STATUS";
767
system "$SVN diff -- $STATUS";
768
prompt "Press the 'any' key to continue...\n", dontprint => 1;
774
sub renormalize_STATUS {
775
my $vimscript = <<'EOVIM';
776
:"" Strip trailing whitespace before entries and section headers, but not
777
:"" inside entries (e.g., multi-paragraph Notes: fields).
779
:"" Since an entry is always followed by another entry, section header, or EOF,
780
:"" there is no need to separately strip trailing whitespace from lines following
782
:%s/\v\s+\n(\s*\n)*\ze(\s*[*]|\w)/\r\r/g
784
:"" Ensure there is exactly one blank line around each entry and header.
786
:"" First, inject a new empty line above and below each entry and header; then,
787
:"" squeeze runs of empty lines together.
788
:0/^=/,$ g/^ *[*]/normal! O
797
open VIM, '|-', $VIM, qw/-e -s -n -N -i NONE -u NONE --/, $STATUS
798
or die "Can't renormalize STATUS: $!";
799
print VIM $vimscript;
800
close VIM or warn "$0: renormalize_STATUS failed ($?): $!)";
802
system("$SVN commit -m '* STATUS: Whitespace changes only.' -- $STATUS") == 0
803
or die "$0: Can't renormalize STATUS ($?): $!"
809
die "Bug: \$args{verbose} undefined" unless exists $args{verbose};
810
die "Bug: unknown argument" if grep !/^(?:verbose|discard_STATUS)$/, keys %args;
812
copy $STATUS, "$STATUS.$$.tmp" unless $args{discard_STATUS};
813
system("$SVN revert -q $STATUS") == 0
814
or die "revert failed ($?): $!";
815
system("$SVN revert -R ./" . (" -q" x !$args{verbose})) == 0
816
or die "revert failed ($?): $!";
817
move "$STATUS.$$.tmp", $STATUS unless $args{discard_STATUS};
818
$MERGED_SOMETHING = 0;
822
# This is both a SIGINT handler, and the tail end of main() in normal runs.
823
# @_ is 'INT' in the former case and () in the latter.
824
delete $SIG{INT} unless @_;
825
revert verbose => 1 if !$YES and $MERGED_SOMETHING and prompt 'Revert? ';
826
(@_ ? exit : return);
832
# Clean up after prompt()
835
# Fall back to default action
840
sub warning_summary {
841
return unless %ERRORS;
843
warn "Warning summary\n";
844
warn "===============\n";
846
for my $id (keys %ERRORS) {
847
my $title = logsummarysummary $ERRORS{$id}->[0];
848
warn "$id ($title): $ERRORS{$id}->[1]\n";
853
# die "$0: called read_state() in non-interactive mode!" if $YES;
855
open my $fh, '<', $STATEFILE or do {
856
return {} if $!{ENOENT};
857
die "Can't read statefile: $!";
870
open STATE, '>', $STATEFILE or warn("Can't write state: $!"), return;
871
say STATE for keys %$state;
875
sub exit_stage_left {
878
warning_summary if $YES;
881
exit scalar keys %ERRORS;
884
# Given an ENTRY, check whether all ENTRY->{revisions} have been merged
885
# into ENTRY->{branch}, if it has one. If revisions are missing, record
886
# a warning in $ERRORS. Return TRUE If the entry passed the validation
887
# and FALSE otherwise.
888
sub validate_branch_contains_named_revisions {
890
return 1 unless defined $entry{branch};
893
return "Why are you running so old versions?" # true in boolean context
894
if $SVNvsn < 1_005_000; # doesn't have the 'mergeinfo' subcommand
896
my $shell_escaped_branch = shell_escape($entry{branch});
898
my @present = `$SVN mergeinfo --show-revs=merged -- $TRUNK $BRANCHES/$shell_escaped_branch`;
900
@present = map /(\d+)/g, @present;
901
map +($_ => 1), @present;
904
my @absent = grep { not exists $present{$_} } @{$entry{revisions}};
907
$ERRORS{$entry{id}} //= [\%entry,
908
sprintf("Revisions '%s' nominated but not included in branch",
909
(join ", ", map { "r$_" } @absent)),
912
return @absent ? 0 : 1;
197
915
sub handle_entry {
198
my %entry = parse_entry @_;
199
my @vetoes = grep { /^ -1:/ } @{$entry{votes}};
916
my $in_approved = shift;
917
my $approved = shift;
923
my %entry = parse_entry $raw, $parno, @_;
924
my @vetoes = grep /^\s*-1:/, @{$entry{votes}};
926
my $match = defined($skip) ? ($raw =~ /\Q$skip\E/ or $raw =~ /$skip/msi) : 0
202
merge %entry unless @vetoes;
932
if ($MAY_COMMIT and $in_approved) {
934
merge \%entry if validate_branch_contains_named_revisions %entry;
935
} elsif (!$MAY_COMMIT) {
936
# Scan-for-conflicts mode
938
# First, sanity-check the entry. We ignore the result; even if it
939
# failed, we do want to check for conflicts, in the remainder of this
941
validate_branch_contains_named_revisions %entry;
943
# E155015 is SVN_ERR_WC_FOUND_CONFLICT
944
my $expected_error_p = sub {
945
my ($exit_code, $outlines, $errlines) = @_;
948
(grep /svn: E155015:/, @$errlines)
950
merge \%entry, ($entry{depends} ? $expected_error_p : undef);
952
my $output = `$SVN status`;
954
# Pre-1.6 svn's don't have the 7th column, so fake it.
955
$output =~ s/^(......)/$1 /mg if $SVNvsn < 1_006_000;
957
my (@conflicts) = ($output =~ m#^(?:C......|.C.....|......C)\s(.*)#mg);
958
if (@conflicts and !$entry{depends}) {
959
$ERRORS{$entry{id}} //= [\%entry,
960
sprintf "Conflicts on %s%s%s",
967
say STDERR "Conflicts merging $entry{header}!";
970
system "$SVN diff -- " . join ' ', shell_escape @conflicts;
971
} elsif (!@conflicts and $entry{depends}) {
972
# Not a warning since svn-role may commit the dependency without
973
# also committing the dependent in the same pass.
974
print "No conflicts merging $entry{header}, but conflicts were "
975
."expected ('Depends:' header set)\n";
976
} elsif (@conflicts) {
977
say "Conflicts found merging $entry{header}, as expected.";
982
} elsif (defined($skip) ? not $match : $state->{$entry{digest}}) {
984
my $reason = defined($skip) ? "doesn't match pattern"
985
: "remove $STATEFILE to reset";
986
say "Skipping $entry{header} ($reason):";
987
say logsummarysummary \%entry;
988
} elsif ($match or not defined $skip) {
989
# This loop is just a hack because 'goto' panics. The goto should be where
990
# the "next PROMPT;" is; there's a "last;" at the end of the loop body.
993
say "\n>>> $entry{header_start}:";
994
say join ", ", map { "r$_" } @{$entry{revisions}} if @{$entry{revisions}};
995
say "$BRANCHES/$entry{branch}" if $entry{branch};
996
say "--accept=$entry{accept}" if $entry{accept};
998
say for @{$entry{logsummary}};
1000
say for @{$entry{votes}};
1002
say "Vetoes found!" if @vetoes;
1004
# See above for why the while(1).
1005
QUESTION: while (1) {
1006
my $key = $entry{digest};
1007
given (prompt 'Run a merge? [y,l,v,±1,±0,q,e,a, ,N] ',
1008
verbose => 1, extra => qr/[+-]/) {
1010
#validate_branch_contains_named_revisions %entry;
1013
given (prompt "Shall I open a subshell? [ydN] ", verbose => 1) {
1015
# TODO: if $MAY_COMMIT, save the log message to a file (say,
1016
# backport.logmsg in the wcroot).
1018
or warn "Creating an interactive subshell failed ($?): $!"
1021
system("$SVN diff | $PAGER") == 0
1022
or warn "diff failed ($?): $!";
1032
revert verbose => 1;
1038
if ($entry{branch}) {
1039
system "$SVN log --stop-on-copy -v -g -r 0:HEAD -- "
1040
.shell_escape("$BRANCHES/$entry{branch}")." "
1042
} elsif (@{$entry{revisions}}) {
1043
system "$SVN log ".(join ' ', map { "-r$_" } @{$entry{revisions}})
1044
." -- ^/subversion | $PAGER";
1046
die "Assertion failed: entry has neither branch nor revisions:\n",
1047
'[[[', (join ';;', %entry), ']]]';
1053
say for @{$entry{entry}};
1058
exit_stage_left $state, $approved, $votes;
1061
$approved->{$key} = \%entry;
1064
when (/^([+-][01])\s*$/i) {
1065
next QUESTION if warned_cannot_commit "Entering a vote failed";
1066
$votes->{$key} = [$1, \%entry];
1067
say "Your '$1' vote has been recorded." if $VERBOSE;
1071
prompt "Press the 'any' key to continue...\n"
1072
if warned_cannot_commit "Committing this edit later on may fail";
1073
my $original = $entry{raw};
1074
$entry{raw} = edit_string $entry{raw}, $entry{header},
1076
# TODO: parse the edited entry (empty lines, logsummary+votes, etc.)
1077
$votes->{$key} = ['edit', \%entry] # marker for the 2nd pass
1078
if $original ne $entry{raw};
1082
$state->{$entry{digest}}++;
1086
last PROMPT; # Fall off the end of the given/when block.
1089
say "Please use one of the options in brackets (q to quit)!";
205
print "\n>>> The $entry{header}:";
206
print join ", ", map { "r$_" } @{$entry{revisions}};
207
print "$BRANCHES/$entry{branch}" if $entry{branch};
209
print for @{$entry{logsummary}};
211
print for @{$entry{votes}};
213
print "Vetoes found!" if @vetoes;
215
merge %entry if prompt;
1097
die "Unreachable code reached.";
218
# TODO: merge() changes ./STATUS, which we're reading below, but
219
# on my system the loop in main() doesn't seem to care.
225
usage, exit 0 if @ARGV;
227
open STATUS, "<", $STATUS or (usage, exit 1);
1107
my $state = read_state;
1110
if (@ARGV && $ARGV[0] eq '--renormalize') {
1115
backport_usage, exit 0 if @ARGV > ($YES ? 0 : 1) or grep /^--help$/, @ARGV;
1116
backport_usage, exit 0 if grep /^(?:-h|-\?|--help|help)$/, @ARGV;
1117
my $skip = shift; # maybe undef
1118
# assert not defined $skip if $YES;
1120
open STATUS, "<", $STATUS or (backport_usage, exit 1);
229
1122
# Because we use the ':normal' command in Vim...
230
die "A vim with the +ex_extra feature is required"
231
if `${VIM} --version` !~ /[+]ex_extra/;
1123
die "A vim with the +ex_extra feature is required for --renormalize and "
1124
."\$MAY_COMMIT modes"
1125
if ($renormalize or $MAY_COMMIT) and `${VIM} --version` !~ /[+]ex_extra/;
233
1127
# ### TODO: need to run 'revert' here
234
1128
# ### TODO: both here and in merge(), unlink files that previous merges added
235
die "Local mods to STATUS file $STATUS" if `$SVN status -q $STATUS`;
1129
# When running from cron, there shouldn't be local mods. (For interactive
1130
# usage, we preserve local mods to STATUS.)
1131
system("$SVN info $STATUS >/dev/null") == 0
1132
or die "$0: svn error; point \$SVN to an appropriate binary";
1134
check_local_mods_to_STATUS;
1135
renormalize_STATUS if $renormalize;
237
1137
# Skip most of the file
239
last if /^Approved changes/;
244
1138
$/ = ""; # paragraph mode
1140
last if /^Status of \d+\.\d+/;
1143
$SIG{INT} = \&maybe_revert unless $YES;
1144
$SIG{TERM} = \&signal_handler unless $YES;
1146
my $in_approved = 0;
247
1149
my @lines = split /\n/;
249
1151
given ($lines[0]) {
250
1152
# Section header
251
1153
when (/^[A-Z].*:$/i) {
252
print "\n\n=== $lines[0]" unless $YES;
1154
say "\n\n=== $lines[0]" unless $YES;
1155
$in_approved = $lines[0] =~ /^Approved changes/;
1158
when (/^[#\x5b]/i) {
254
1161
# Separator after section header
255
1162
when (/^=+$/i) {
258
1165
# Backport entry?
260
1167
warn "Too many bullets in $lines[0]" and next
261
if grep /^ \*/, @lines[1..$#lines];
1168
if grep /^ *\*/, @lines[1..$#lines];
1169
handle_entry $in_approved, \%approved, \%votes, $state, $lines, $.,
265
warn "Unknown entry '$lines[0]' at $ARGV:$.\n";
1174
warn "Unknown entry '$lines[0]'";
1179
exit_stage_left $state, \%approved, \%votes;
1185
local $Text::Wrap::columns = 79;
1187
$had_local_mods = check_local_mods_to_STATUS;
1190
nominate_usage, exit 0 if @ARGV != 2;
1191
my (@revnums) = (+shift) =~ /(\d+)/g;
1192
my $justification = shift;
1194
die "Unable to proceed." if warned_cannot_commit "Nominating failed";
1196
@revnums = sort { $a <=> $b } keys %{{ map { $_ => 1 } @revnums }};
1197
die "No revision numbers specified" unless @revnums;
1199
# Determine whether a backport branch exists
1200
my ($URL) = `$SVN info` =~ /^URL: (.*)$/m;
1201
die "Can't retrieve URL of cwd" unless $URL;
1203
die unless shell_safe_path_or_url $URL;
1204
system "$SVN info -- $URL-r$revnums[0] 2>/dev/null";
1205
my $branch = ($? == 0) ? basename("$URL-r$revnums[0]") : undef;
1208
my $logmsg = `$SVN propget --revprop -r $revnums[0] --strict svn:log '^/'`;
1209
die "Can't fetch log message of r$revnums[0]: $!" unless $logmsg;
1211
unless ($logmsg =~ s/^(.*?)\n\n.*/$1/s) {
1212
# "* file\n (symbol): Log message."
1214
# Strip before and after the first symbol's log message.
1215
$logmsg =~ s/^.*?: //s;
1216
$logmsg =~ s/^ \x28.*//ms;
1218
# Undo line wrapping. (We'll re-do it later.)
1219
$logmsg =~ s/\s*\n\s+/ /g;
1223
warn "Wrapping [$logmsg]\n";
1224
push @lines, wrap " * ", ' 'x3, join ', ', map "r$_", @revnums;
1225
push @lines, wrap ' 'x3, ' 'x3, split /\n/, $logmsg;
1226
push @lines, " Justification:";
1227
push @lines, wrap ' 'x5, ' 'x5, $justification;
1228
push @lines, " Branch: $branch" if defined $branch;
1229
push @lines, " Votes:";
1230
push @lines, " +1: $AVAILID";
1232
my $raw = join "", map "$_\n", @lines;
1234
# Open the file in line-mode (not paragraph-mode).
1236
tie @STATUS, "Tie::File", $STATUS, recsep => "\n";
1237
my ($index) = grep { $STATUS[$_] =~ /^Veto/ } (0..$#STATUS);
1238
die "Couldn't find where to add an entry" unless $index;
1240
# Add an empty line if needed.
1241
if ($STATUS[$index-1] =~ /\S/) {
1242
splice @STATUS, $index, 0, "";
1247
splice @STATUS, $index, 0, @lines;
1253
system "$SVN diff -- $STATUS";
1254
if (prompt "Commit this nomination? ") {
1255
system "$SVN commit -m 'Nominate r$revnums[0].' -- $STATUS";
1258
elsif (!$had_local_mods or prompt "Revert STATUS (destroying local mods)? ") {
1259
# TODO: we could be smarter and just un-splice the lines we'd added.
1260
system "$SVN revert -- $STATUS";
1267
# Dispatch to the appropriate main().
1268
given (basename($0)) {
1269
when (/^b$|backport/) {
1270
chdir dirname $0 or die "Can't chdir: $!" if /^b$/;
1271
&backport_main(@ARGV);
1273
when (/^n$|nominate/) {
1274
chdir dirname $0 or die "Can't chdir: $!" if /^n$/;
1275
&nominate_main(@ARGV);
1278
&backport_main(@ARGV);
added
removed
tools/dist/backport.pl
