#!/usr/bin/perl -w
# Mass rebuild packages.
# Written By Richard W.M. Jones.
# Copyright (C) 2012 Red Hat Inc.
#
# 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 2 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, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use Graph::Directed;

#----------------------------------------------------------------------
# Configuration section.

# The name of the rebuild.  This is used in commit messages, and also
# used to tell if we have rebuilt a package already.
my $message = "Rebuild for OCaml 4.00.0.";

# These are regular expressions matching all the *source* packages
# that we want to rebuild.
my @package_regexps = (
    qr/\bocaml\b/,
    qr/^cduce$/,
    qr/^coccinelle$/,
    qr/^coq$/,
    qr/^frama-c$/,
    qr/^hivex$/,
    qr/^libguestfs$/,
    qr/^llvm$/,
    qr/^plplot$/,
    qr/^virt-dmesg$/,
    qr/^virt-top$/,
    qr/^why$/
    );

# Packages that match the above regexps, but which you nevertheless
# want to ignore.
my @package_ignored = (
    qr/^ocaml$/,
    );

# Directory to use when checking out Fedora packages.  This directory
# must exist.  Packages are cloned into directories under here.  If a
# directory already exists, then it is updated.
my $dir = "$ENV{HOME}/d/fedora";

# Branch to perform rebuilds in.  ('master' = Rawhide, otherwise 'f17' etc.)
my $branch = "master";

# End of configuration.
#----------------------------------------------------------------------

# Get a list of all source package names.
my @all_source_packages;
open PIPE, "repoquery --enablerepo=fedora-source -q -a --archlist=src --qf='%{name}' | sort -u |" or die "repoquery: $!";
while (<PIPE>) {
    chomp;
    push @all_source_packages, $_;
}
close PIPE or die;

my @packages;
my $rex;
foreach $rex (@package_regexps) {
    foreach (@all_source_packages) {
        if ($_ =~ $rex) {
            my $ignore;
            my $rex2;
            foreach $rex2 (@package_ignored) {
                $ignore = 1 if $_ =~ $rex2;
            }
            push @packages, $_ unless $ignore;
        }
    }
}

@packages = sort @packages;
print "packages considered for mass rebuild: ", join (" ", @packages),
    " (", 0+@packages, " packages)\n";

# Make a hashtable from @packages, so we can quickly tell if a package
# is in the list.
my %packages;
$packages{$_} = 1 foreach @packages;

# Get a list of all binary packages.  So that we can relate binary
# packages to what source they come from, also list the source RPM
# name for each.
my @all_binary_packages;
my %binary_to_source;
open PIPE, "repoquery -q -a --qf='%{name} %{sourcerpm}' | sort -u |" or die "repoquery: $!";
while (<PIPE>) {
    chomp;
    if (/^(.*) (.*?)-\d/) {
        push @all_binary_packages, $1;
        $binary_to_source{$1} = $2;
    } else {
        warn "ignored repoquery output: $_\n";
    }
}
close PIPE or die;

# For each package that needs rebuilding, get the dependencies.  These
# form a directed graph which is (hopefully though not necessarily)
# acyclic.
my $pkg;
my $depends = Graph::Directed->new;
foreach $pkg (@packages) {
    my $nr_edges_added = 0;
    open PIPE, "repoquery --enablerepo=fedora-source --requires $pkg.src | awk '{print \$1}' |" or die "repoquery: $!";
    while (<PIPE>) {
        chomp;
        # Resolve the binary package to its source package.
        # XXX Should resolve file dependencies here.
        if (exists $binary_to_source{$_}) {
            my $br = $binary_to_source{$_};
            # Is the BR in the list of packages?  If not, ignore.
            if (exists $packages{$br}) {
                $depends->add_edge ($br, $pkg);
                $nr_edges_added++;
            }
        } else {
            #warn "ignored non-existent build requires: $_ (from package $pkg)\n";
        }
    }
    close PIPE or die;

    # If we didn't add any edges, just add the disconnected vertex.
    $depends->add_vertex ($pkg) if $nr_edges_added == 0;
}

# Print some stats about the dependency graph.
print "dependency graph:\n";
print "  vertices (packages):   ", 0+$depends->vertices, "\n";
print "  edges (BuildRequires): ", 0+$depends->edges, "\n";

# Break cycles.
while ($depends->has_a_cycle) {
    print "warning: breaking dependency graph cycle ";
    my @vs = $depends->find_a_cycle;
    if (@vs == 1) {             # A -> A
        my $v = $vs[0];
        print "by deleting edge $v -> $v\n";
        $depends->delete_edge ($v, $v);
    } else {                    # A -> B -> ... -> Z -> A
        my $u = $vs[0];
        my $v = $vs[1];
        print "by deleting edge $u -> $v\n";
        $depends->delete_edge ($u, $v);
    }
}

die unless $depends->is_dag;

# Sort the dependencies into a build order.
my @build_order = $depends->topological_sort;

print "build order for mass rebuild: ", join (" ", @build_order),
    " (", 0+@build_order, " packages)\n\n";

