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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
|
#!/usr/bin/perl
#
# buildah-vendor-treadmill - daily vendor of latest-buildah onto latest-podman
#
package Podman::BuildahVendorTreadmill;
use v5.14;
use utf8;
use open qw( :encoding(UTF-8) :std );
use strict;
use warnings;
use File::Temp qw(tempfile);
use JSON;
use LWP::UserAgent;
(our $ME = $0) =~ s|.*/||;
our $VERSION = '0.2';
# For debugging, show data structures using DumpTree($var)
#use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
###############################################################################
# BEGIN user-customizable section
# Page describing this process in much more detail
our $Docs_URL =
'https://github.com/containers/podman/wiki/Buildah-Vendor-Treadmill';
# github path to buildah
our $Buildah = 'github.com/containers/buildah';
# FIXME FIXME FIXME: add 'main'? I hope we never need this script for branches.
our $Treadmill_PR_Title = 'DO NOT MERGE: buildah vendor treadmill';
# Github API; this is where we query to find out the active treadmill PR
our $API_URL = 'https://api.github.com/graphql';
# Temporary file used to preserve current treadmill patches. This file
# should only exist very briefly while we perform branch operations.
our $Patch_File = "0000-$ME.patch";
# Use colors if available and if stdout is a tty
our $C_Highlight = '';
our $C_Warning = '';
our $C_Reset = '';
eval '
use Term::ANSIColor;
if (-t 1) {
$C_Highlight = color("green");
$C_Warning = color("bold red");
$C_Reset = color("reset");
}
$SIG{__WARN__} = sub { print STDERR $C_Warning, "@_", $C_Reset; };
';
# END user-customizable section
###############################################################################
###############################################################################
# BEGIN boilerplate args checking, usage messages
sub usage {
print <<"END_USAGE";
Usage: $ME [OPTIONS] [--sync | --pick ]
$ME is (2022-04-20) **EXPERIMENTAL**
$ME is intended to solve the problem of vendoring
buildah into podman.
Call me with one of two options:
--sync The usual case. Mostly used by Ed. Called from a
development branch, this just updates everything so
we vendor in latest-buildah (main) on top of
latest-podman (main). With a few sanity checks.
--pick Used for really-truly vendoring in a new buildah; will
cherry-pick a commit on your buildah-vendor working branch
For latest documentation and best practices, please see:
$Docs_URL
OPTIONS:
--help display this message
--version display program name and version
END_USAGE
exit;
}
# Command-line options. Note that this operates directly on @ARGV !
our %action;
our $debug = 0;
our $force_old_main = 0; # in --pick, proceeds even if main is old
our $force_testing = 0; # in --sync, test even no podman/buildah changes
our $verbose = 0;
our $NOT = ''; # print "blahing the blah$NOT\n" if $debug
sub handle_opts {
use Getopt::Long;
GetOptions(
'sync' => sub { $action{sync}++ },
'pick' => sub { $action{pick}++ },
'force-old-main' => \$force_old_main,
'force-testing' => \$force_testing,
'debug!' => \$debug,
'dry-run|n!' => sub { $NOT = ' [NOT]' },
'verbose|v' => \$verbose,
help => \&usage,
version => sub { print "$ME version $VERSION\n"; exit 0 },
) or die "Try `$ME --help' for help\n";
}
# END boilerplate args checking, usage messages
###############################################################################
############################## CODE BEGINS HERE ###############################
# The term is "modulino".
__PACKAGE__->main() unless caller();
# Main code.
sub main {
# Note that we operate directly on @ARGV, not on function parameters.
# This is deliberate: it's because Getopt::Long only operates on @ARGV
# and there's no clean way to make it use @_.
handle_opts(); # will set package globals
# Fetch command-line arguments. Barf if too many.
# FIXME: if called with arg, that's the --sync branch?
# FIXME: if called with --pick + arg, that's the PR?
die "$ME: Too many arguments; try $ME --help\n" if @ARGV;
my @action = keys(%action);
die "$ME: Please invoke me with one of --sync or --pick\n"
if ! @action;
die "$ME: Please invoke me with ONLY one of --sync or --pick\n"
if @action > 1;
my $handler = __PACKAGE__->can("do_@action")
or die "$ME: No handler available for --@action\n";
# We've validated the command-line args. Before running action, check
# that repo is clean. None of our actions can be run on a dirty repo.
assert_clean_repo();
$handler->();
}
###############################################################################
# BEGIN sync and its helpers
sub do_sync {
# Preserve current branch name, so we can come back after switching to main
my $current_branch = git_current_branch();
# Branch HEAD must be the treadmill commit.
my $commit_message = git('log', '-1', '--format=%s', 'HEAD');
print "[$commit_message]\n" if $verbose;
$commit_message =~ /buildah.*treadmill/
or die "$ME: HEAD must be a 'buildah treadmill' commit.\n";
# ...and previous commit must be a scratch buildah vendor
$commit_message = git('log', '-1', '--format=%B', 'HEAD^');
$commit_message =~ /DO NOT MERGE.* vendor in buildah.*JUNK COMMIT/s
or die "$ME: HEAD^ must be a DO NOT MERGE / JUNK COMMIT commit\n";
assert_buildah_vendor_commit('HEAD^');
# Looks good so far.
my $buildah_old = vendored_buildah();
print "-> buildah old = $buildah_old\n";
# Pull main, and pivot back to this branch
pull_main();
git('checkout', '-q', $current_branch);
# Preserve local patches
git('format-patch', "--output=$Patch_File", 'HEAD^');
progress("Treadmill patches saved to $Patch_File");
#
# Danger Will Robinson! This is where it gets scary: a failure here
# can leave us in a state where we could lose the treadmill patches.
# Proceed with extreme caution.
#
local $SIG{__DIE__} = sub {
print STDERR $C_Warning, "@_", <<"END_FAIL_INSTRUCTIONS";
This is not something I can recover from. Your human judgment is needed.
You will need to recover from this manually. Your best option is to
look at the source code for this script.
Your treadmill patches are here: $Patch_File
END_FAIL_INSTRUCTIONS
exit 1;
};
my $forkpoint = git_forkpoint();
my $rebased;
# Unlikely to fail
git('reset', '--hard', 'HEAD^^');
# Rebase branch. Also unlikely to fail
my $main_commit = git('rev-parse', 'main');
if ($forkpoint eq $main_commit) {
progress("[Already rebased on podman main]");
}
else {
progress("Rebasing on podman main...");
git('rebase', '--empty=keep', 'main');
$rebased = 1;
}
# This does have a high possibility of failing.
progress("Vendoring in buildah...");
system('go', 'mod', 'edit', '--require' => "${Buildah}\@main") == 0
or die "$ME: go mod edit failed";
system('make', 'vendor') == 0
or die "$ME: make vendor failed";
my $buildah_new = vendored_buildah();
print "-> buildah new = $buildah_new\n";
# Tweak .cirrus.yml so we run bud tests first in CI (to fail fast).
tweak_cirrus_test_order();
# 'make vendor' seems to git-add files under buildah itself, but not
# under other changed modules. Add those now, otherwise we fail
# the dirty-tree test in CI.
if (my @v = git('status', '--porcelain', '--untracked=all', 'vendor')) {
if (my @untracked = grep { /^\?\?\s/ } @v) {
my %repos = map {
s!^.*?vendor/[^/]+/([^/]+/[^/]+)/.*$!$1!; $_ => 1;
} @untracked;
my $repos = join(', ', sort keys %repos);
progress("Adding untracked files under $repos");
git('add', 'vendor');
}
}
# Commit everything.
git('commit', '-as', '-m', <<"END_COMMIT_MESSAGE");
[DO NOT MERGE] vendor in buildah \@ $buildah_new
This is a JUNK COMMIT from $ME v$VERSION.
DO NOT MERGE. This is just a way to keep the buildah-podman
vendoring in sync. Refer to:
$Docs_URL
END_COMMIT_MESSAGE
# And, finally, this has the highest possibility of failing
progress('Reapplying preserved patches');
git('am', $Patch_File);
# It worked! Clean up: remove our local die() handler and the patch file
undef $SIG{__DIE__};
unlink $Patch_File;
# if buildah is unchanged, and we did not pull main, exit cleanly
my $change_message = '';
if ($buildah_new eq $buildah_old) {
if (! $rebased) {
$change_message = "Nothing has changed (same buildah, same podman).";
if ($force_testing) {
$change_message .= " Testing anyway due to --force-testing.";
}
else {
progress($change_message);
progress("Not much point to testing this, but use --force-testing to continue.");
exit 0;
}
}
else {
$change_message = "Podman has bumped, but Buildah is unchanged. There's probably not much point to testing this.";
}
}
else {
my $samenew = ($rebased ? 'new' : 'same');
$change_message = "New buildah, $samenew podman. Good candidate for pushing.";
}
progress($change_message);
build_and_check_podman();
progress("All OK. It's now up to you to 'git push --force'");
progress(" --- Reminder: $change_message");
}
###############
# pull_main # Switch to main, and pull latest from github
###############
sub pull_main {
progress("Pulling podman main...");
git('checkout', '-q', 'main');
git('pull', '-r', git_upstream(), 'main');
}
#############################
# tweak_cirrus_test_order # Run bud tests first, to fail fast & early
#############################
sub tweak_cirrus_test_order {
my $cirrus_yml = '.cirrus.yml';
my $tmpfile = "$cirrus_yml.tmp.$$";
unlink $tmpfile;
progress("Tweaking test order in $cirrus_yml to run bud tests early");
open my $in, '<', $cirrus_yml
or do {
warn "$ME: Cannot read $cirrus_yml: $!\n";
warn "$ME: Will continue anyway\n";
return;
};
open my $out, '>'. $tmpfile
or die "$ME: Cannot create $tmpfile: $!\n";
my $current_task = '';
my $in_depend;
while (my $line = <$in>) {
chomp $line;
if ($line =~ /^(\S+)_task:$/) {
$current_task = $1;
undef $in_depend;
}
elsif ($line =~ /^(\s+)depends_on:$/) {
$in_depend = $1;
}
elsif ($in_depend && $line =~ /^($in_depend\s+-\s+)(\S+)/) {
if ($current_task eq 'buildah_bud_test') {
# Buildah bud test now depends on validate, so it runs early
$line = "${1}validate";
}
elsif ($2 eq 'validate' && $current_task ne 'success') {
# Other tests that relied on validate, now rely on bud instead
$line = "${1}buildah_bud_test";
}
}
else {
undef $in_depend;
}
print { $out } $line, "\n";
}
close $in;
close $out
or die "$ME: Error writing $tmpfile: $!\n";
chmod 0644 => $tmpfile;
rename $tmpfile => $cirrus_yml
or die "$ME: Could not rename $tmpfile: $!\n";
}
############################
# build_and_check_podman # Run quick (local) sanity checks before pushing
############################
sub build_and_check_podman {
my $errs = 0;
# Confirm that we can still build podman
progress("Running 'make' to confirm that podman builds cleanly...");
system('make') == 0
or die "$ME: 'make' failed with new buildah. Cannot continue.\n";
# See if any new options need man pages. (C_Warning will highlight errs)
progress('Cross-checking man pages...');
print $C_Warning;
$errs += system('hack/xref-helpmsgs-manpages');
print $C_Reset;
# Confirm that buildah-bud patches still apply. This requires knowing
# the name of the directory created by the bud-tests script.
progress("Confirming that buildah-bud-tests patches still apply...");
system('rm -rf test-buildah-*');
if (system('test/buildah-bud/run-buildah-bud-tests', '--no-test')) {
# Error
++$errs;
warn "$ME: Leaving test-buildah- directory for you to investigate\n";
}
else {
# Patches apply cleanly. Clean up
system('rm -rf test-buildah-*');
}
return if !$errs;
warn <<"END_WARN";
$ME: Errors found. I have to stop now for you to fix them.
Your best bet now is:
1) Find and fix whatever needs to be fixed; then
2) git commit -am'fixme-fixme'; then
3) git rebase -i main:
a) you are now in an editor window
b) move the new fixme-fixme commit up a line, to between the
'buildah vendor treadmill' and 'vendor in buildah @ ...' lines
c) change 'pick' to 'squash' (or just 's')
d) save & quit to continue the rebase
e) back to a new editor window
f) change the commit message: remove fixme-fixme, add a description
of what you actually fixed. If possible, reference the PR (buildah
or podman) that introduced the failure
g) save & quit to continue the rebase
Now, for good measure, rerun this script.
For full documentation, refer to
$Docs_URL
END_WARN
exit 1;
}
# END sync and its helpers
###############################################################################
# BEGIN pick and its helpers
#
# This is what gets used on a real vendor-new-buildah PR
sub do_pick {
my $current_branch = git_current_branch();
# Confirm that current branch is a buildah-vendor one
assert_buildah_vendor_commit('HEAD');
progress("HEAD is a buildah vendor commit. Good.");
# Identify and pull the treadmill PR
my $treadmill_pr = treadmill_pr();
my $treadmill_branch = "$ME/pr$treadmill_pr/tmp$$";
progress("Fetching treadmill PR $treadmill_pr into $treadmill_branch");
git('fetch', '-q', git_upstream(), "pull/$treadmill_pr/head:$treadmill_branch");
# Compare merge bases of our branch and the treadmill one
progress("Checking merge bases");
check_merge_bases($treadmill_pr, $treadmill_branch);
# read buildah go.mod from it, and from current tree, and compare
my $buildah_on_treadmill = vendored_buildah($treadmill_branch);
my $buildah_here = vendored_buildah();
if ($buildah_on_treadmill ne $buildah_here) {
warn "$ME: Warning: buildah version mismatch:\n";
warn "$ME: on treadmill: $buildah_on_treadmill\n";
warn "$ME: on this branch: $buildah_here\n";
# FIXME: should this require --force? A yes/no prompt?
# FIXME: I think not, because usual case will be a true tagged version
warn "$ME: Continuing anyway\n";
}
cherry_pick($treadmill_pr, $treadmill_branch);
# Clean up
git('branch', '-D', $treadmill_branch);
build_and_check_podman();
progress("Looks good! Please 'git commit --amend' and edit commit message before pushing.");
}
##################
# treadmill_pr # Returns ID of open podman PR with the desired subject
##################
sub treadmill_pr {
my $query = <<'END_QUERY';
{
search(
query: "buildah vendor treadmill repo:containers/podman",
type: ISSUE,
first: 10
) {
edges { node { ... on PullRequest { number state title } } }
}
}
END_QUERY
my $ua = LWP::UserAgent->new;
$ua->agent("$ME " . $ua->agent); # Identify ourself
my %headers = (
'Accept' => "application/vnd.github.antiope-preview+json",
'Content-Type' => "application/json",
);
# Use github token if available, but don't require it. (All it does is
# bump up our throttling limit, which shouldn't be an issue) (unless
# someone invokes this script hundreds of times per minute).
if (my $token = $ENV{GITHUB_TOKEN}) {
$headers{Authorization} = "bearer $token";
}
$ua->default_header($_ => $headers{$_}) for keys %headers;
# Massage the query: escape quotes, put it all in one line, collapse spaces
$query =~ s/\"/\\"/g;
$query =~ s/\n/\\n/g;
$query =~ s/\s+/ /g;
# ...and now one more massage
my $postquery = qq/{ "query": \"$query\" }/;
print $postquery, "\n" if $debug;
my $res = $ua->post($API_URL, Content => $postquery);
if ((my $code = $res->code) != 200) {
print $code, " ", $res->message, "\n";
exit 1;
}
# Got something. Confirm that it has all our required fields
my $content = decode_json($res->content);
use Data::Dump; dd $content if $debug;
exists $content->{data}
or die "$ME: No '{data}' section in response\n";
exists $content->{data}{search}
or die "$ME: No '{data}{search}' section in response\n";
exists $content->{data}{search}{edges}
or die "$ME: No '{data}{search}{edges}' section in response\n";
# Confirm that there is exactly one such PR
my @prs = @{ $content->{data}{search}{edges} };
@prs > 0
or die "$ME: WEIRD! No 'buildah vendor treadmill' PRs found!\n";
@prs = grep { $_->{node}{title} eq $Treadmill_PR_Title } @prs
or die "$ME: No PRs found with title '$Treadmill_PR_Title'\n";
@prs = grep { $_->{node}{state} eq 'OPEN' } @prs
or die "$ME: Found '$Treadmill_PR_Title' PRs, but none are OPEN\n";
@prs == 1
or die "$ME: Multiple OPEN '$Treadmill_PR_Title' PRs found!\n";
# Yay. Found exactly one.
return $prs[0]{node}{number};
}
#######################
# check_merge_bases # It's OK if our branch is newer than treadmill
#######################
sub check_merge_bases {
my $treadmill_pr = shift; # e.g., 12345
my $treadmill_branch = shift; # e.g., b-v-p/pr12345/tmpNNN
# Fetch latest main, for accurate comparison
git('fetch', '-q', git_upstream(), 'main');
my $forkpoint_cur = git_forkpoint();
my $forkpoint_treadmill = git_forkpoint($treadmill_branch);
print "fork cur: $forkpoint_cur\nfork tm: $forkpoint_treadmill\n"
if $debug;
if ($forkpoint_cur eq $forkpoint_treadmill) {
progress("Nice. This branch is up-to-date wrt treadmill PR $treadmill_pr");
return;
}
# They differ.
if (git_is_ancestor($forkpoint_cur, $forkpoint_treadmill)) {
warn <<"END_WARN";
$ME: treadmill PR $treadmill_pr is based on
a newer main than this branch. This means it might have
more up-to-date patches.
END_WARN
if ($force_old_main) {
warn "$ME: Proceeding due to --force-old-main\n";
return;
}
# Cannot continue. Clean up side branch, and bail.
git('branch', '-D', $treadmill_branch);
warn "$ME: You might want to consider rebasing on latest main.\n";
warn "$ME: Aborting. Use --force-old-main to continue without rebasing.\n";
exit 1;
}
else {
progress("Your branch is based on a newer main than treadmill PR $treadmill_pr. This is usually OK.");
}
}
#################
# cherry_pick # cherry-pick a commit, updating its commit message
#################
sub cherry_pick {
my $treadmill_pr = shift; # e.g., 12345
my $treadmill_branch = shift; # e.g., b-v-p/pr12345/tmpNNN
progress("Cherry-picking from $treadmill_pr");
# Create a temp script. Do so in /var/tmp because sometimes $TMPDIR
# (e.g. /tmp) has noexec.
my ($fh, $editor) = tempfile( "$ME.edit-commit-message.XXXXXXXX", DIR => "/var/tmp" );
printf { $fh } <<'END_EDIT_SCRIPT', $ME, $VERSION, $treadmill_pr;
#!/bin/bash
if [[ -z "$1" ]]; then
echo "FATAL: Did not get called with an arg" >&2
exit 1
fi
msgfile=$1
if [[ ! -e $msgfile ]]; then
echo "FATAL: git-commit file does not exist: $msgfile" >&2
exit 1
fi
tmpfile=$msgfile.tmp
rm -f $tmpfile
cat >$tmpfile <<EOF
WIP: Fixes for vendoring Buildah
This commit was automatically cherry-picked
by %s v%s
from the buildah vendor treadmill PR, #%s
/vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
> The git commit message from that PR is below. Please review it,
> edit as necessary, then remove this comment block.
\^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
EOF
# Strip the "DO NOT MERGE" header from the treadmill PR, print only
# the "Changes as of YYYY-MM-DD" and subsequent lines
sed -ne '/^Changes as of/,$ p' <$msgfile >>$tmpfile
mv $tmpfile $msgfile
END_EDIT_SCRIPT
close $fh
or die "$ME: Error writing $editor: $!\n";
chmod 0755 => $editor;
local $ENV{EDITOR} = $editor;
git('cherry-pick', '--allow-empty', '--edit', $treadmill_branch);
unlink $editor;
}
# END pick and its helpers
###############################################################################
# BEGIN general-purpose helpers
##############
# progress # Progris riport Dr Strauss says I shud rite down what I think
##############
sub progress {
print $C_Highlight, "|\n+---> @_\n", $C_Reset;
}
#######################
# assert_clean_repo # Don't even think of running with local changes
#######################
sub assert_clean_repo {
# Our patch file should only exist for brief moments during a sync run.
# If it exists at any other time, something has gone very wrong.
if (-e $Patch_File) {
warn <<"END_WARN";
$ME: File exists: $Patch_File
This means that something went very wrong during an earlier sync run.
Your git branch may be in an inconsistent state. Your work to date
may be lost. This file may be your only hope of recovering it.
This is not something a script can resolve. You need to look at this
file, compare to your git HEAD, and manually reconcile any differences.
END_WARN
exit 1;
}
# OK so far. Now check for modified files.
if (my @changed = git('status', '--porcelain', '--untracked=no')) {
warn "$ME: Modified files in repo:\n";
warn " $_\n" for @changed;
exit 1;
}
# ...and for untracked files under vendor/
if (my @v = git('status', '--porcelain', '--untracked=all', 'vendor')) {
warn "$ME: Untracked vendor files:\n";
warn " $_\n" for @v;
exit 1;
}
}
########################
# git_current_branch # e.g., 'vendor_buildah'
########################
sub git_current_branch() {
my $b = git('rev-parse', '--abbrev-ref=strict', 'HEAD');
# There is no circumstance in which we can ever be called from main
die "$ME: must run from side branch, not main\n" if $b eq 'main';
return $b;
}
###################
# git_forkpoint # Hash at which branch (default: cur) branched from main
###################
sub git_forkpoint {
return git('merge-base', '--fork-point', 'main', @_);
}
#####################
# git_is_ancestor # Is hash1 an ancestor of hash2?
#####################
sub git_is_ancestor {
# Use system(), not git(), because we don't want to abort on exit status
my $rc = system('git', 'merge-base', '--is-ancestor', @_);
die "$ME: Cannot continue\n" if $? > 256; # e.g., Not a valid object
# Translate shell 0/256 status to logical 1/0
return !$rc;
}
##################
# git_upstream # Name of true github upstream
##################
sub git_upstream {
for my $line (git('remote', '-v')) {
my ($remote, $url, $type) = split(' ', $line);
if ($url =~ m!github\.com.*containers/(podman|libpod)!) {
if ($type =~ /fetch/) {
return $remote;
}
}
}
die "$ME: did not find a remote with 'github.com/containers/podman'\n";
}
#########
# git # Run a git command
#########
sub git {
my @cmd = ('git', @_);
print "\$ @cmd\n" if $verbose || $debug;
open my $fh, '-|', @cmd
or die "$ME: Cannot fork: $!\n";
my @results;
while (my $line = <$fh>) {
chomp $line;
push @results, $line;
}
close $fh
or die "$ME: command failed: @cmd\n";
return wantarray ? @results : join("\n", @results);
}
##################################
# assert_buildah_vendor_commit # Fails if input arg is not a buildah vendor
##################################
sub assert_buildah_vendor_commit {
my $ref = shift; # in: probably HEAD or HEAD^
my @deltas = git('diff', '--name-only', "$ref^", $ref);
# It's OK if there are no deltas, e.g. immediately after a buildah vendor PR
return if !@deltas;
# It's OK if there are more modified files than just these.
# It's not OK if any of these are missing.
my @expect = qw(go.mod go.sum vendor/modules.txt);
my @missing;
for my $expect (@expect) {
if (! grep { $_ eq $expect } @deltas) {
push @missing, "$expect is unchanged";
}
}
if (! grep { m!^vendor/\Q$Buildah\E/! } @deltas) {
push @missing, "no changes under $Buildah";
}
return if !@missing;
warn "$ME: $ref does not look like a buildah vendor commit:\n";
warn "$ME: - $_\n" for @missing;
die "$ME: Cannot continue\n";
}
######################
# vendored_buildah # Returns currently-vendored buildah
######################
sub vendored_buildah {
my $gomod_file = 'go.mod';
my @gomod;
if (@_) {
# Called with a branch argument; fetch that version of go.mod
$gomod_file = "@_:$gomod_file";
@gomod = git('show', $gomod_file);
}
else {
# No branch argument, read file
open my $fh, '<', $gomod_file
or die "$ME: Cannot read $gomod_file: $!\n";
while (my $line = <$fh>) {
chomp $line;
push @gomod, $line;
}
close $fh;
}
for my $line (@gomod) {
if ($line =~ m!^\s+\Q$Buildah\E\s+(\S+)!) {
return $1;
}
}
die "$ME: Could not find buildah in $gomod_file!\n";
}
# END general-purpose helpers
###############################################################################
|