1 files changed, 222 insertions, 0 deletions
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", @_
+}