# Now start checking out the packages under $dir.
my $cmd;
foreach $pkg (@build_order) {
    if (! -d "$dir/$pkg") {
        $cmd = "cd $dir && fedpkg clone -B $pkg";
        print $cmd, "\n";
        system ($cmd) == 0 or die "fedpkg: failed for $pkg: $?";
    }
    elsif (-f "$dir/$pkg/$branch/$pkg.spec" ||
           -f "$dir/$pkg/$branch/dead.package") {
        # already cloned with fedpkg -B
    }
    elsif (-f "$dir/$pkg/$pkg.spec" || -f "$dir/$pkg/dead.package") {
        # already cloned with fedpkg
    }
    else {
        print "$dir/$pkg exists, but contents are unexpected.\n";
        print "Fix this directory, and rerun the script (or fix the script).\n";
        exit 1;
    }
}

# Notes for each package.
my %package_notes;

# Build each package in order.
BUILD:
foreach $pkg (@build_order) {
    # Are all the dependencies of this package ready?
    my @v = $depends->predecessors ($pkg);
    foreach (@v) {
        if (!$package_notes{$_}{build_done}) {
            print "skipping $pkg because $_ was not built\n";
            $package_notes{$pkg}{error} = "skipped-dependency-not-built";
            next BUILD;
        }
    }

    # Make sure the package checkout is up to date.
    my ($d, $spec);
    if (-d "$dir/$pkg/$branch") {
        $d = "$dir/$pkg/$branch";
        $spec = "$dir/$pkg/$branch/$pkg.spec";
        $cmd = "cd $d && git pull --rebase";
    } elsif (-d "$dir/$pkg") {
        $d = "$dir/$pkg";
        $spec = "$dir/$pkg/$pkg.spec";
        $cmd = "cd $d && git pull --rebase && git checkout $branch";
    } else {
        die
    }
    print $cmd, "\n";
    system ($cmd) == 0 or die "git: failed for $pkg: $?";

    # Dead package?  We will note and ignore these.
    if (-f "$d/dead.package") {
        $package_notes{$pkg}{error} = "dead-package";
        next BUILD;
    }

    # Are there unpushed changes?  If so we have to skip this package.
    open PIPE, "cd $d && git log --oneline $branch ^origin/$branch | wc -l |"
        or die "git: $!";
    my $unpushed_changes = <PIPE>;
    chomp $unpushed_changes;
    close PIPE or die;
    if ($unpushed_changes > 0) {
        $package_notes{$pkg}{error} = "unpushed-changes";
        next BUILD;
    }

    # Get the current NVR of the package.
    open PIPE, "cd $d && fedpkg verrel |" or die "fedpkg: $!";
    my $nvr = <PIPE>;
    chomp $nvr;
    close PIPE or die;

    # Has the package been bumped already?
    my $bumped = grep_file ("^- $message", $spec);

    if ($bumped) {
        print "Checking if there is a build of $nvr ... ";

        # If the package has been bumped, does a successful build exist?
        open PIPE, "cd $d && LANG=C koji buildinfo $nvr |" or die "koji: $!";
        my ($state, $no_build);
        while (<PIPE>) {
            if (/No such build/) {
                $no_build = 1; last;
            }
            if (/State: (.*)/) {
                $state = $1; last;
            }
        }
        close PIPE or die;

        if ($no_build) {        # Bumped, but no build exists.
            print "no\n";
            if (!do_build_and_wait ($pkg, $d)) {
                $package_notes{$pkg}{error} = "build-failed";
                next BUILD;
            }
            $package_notes{$pkg}{build_done} = 1;
            next BUILD;
        } elsif (defined $state) {
            if ($state eq "COMPLETE") {
                print "yes\n";
                $package_notes{$pkg}{build_done} = 1;
                next BUILD;
            }
            elsif ($state eq "FAILED") {
                print "yes, but it failed\n";
                $package_notes{$pkg}{error} = "build-failed";
                next BUILD;
            }
            else {
                die "unknown build state: $state"
            }
        }
    }

    # Bump the package and build it.
    $cmd = "cd $d && rpmdev-bumpspec -c '- $message' $spec && git add $spec && git commit -m '$message' && git push";
    print $cmd, "\n";
    system ($cmd) == 0 or die "rpmdev-bumpspec: $?";

    if (!do_build_and_wait ($pkg, $d)) {
        $package_notes{$pkg}{error} = "build-failed";
        next BUILD;
    }

    $package_notes{$pkg}{build_done} = 1;
}

sub do_build_and_wait
{
    my $pkg = shift;
    my $d = shift;

    my $taskid;

    open PIPE, "cd $d && LANG=C fedpkg build --nowait |"
        or die "fedpkg: failed to build $pkg: $?";
    while (<PIPE>) {
        print;
        $taskid = $1 if /Created task: (\d+)/;
    }
    close PIPE or die;

    return 0 unless defined $taskid;

    while (1) {
        my ($ok, $failed);
        open PIPE, "cd $d && timeout 5m koji watch-task $taskid |" or next;
        while (<PIPE>) {
            print;
            $failed = 1 if /FAILED/;
            $ok = 1 if /^$taskid build .* completed successfully/;
        }
        close PIPE;

        return 1 if $ok;
        return 0 if $failed;
    }

    return 1;
}

sub grep_file
{
    my $rex = shift;
    my $filename = shift;

    my @cmd = ("grep", "--quiet", $rex, $filename);
    my $r = system (@cmd);
    if ($r == 0) {
        return 1;
    } elsif ($r == 256) {
        return 0;
    } else {
        die "grep: $filename: $?"
    }
}
