rewrite some demeter-apt scripts to handle binary builds better

4 files changed, 226 insertions, 125 deletions

diff --git a/.mrconfig.in b/.mrconfig.in
index 5c3f481f..9f632323 100644
--- a/.mrconfig.in
+++ b/.mrconfig.in
@@ -504,20 +504,20 @@ skip = lazy
 #       $ /opt/emacs-snapshot/bin/emacs -nw --debug-init
 #
 #     % cd ~/src/emacs-snapshot
-#     % rebuild-for-athena unstable              # if develacc test was successful
+#     % reprepro-rebuilder --release         # if develacc test was successful
 #
-#     If need to back out before rebuild-for-athena:
+#     If need to back out before reprepro-rebuilder:
 #         % cd ~/src/emacs-snapshot && git reset --hard demeter/athena/unstable
 #
 #     It is important to test local installability of the new .deb, probably
-#     in develacc or a sid chroot, before running release-to-athena, because
+#     in develacc or a sid chroot, before adding to demeter-apt, because
 #     running the rebased 'melete' branch doesn't detect any byte compilation
 #     issues against my current selection of elpa-* packages.
 #
 # 'athena/CODENAME-bpo' branch:
 #
 #     Backported from athena/unstable.  Automatically updated by
-#     rebuild-for-athena when updating athena/unstable as described above.
+#     reprepro-rebuilder when updating athena/unstable as described above.
 #
 # See also bin/emacsclient wrapper script in dotfiles.git.
 [src/emacs]
diff --git a/bin/rebuild-for-athena b/bin/rebuild-for-athena
deleted file mode 100755
index 99c9acfe..00000000
--- a/bin/rebuild-for-athena
+++ /dev/null
@@ -1,103 +0,0 @@
-#!/usr/bin/perl
-
-use 5.028;
-use strict;
-use warnings;
-
-use autodie ":all";
-
-use File::Basename qw(basename);
-use Git::Wrapper;
-use Getopt::Long;
-use Term::UI;
-
-my ($want_minus, $want_plus) = (0, 0);
-GetOptions
-  "minus" => \$want_minus,
-  "plus"  => \$want_plus;
-die "invalid options" if $want_minus and $want_plus;
-$want_minus = 1 unless $want_minus or $want_plus;
-die "usage: " . basename $0 . " [--minus|--plus] CODENAME\n" unless @ARGV == 1;
-my $codename = pop @ARGV;
-my $git      = Git::Wrapper->new(".");
-my $term     = Term::ReadLine->new("brand");
-die "git commit first\n" unless $git->RUN("status", { porcelain => 1 }) == 0;
-
-if ($codename eq "bullseye-backports") {
-    rebuild_for_suite("bullseye-backports", "~bpo11+1");
-    system "release-to-athena";
-} elsif ($codename =~ /-backports$/) {
-    die "unknown backports suite";
-} else {
-    rebuild_for_suite($codename);
-    system "release-to-athena";
-
-    # if we just built for unstable, also offer to rebuild for stable-backports
-    if ($codename eq "unstable") {
-	exit unless
-	  $term->ask_yn(prompt => "also rebuild for bullseye-backports?");
-
-	rebuild_for_suite("bullseye-backports", "~bpo11+1");
-	system "release-to-athena";
-    }
-}
-
-sub rebuild_for_suite {
-    my $codename = shift;
-    my $local    = shift;
-    my $branch   = "athena/$codename";
-
-    my $local_branch_exists = $git->for_each_ref("[r]efs/heads/$branch") != 0;
-    my @remote_branches     = map {
-        my (undef, undef, $ref) = split;
-        $ref =~ s{^refs/remotes/}{};
-        $ref
-      }
-      grep {
-        m{/$branch$}
-      } $git->for_each_ref("refs/remotes");
-
-    $local .= "~athena" if $want_minus;
-    $local .= "+athena" if $want_plus;
-
-    if ($local_branch_exists) {
-        my ($branch_to_build) = $git->symbolic_ref("HEAD");
-        $branch_to_build =~ s{^refs/heads/}{};
-
-        # are we already on the requisite branch and this script is being used
-        # to release?
-        if ($branch eq $branch_to_build) {
-            chomp(my $dist = `dpkg-parsechangelog -SDistribution`);
-            if ($dist eq "UNRELEASED") {
-                system "dch", "-r", "-D$codename";
-            } else {
-                say "Hmm, already on $branch and changelog is not UNRELEASED";
-                exit 1;
-            }
-        } else {
-            $git->checkout($branch);
-	    system "dgit", "setup-mergechangelogs";
-            $git->merge($branch_to_build);
-            system "dch", "-D$codename", "-l$local",
-              "Rebuild for athena's apt repository.";
-            system qw(dch -r);
-        }
-    } else {
-        if (@remote_branches) {
-            say "I want to create branch $branch, "
-              . "but these remote branches already exist:";
-            say for @remote_branches;
-            say
-"maybe you want to check out or `git branchmove get` one of those";
-            exit 1;
-        } else {
-            $git->checkout("-b", $branch);
-            system "dch", "-D$codename", "-l$local",
-              "Rebuild for athena's apt repository.";
-            system qw(dch -r);
-        }
-    }
-
-    $git->add("debian/changelog");
-    $git->commit({ message => "Rebuild for athena's apt repository" });
-}
diff --git a/bin/release-to-athena b/bin/release-to-athena
deleted file mode 100755
index 0147febc..00000000
--- a/bin/release-to-athena
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/usr/bin/perl
-
-use 5.028;
-use strict;
-use warnings;
-
-use autodie ":all";
-use Term::UI;
-
-system qw(dgit sbuild --no-run-lintian);
-
-my $term = Term::ReadLine->new("brand");
-exit unless $term->ask_yn(prompt => "run athena-apt-add and git tag?");
-
-chomp(my $version = `dpkg-parsechangelog -SVersion`);
-chomp(my $package = `dpkg-parsechangelog -SSource`);
-system "athena-apt-add", "../${package}_${version}_multi.changes";
-system qw(gbp buildpackage --git-tag-only --git-ignore-branch);
diff --git a/bin/reprepro-rebuilder b/bin/reprepro-rebuilder
new file mode 100755
index 00000000..50aaf38e
--- /dev/null
+++ b/bin/reprepro-rebuilder
@@ -0,0 +1,222 @@
+#!/usr/bin/perl
+
+# reprepro-rebuilder -- rebuild Debian packages for a local repository
+
+# Copyright (C) 2020-2022  Sean Whitton <spwhitton@spwhitton.name>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use 5.032;
+use strict;
+use warnings;
+use autodie ":all";
+
+use Cwd;
+use File::Basename;
+use File::Spec::Functions "catfile", "rel2abs";
+use File::Temp "tempdir";
+use Array::Utils "array_minus";
+use Git::Wrapper;
+use Getopt::Long;
+use Term::UI;
+use File::chdir;
+
+our $repo         = "$ENV{HOME}/lib/athena-apt";
+our $prefix       = "athena";
+our @dists        = qw(bullseye bullseye-backports unstable experimental);
+our $bpo_dist     = "bullseye-backports";
+our $bpo_dist_num = 11;
+
+my $us = basename $0;
+
+my ($minus, $plus, $release, $build);
+GetOptions
+  "minus"       => \$minus,
+  "plus"        => \$plus,
+  "release"     => \$release,
+  "wanna-build" => \$build;
+$plus or $release or $build or $minus++;
+unless (grep($_, $minus, $plus, $release, $build) == 1
+    and ($minus || $plus) && @ARGV == 1 || ($release || $build) && !@ARGV) {
+    say STDERR "usage:";
+    say STDERR "  $us [--minus|--plus] CODENAME|SUITE";
+    say STDERR "  $us --release|--wanna-build";
+    exit 255;
+}
+-d $repo or die "$repo doesn't exist?";
+my $git = Git::Wrapper->new(getcwd);
+$build || $git->RUN("status", { porcelain => 1 }) && die "git commit first\n";
+my $term   = Term::ReadLine->new("brand");
+my $suffix = $plus ? "+$prefix" : "~$prefix";
+
+if ($minus || $plus) {
+    my $codename = shift @ARGV;
+    prepare($codename, $suffix);
+    $codename eq "unstable" and maybe_bpo();
+    maybe_build();
+} elsif ($release) {
+    release();
+    my ($branch) = $git->rev_parse({ abbrev_ref => 1 }, "HEAD");
+    $branch eq "$prefix/unstable" and maybe_bpo();
+    maybe_build();
+} elsif ($build) {
+    build();
+}
+
+sub maybe_bpo {
+    $term->ask_yn(prompt => "Also prepare rebuild for $bpo_dist?")
+      and prepare($bpo_dist, $suffix)
+}
+
+sub maybe_build {
+    $term->ask_yn(prompt => "Populate ${repo}'s binary builds?")
+      ? build()
+      : say "Okay, say '$us --wanna-build' when you're ready."
+}
+
+#### BRANCHING, MERGING, NEW CHANGELOG ENTRIES ####
+sub prepare {
+    my ($codename, $suffix) = @_;
+    my $branch = "$prefix/$codename";
+
+    if ($codename eq $bpo_dist) {
+        $suffix = "~bpo$bpo_dist_num+1$suffix";
+    } elsif ($codename =~ /-backports$/) {
+        die "unknown backports suite $codename";
+    }
+
+    my @matching_remote_branches = map { (split)[2] =~ s{^refs/remotes/}{}r }
+      grep m{/$branch$}, $git->for_each_ref("refs/remotes/");
+
+    if ($git->for_each_ref("[r]efs/heads/$branch")) {
+        my ($current) = $git->rev_parse({ abbrev_ref => 1 }, "HEAD");
+        if ($branch eq $current) {
+            say STDERR
+              "Already on $branch, don't know what you want to rebuild.";
+            say STDERR "Maybe you wanted '$us --release' to build a dsc.";
+            exit 1;
+        } else {
+            $git->checkout($branch);
+            system "dgit", "setup-mergechangelogs";
+            $git->merge($current);
+        }
+    } elsif (@matching_remote_branches) {
+        say STDERR "I want to create branch $branch,"
+          . " but these remote branches already exist:";
+        say STDERR "  $_" for @matching_remote_branches;
+        say STDERR "maybe you want to check out"
+          . " or 'git branchmove get' one of those.";
+        exit 1;
+    } else {
+        $git->checkout("-b", $branch);
+    }
+
+    system "dch", "-l$suffix", "Rebuild for $prefix apt repository.";
+    $git->add("debian/changelog");
+    $git->commit({ message => "Rebuild for $prefix apt repository" });
+
+    {
+        no autodie;
+        $term->ask_yn(prompt => "Build binary package for local testing?")
+          and system qw(dgit sbuild --no-run-lintian -A -d), $codename;
+    }
+
+    $term->ask_yn(prompt => "Tag release & add dsc to reprepro?")
+      ? release(1)
+      : say "Okay, say '$us --release' when you're ready.";
+}
+
+#### 'dch -r' & ADDING SOURCE PACKAGES TO REPREPRO ####
+sub release {
+    my $amend = shift // 0;
+    my ($branch) = $git->symbolic_ref("HEAD");
+    (my $codename = $branch) =~ s{^refs/heads/$prefix/}{};
+    chomp(my $dist = `dpkg-parsechangelog -SDistribution`);
+
+    if ($dist eq "UNRELEASED") {
+        system "dch", "-D$codename", "-r";
+        $git->add("debian/changelog");
+        $git->commit({
+            amend   => $amend,
+            message => $amend
+            ? "Rebuild for $prefix apt repository"
+            : "Release rebuild to $prefix apt repository"
+        });
+    } elsif ($dist ne $codename) {
+        die "d/changelog has $dist, but branch name indicates $codename\n";
+    }
+
+    system "dgit", "build-source";
+    system qw(gbp buildpackage --git-tag-only --git-ignore-branch);
+    chomp(my $package = `dpkg-parsechangelog -SSource`);
+    chomp(my $version = `dpkg-parsechangelog -SVersion`);
+    reprepro("includedsc", $codename, rel2abs "../${package}_${version}.dsc");
+}
+
+#### POPULATING REPREPRO BINARY PACKAGES ####
+sub build {
+    my (@succeeded, @failed);
+    chomp(my $arch = `dpkg --print-architecture`);
+
+    # Add "Tracking: minimal" for each distribution's stanza in reprepro conf.
+    reprepro("retrack", @dists);
+
+    foreach my $dist (@dists) {
+        my @all_needed = map dsc2rel($_),
+          reprepro("build-needing", $dist, "all");
+        my @arch_needed = map dsc2rel($_),
+          reprepro("build-needing", $dist, $arch);
+        next unless @all_needed or @arch_needed;
+        @arch_needed = array_minus @arch_needed, @all_needed;
+
+        my $build_debs = sub {
+            my @args = ("-d", $dist);
+            shift and push @args, "-A";
+            for (@_) {
+                my $basename = basename $_;
+                {
+                    no autodie;
+                    system "sbuild", "--no-run-lintian", @args, $basename
+                }
+                $? == 0
+                  ? push(@succeeded, $basename)
+                  : push(@failed,    $basename);
+            }
+        };
+
+        local $CWD = $repo;
+        my $temp = tempdir CLEANUP => 1;
+        system "dcmd", "cp", $_, $temp for @all_needed, @arch_needed;
+
+        local $CWD = $temp;
+        $build_debs->(1, @all_needed);
+        $build_debs->(0, @arch_needed);
+
+        {
+            no autodie;
+            # May fail if the .deb is already present from another build.
+            reprepro("includedeb", $dist, $_) for <$temp/*.deb>;
+        }
+    }
+
+    say "successful builds: @succeeded" if @succeeded;
+    say "failed builds: @failed"        if @failed;
+}
+
+sub dsc2rel { (split " ", $_[0])[2] }
+
+sub reprepro {
+    local $CWD = $repo;
+    wantarray ? `reprepro @_` : system "reprepro", @_
+}