[prev in list] [next in list] [prev in thread] [next in thread]
List: kde-scm-interest
Subject: Re: [Kde-scm-interest] Post-commit hooks script
From: Oswald Buddenhagen <ossi () kde ! org>
Date: 2009-12-04 8:41:49
Message-ID: 20091204084149.GA6976 () ugly ! local
[Download RAW message or body]
On Fri, Dec 04, 2009 at 08:23:39AM +0100, Johannes Sixt wrote:
> Since you are using post-receive, you can use this strategy:
>
you really don't have to explain the simple stuff to me. ;)
> If you furthermore iterate over the refs in "logical" order (4.3.0
> 4.3.1 4.4.0 ... master), you can add $new to $all_old, then in the
> next iteration you will visit only commits that have not been
> attributed to an earlier ref.
>
i considered such an approach. i don't like it too much, as it requires
specific knowledge of the repository. and it should be really not
necessary, after all - the really weird stuff is not expected to happen
on the standardized main branches.
i'm attaching the current version. it doesn't work yet (it's in the
middle of the second rewrite), but it should illustrate the ideas.
it occurred to me that the duplicate commits problem (both the inherent
problem stated in the script and the pushing from one public repo to the
other one as explained to chani) can be solved via some external state
management (database of seen sha1s). that's a tad ugly, though.
["ossis-post-receive-email.pl" (text/x-perl)]
#! /usr/bin/perl -w
# Inherent problems
#
# Revs from a new branch which sprouts from a deleted branch will
# be announced a second time if the delete is pushed before the
# creation. This can be potentially *quite* some revs ...
#
# Creating a rev on one branch, merging it to another branch and
# then pushing the second branch first will attribute the rev to
# the wrong branch.
# Alternatively, one could speculatively attribute to the ref(s)
# which point to the parent commit(s).
#
# If a commit is reachable from multiple refs, it will appear as being
# made on all these refs, even though this is weird - in reality, all
# but one of the branches must have been reset after the commit.
use strict;
use Carp;
use Carp::Assert;
$ENV{LC_ALL} = 'en_US.UTF-8';
my %refs = ();
my %old_roots = (); # hash of arrays
my @new_revs = (); # New heads
my @x_old_revs = (); # Inverted old heads
while (<>) {
my ($oldrev, $newrev, $refname) = split;
if ($oldrev =~ /^0+$/) {
$oldrev = "";
} else {
push @x_old_revs, '^'.$oldrev;
}
if ($newrev =~ /^0+$/) {
$newrev = "";
} else {
push @new_revs, $newrev;
if ($oldrev) {
push @{$old_roots{$oldrev}}, $refname;
}
}
$refs{$refname} = [ $oldrev, $newrev ];
}
print "refs:\n";
for my $key (sort(keys(%refs))) {
print $key.": ".$refs{$key}[0]." => ".$refs{$key}[1]."\n";
}
# Note that there is a race condition between this call completing
# and a possible subsequent ref update. For that to become a problem,
# the second update would have to push the same revs to different
# refs. That could happen if users pulled from each other and are
# pushing their derived branches to the central repo now. The effect
# would be missing notifications.
# The only fix for that would be obsoleting this call by passing
# no-op updates to all refs to the hook. Of course, that snapshot
# has to be atomic.
for (&run_pipe(1, 'git', 'for-each-ref',
'--format=%(refname) %(objectname)',
'refs/heads/', 'refs/tags/')) {
my ($ref, $rev) = split;
push @x_old_revs, '^'.$rev unless (exists $refs{$ref});
print "excluding $ref:".'^'.$rev."\n" unless (exists $refs{$ref});
}
############### Setup section ##############
#
# This comes only here to keep the racing window explained above
# as short as possible.
my @sendmail = ();
if (0) { # !istty
@sendmail = ('/usr/sbin/sendmail', '-oi', '-t');
my $envelopesender = &get_config('hooks.envelopesender');
push @sendmail, ('-f', $envelopesender) if ($envelopesender);
}
my $mailinglist = &get_config('hooks.mailinglist');
my $announcelist = &get_config('hooks.announcelist');
my $envelopesender = &get_config('hooks.envelopesender');
my $emailprefix = &get_config('hooks.emailprefix');
$emailprefix = '[SCM] ' if (not $emailprefix);
############### End setup section ##############
my @lines = &run_pipe(1, 'git', 'rev-list', '--reverse', '--topo-order',
'--parents', @new_revs, @x_old_revs);
my @new_commits = ();
my %new_commit_ref_scores = (); # hash of hashes of tuples
my %new_commit_parents = (); # hash of arrays
for (@lines) {
my @hashes = split;
my $rev = shift @hashes;
push @new_commits, $rev;
$new_commit_parents{$rev} = \@hashes;
$new_commit_ref_scores{$rev} = { };
}
print "new commits: @new_commits \n";
my %queued_mails_pre = (); # hash of arrays of tuples
my %queued_mails_post = (); # hash of arrays of tuples
for my $refname (keys(%refs)) {
my ($oldrev, $newrev) = @{$refs{$refname}};
my $rev = $newrev ? $newrev : $oldrev;
my $rev_type = &run_pipe_line(1, 'git', 'cat-file', '-t', $rev);
# First determine the change type.
my $refname_type = "";
my $short_refname = $refname;
my $recipients = $mailinglist;
if ($short_refname =~ s,^refs/tags/,,) {
if ($rev_type eq "commit") {
$refname_type = "tag";
} elsif ($rev_type eq "tag") {
$refname_type = "annotated tag";
$recipients = $announcelist if ($announcelist);
}
} elsif ($short_refname =~ s,^refs/heads/,,) {
if ($rev_type eq "commit") {
$refname_type = "branch";
}
}
if (!$refname_type) {
print STDERR "*** Unknown type of update to $refname ($rev_type)\n";
next;
}
# Then report the change.
if (!$newrev) {
&send_mail($recipients,
"$refname_type $short_refname deleted",
"The $refname_type '$short_refname', previously at\n".
"$oldrev, has been deleted.\n");
} else {
my $is_branch = ($refname_type eq "branch"); # is_strong
my $rec_refname = $is_branch ? $short_refname : '['.$short_refname.']';
if (!$oldrev) {
my ($first, $last, @added) =
&record_commits($rec_refname, "", $newrev, @x_old_revs);
should(@added, 0);
if (!$is_branch) { # XXX || !$first
&queue_mail_post($last, $recipients,
"$refname_type $short_refname created",
"The $refname_type '$short_refname' has been created at\n".
$newrev."\n");
}
} else {
my $baserev = &run_pipe_line(1, 'git', 'merge-base', $oldrev, $newrev);
my ($first, $last, @added) =
&record_commits($rec_refname, $oldrev, $newrev, '^'.$baserev);
if (!$is_branch) {
&queue_mail_post($last, $recipients,
"$refname_type $short_refname re-created",
"The $refname_type '$short_refname', previously at\n".
"$oldrev, has been re-created at\n".
"$newrev.\n");
} else {
if ($baserev ne $oldrev) {
my @discarded = &run_pipe(1, 'git', 'rev-list', '--topo-order',
$baserev."..".$oldrev);
if (@added) {
&queue_mail_pre($first, $newrev, $recipients,
"branch $short_refname reset",
"The branch '$short_refname', previously at\n".
"$oldrev, has been rewound by ".scalar(@discarded)." revisions\n".
"and subsequently fast-forwarded by ".scalar(@added)." revisions to\n");
} else {
&queue_mail_pre($first, $newrev, $recipients,
"branch $short_refname rewound",
"The branch '$short_refname', previously at\n".
"$oldrev, has been rewound by ".scalar(@discarded)." revisions to\n");
}
} else {
if (@added) {
&queue_mail_pre($first, $newrev, $recipients,
"branch $short_refname fast-forwarded",
"The branch '$short_refname', previously at\n".
"$oldrev, has been fast-forwarded by ".scalar(@added)." revisions to\n");
}
}
}
}
}
}
# FIXME
# Imagine three branches 1, 2 & 3, currently all at commit A.
# Now push B(A), C(A), 1:D(B), 2:E(B+C), 3:F(C).
# E is a merge, while D and F are not, so B and C will be ascribed
# to 1 & 3, resp., but not to 2. This is clearly wrong, as it
# interrupts the graph for 2. Note that a once ousted branch may
# re-appear further up the ancestry.
# The solution might be finding the "lowest cost route" for each
# ref. The cost will be 0 for "non-congested" updates. If multiple
# branches have the same cost (like in the example above), all
# of them should be taken for the given segment.
# Alternatively, the interruption of a graph could be declared
# a fast-forward as is done for existing commits. This reflects
# reality closer - at least one possible variant of it, which is
# the problem.
#my %new_commit_branches = (); # hash of arrays
my %new_commit_scores = (); # hash of arrays
for my $rev (@new_commits) {
my @scores = sort { @$a[0] <=> @$b[0] || @$a[1] <=> @$b[1] }
values %{$new_commit_ref_scores{$rev}};
$new_commit_scores{$rev} = \@scores;
}
# for my $refname (keys(%refs)) {
# my ($oldrev, $newrev) = @{$refs{$refname}};
# if ($newrev) {
#
# # FIXME We should also say from which other ref(s) the branch is sprouting.
# if ($is_branch) {
# my $subject = "branch $short_refname created";
# my $body = "The branch '$short_refname' has been created at\n";
# &queue_mail_pre($first, $newrev, $recipients, $subject, $body);
#
# }
# }
for my $rev (@new_commits) {
if (exists($queued_mails_pre{$rev})) {
for my $qm (@{$queued_mails_pre{$rev}}) {
print "===== pre mail =====\n";
&send_mail(@$qm);
}
&advance_time();
}
my @branches = @{$new_commit_ref_scores{$rev}};
my @brs = grep(!/^\[/, @branches);
@brs = @branches if (!@brs);
my $summ = &run_pipe_line(1, 'git', 'log', '--pretty=%s', '-1', $rev); # FIXME
print "===== native mail: @branches =====\n";
&send_mail($mailinglist, join(" ", @brs).": ".$summ,
&run_pipe(1, 'git', 'show', $rev));
&advance_time();
if (exists($queued_mails_post{$rev})) {
for my $qm (@{$queued_mails_post{$rev}}) {
print "===== post mail =====\n";
&send_mail(@$qm);
}
&advance_time();
}
}
sub record_commits
{
my $refname = shift;
my $root = shift;
my $newrev = shift;
my @lines = &run_pipe(1, 'git', 'rev-list', '--parents', $newrev, @_);
my ($first, $last) = ("", "");
my @added = ();
my %parents = (); # hash of arrays
for (@lines) {
my @hashes = split;
my $rev = shift @hashes;
$parents{$rev} = \@hashes;
}
&record_commit($refname, 2**1023, $newrev, $root, \%parents,
\$first, \$last, \@added);
return $first, $last, @added;
}
sub record_commit
{
my ($refname, $weight, $rev, $root, $parents, $first, $last, $added) = @_;
if (exists($$parents{$rev})) {
my $best_score = 3;
my @my_parents = @{$$parents{$rev}};
$weight /= @my_parents if (@my_parents > 1);
for my $parent (@my_parents) {
# Merging a big branch will make quite a recursion here
my $score = &record_commit($refname, $weight, $parent, $root, $parents,
$first, $last, $added);
$best_score = $score if ($score < $best_score);
}
if (exists($new_commit_ref_scores{$rev})) {
if ($best_score == 0) {
$$first = $rev;
$$last = $rev if (!$$last);
}
print "adding $rev on $refname\n";
my %r = %{$new_commit_ref_scores{$rev}};
if (exists($r{$refname})) {
$r{$refname}[0] += $weight;
} else {
@{$r{$refname}} = ($weight, $best_score);
}
# push , [ ($depth << 2) | $best_score, $refname ];
} else {
print "skipping $rev on $refname\n";
push @$added, $rev;
}
} else {
return $root ? ($rev eq $root) ? 0 : 2 : 1;
}
}
sub queue_mail_pre
{
my ($first, $newrev, $rec, $subject, $body) = @_;
if ($first) {
$_ = &run_pipe_line(1, 'git', 'rev-list', '--parents', '-1', $first);
my @hashes = split;
shift @hashes;
# Multiple parents occur when the first new commit on a branch is a merge.
my $parents = join ' & ', @hashes;
push @{$queued_mails_pre{$first}}, [ $rec, $subject, $body.$parents."\n" ];
} else {
&send_mail($rec, $subject, $body.$newrev."\n");
}
}
sub queue_mail_post
{
my ($rev, $rec, $subject, $body) = @_;
if ($rev) {
push @{$queued_mails_post{$rev}}, [ $rec, $subject, $body ];
} else {
&send_mail($rec, $subject, $body);
}
}
sub advance_time
{
print STDOUT "---- advancing time ----\n";
}
sub send_mail
{
my ($rec, $subject, @body) = @_;
my @mime_head = (
"MIME-Version: 1.0",
"Content-Type: text/plain; charset=UTF-8",
"Content-Transfer-Encoding: 8bit",
""
);
my @head;
# push(@head, "From: $blame");
push(@head, "To: $rec");
# push(@head, "Cc: ".join(', ', @cclist)) if(@cclist);
push(@head, "Subject: $subject");
push(@head, @mime_head);
&do_send(@head, @body);
}
sub do_send
{
if (@sendmail) {
open (MAIL, "|-") || exec @sendmail;
print MAIL join "\n", @_;
print MAIL "\n";
close (MAIL);
} else {
print STDOUT "==================================================================\n";
print STDOUT join "\n", @_;
print STDOUT "\n";
}
}
sub get_config
{
return &run_pipe_line(0, 'git', 'config', @_);
}
sub run_pipe_line
{
my @ret = &run_pipe(@_);
return "" if (!@ret);
return shift @ret;
}
sub run_pipe
{
my $fail_on = shift;
unless (@_) {
croak "$0: run_pipe passed no arguments.\n";
}
my $pid = open(SAFE_READ, '-|');
unless (defined $pid) {
die "$0: cannot fork: $!\n";
}
unless ($pid) {
open(STDERR, ">&STDOUT") or die "$0: cannot dup STDOUT: $!\n";
exec(@_) or die "$0: cannot exec `@_': $!\n";
}
my @output;
while (<SAFE_READ>) {
chomp;
push(@output, $_);
}
close(SAFE_READ);
my $result = $?;
my $exit = $result >> 8;
my $signal = $result & 127;
# The commands we call are unlikely to fail unless we are
# in real trouble anyway.
if ($signal) {
die "$0: pipe '@_' crashed with signal $signal\n";
}
if ($fail_on && $exit) {
die "$0: pipe '@_' returned non-zero exit code $exit\n";
}
print "pipe @_ returns @output\n";
return @output;
}
_______________________________________________
Kde-scm-interest mailing list
Kde-scm-interest@kde.org
https://mail.kde.org/mailman/listinfo/kde-scm-interest
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic