Girocco/Notify.pm

   1 package Girocco::Notify;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Girocco::Config;
   7 use Girocco::Util;
   8
   9 use LWP::UserAgent;
  10
  11 #use RPC::XML;
  12 #use RPC::XML::Client;
  13
  14 # This Perl code creates json payload within post-receive hook.
  15
  16 sub _fixlaxiso {
  17         # The %ai %ci formats are ISO 8601 like "1999-12-31 23:59:59 -0100"
  18         # The %aI %cI strict ISO 8601 formats aren't available until Git v2.2.0
  19         local $_ = shift;
  20         s/ /T/;                 # "1999-12-31 23:59:59 -0100" -> "1999-12-31T23:59:59 -0100"
  21         s/ //;                  # "1999-12-31T23:59:59 -0100" -> "1999-12-31T23:59:59-0100"
  22         s/(?<!:)(\d\d)$/:$1/;   # "1999-12-31T23:59:59-0100"  -> "1999-12-31T23:59:59-01:00"
  23         return $_;
  24 }
  25
  26 sub json_commit {
  27         my ($proj, $commit, $root) = @_;
  28
  29         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
  30         my $fd;
  31
  32         open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%T%n%ae %an%n%ai%n%ce %cn%n%ci%n%s%n%n%b', $commit, '--'
  33                 or die "cannot do git log: $! $?";
  34         my @l = <$fd>;
  35         chomp @l;
  36         close $fd;
  37         my ($tr) = $l[0];
  38         my ($ae, $an) = ($l[1] =~ /^(.*?) (.*)$/);
  39         #my ($ai) = _fixlaxiso($l[2]);
  40         my ($ce, $cn) = ($l[3] =~ /^(.*?) (.*)$/);
  41         my ($ci) = _fixlaxiso($l[4]);
  42         my $msg = join("\n", splice(@l, 5));
  43         # Up to three trailing newlines in case of no body.
  44         chomp $msg; chomp $msg; chomp $msg;
  45
  46         my ($rf, $af, $mf) = ([], [], []);
  47         my $parent = ($commit eq $root) ? "--root" : "$commit^";
  48         open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', $parent, $commit, '--'
  49                 or die "cannot do git diff-tree: $! $?";
  50         while (<$fd>) {
  51                 chomp;
  52                 my ($s, $file) = split(/\t/, $_);
  53                 if ($s eq 'M') {
  54                         push @$mf, $file;
  55                 } elsif ($s eq 'A') {
  56                         push @$af, $file;
  57                 } elsif ($s eq 'R') {
  58                         push @$rf, $file;
  59                 }
  60         }
  61         close $fd;
  62
  63         return {
  64                 "removed"   => $rf,
  65                 "message"   => $msg,
  66                 "added"     => $af,
  67                 "timestamp" => $ci,
  68                 "modified"  => $mf,
  69                 "url"       => $Girocco::Config::gitweburl."/".$proj->{name}.".git/commit/".$commit,
  70                 "author"    => { "name" => $an, "email" => $ae },
  71                 "committer" => { "name" => $cn, "email" => $ce },
  72                 "distinct"  => json_bool(1),
  73                 "id"        => $commit,
  74                 "tree_id"   => $tr
  75         };
  76 }
  77
  78 sub json {
  79         my ($url, $proj, $user, $ref, $oldrev, $newrev) = @_;
  80
  81         my $pusher = {};
  82         my $sender = {};
  83         if ($user) {
  84                 $pusher = { "name" => $user->{name} };
  85                 $sender = { "login" => $user->{name} };
  86                 if ($user->{name} ne 'mob') {
  87                         $pusher->{"email"} = $user->{email};
  88                 }
  89         }
  90
  91         my $commits = [];
  92
  93         my @commits = get_commits($proj, $ref, $oldrev, $newrev);
  94         my $root = ($oldrev =~ /^0+$/) ? $commits[$#commits] : "";
  95         foreach my $commit (@commits) {
  96                 push @$commits, json_commit($proj, $commit, $root);
  97         }
  98
  99         # This is backwards-compatible with GitHub (except the GitHub-specific
 100         # full project name construction sometimes performed in clients)
 101         my $payload = to_json {
 102                 "before"  => $oldrev,
 103                 "after"   => $newrev,
 104                 "ref"     => $ref,
 105                 "created" => json_bool($oldrev =~ /^0+$/ ? 1 : 0),
 106                 "deleted" => json_bool($newrev =~ /^0+$/ ? 1 : 0),
 107                 "forced"  => json_bool(0), # for now
 108
 109                 "repository" => {
 110                         "name"  => $proj->{name},
 111                         # Girocco extension: full_name is full project name,
 112                         # equivalent to GitHub's "owner[name]/name".
 113                         "full_name" => $proj->{name}.".git",
 114
 115                         "url"   => $Girocco::Config::gitweburl.'/'.$proj->{name}.".git",
 116                         # Girocco extension: Pull URL.
 117                         "pull_url" => $Girocco::Config::gitpullurl.'/'.$proj->{name}.".git",
 118
 119                         "owner" => { "name" => "", "email" => $proj->{email} }
 120                 },
 121
 122                 "pusher" => $pusher,
 123                 "sender" => $sender,
 124                 "commits" => $commits
 125         };
 126
 127         # print "$payload\n";
 128         my $ua = LWP::UserAgent->new;
 129         $ua->timeout(5);
 130         $ua->post($url, { payload => $payload });
 131 }
 132
 133
 134 sub cia_commit {
 135         my ($cianame, $proj, $branch, $commit, $root) = @_;
 136
 137         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
 138         my $fd;
 139
 140         open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%an <%ae>%n%at%n%s', $commit, '--'
 141                 or die "cannot do git log: $! $?";
 142         my @l = <$fd>;
 143         chomp @l;
 144         close $fd;
 145         foreach (@l) { s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; }
 146         my ($a, $at, $subj) = @l;
 147
 148         my @f;
 149         my $parent = ($commit eq $root) ? "--root" : "$commit^";
 150         open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', $parent, $commit, '--'
 151                 or die "cannot do git diff-tree: $! $?";
 152         while (<$fd>) {
 153                 chomp;
 154                 s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
 155                 my ($status, $file) = split(/\t/, $_);
 156                 push @f, $file;
 157         }
 158         close $fd;
 159
 160         my $rev = substr($commit, 0, 12);
 161
 162         my $msg = <<EOT;
 163         <message>
 164                 <generator>
 165                         <name>Girocco::Notify</name>
 166                         <version>1.0</version>
 167                 </generator>
 168                 <source>
 169                         <project>$cianame</project>
 170 EOT
 171         if ($branch ne 'master') { # XXX: Check HEAD instead
 172                 $msg .= "<branch>$branch</branch>";
 173         }
 174         $msg .= "</source>\n";
 175         $msg .= "<timestamp>$at</timestamp>\n";
 176         $msg .= "<body><commit><author>$a</author><revision>$rev</revision>\n";
 177         $msg .= "<url>$Girocco::Config::gitweburl/$proj->{name}.git/commit/$commit</url>\n";
 178         $msg .= "<files>\n";
 179         foreach (@f) { $msg .= "<file>$_</file>\n"; }
 180         $msg .= "</files><log>$subj</log></commit></body></message>\n";
 181
 182         # print "$msg\n";
 183         #my $rpc_client = new RPC::XML::Client "http://cia.vc/RPC2";
 184         #my $rpc_request = RPC::XML::request->new('hub.deliver', $msg);
 185         #my $rpc_response = $rpc_client->send_request($rpc_request);
 186         #ref $rpc_response or print STDERR "XML-RPC Error: $RPC::XML::ERROR\n";
 187 }
 188
 189 sub cia {
 190         my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
 191
 192         # CIA notifications for branches only
 193         my $branch = $ref;
 194         $branch =~ s#^refs/heads/## or return;
 195
 196         my @commits = get_commits($proj, $ref, $oldrev, $newrev);
 197         my $root = ($oldrev =~ /^0+$/) ? $commits[$#commits] : "";
 198         foreach my $commit (@commits) {
 199                 cia_commit($cianame, $proj, $branch, $commit, $root);
 200         }
 201         print "$proj->{name}.git: CIA.vc is defunct ($cianame)\n";
 202 }
 203
 204
 205 sub get_commits {
 206         my ($proj, $ref, $oldrev, $newrev) = @_;
 207
 208         return () if $newrev =~ /^0+$/;
 209
 210         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
 211         my $fd;
 212
 213         open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
 214                 or die "cannot do git for-each-ref: $! $?";
 215         my @refs = <$fd>;
 216         chomp @refs;
 217         @refs = grep { $_ ne $ref } @refs;
 218         close $fd;
 219
 220         my @revlims;
 221         if (@refs) {
 222                 open $fd, '-|', @gcmd, 'rev-parse', '--not', @refs
 223                         or die "cannot do git rev-list for revlims: $! $?";
 224                 @revlims = <$fd>;
 225                 chomp @revlims;
 226                 close $fd;
 227         }
 228
 229         my $revspec = (($oldrev =~ /^0+$/) ? $newrev : "$oldrev..$newrev");
 230         open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
 231                 or die "cannot do git rev-list: $! $?";
 232         my @revs = <$fd>;
 233         chomp @revs;
 234         close $fd;
 235
 236         return @revs;
 237 }
 238
 239 sub _get_sender_uuid {
 240         my ($proj, $user) = @_;
 241
 242         my $sender;
 243         my $xtrahdr = '';
 244         my $senderemail = $proj->{email};
 245         defined($senderemail) && $senderemail ne ''
 246                 or $senderemail = $Girocco::Config::sender;
 247         if ($user) {
 248                 if ($user->{name} eq 'mob') {
 249                         $sender = "The Mob User <$senderemail>";
 250                 } else {
 251                         my $useremail = $user->{email};
 252                         defined($useremail) && $useremail ne ''
 253                                 or $useremail = $senderemail;
 254                         $sender = "$user->{name} <$useremail>";
 255                         $xtrahdr = "X-User-UUID: $user->{uuid}" if $user->{uuid};
 256                 }
 257         } else {
 258                 $sender = "$proj->{name} <$senderemail>";
 259         }
 260
 261         return ($sender, $xtrahdr);
 262 }
 263
 264 sub _notify_for_ref {
 265         $_[0] =~ m{^refs/heads/.} || $_[0] =~ m{^refs/tags/.};
 266 }
 267
 268 my $_ref_change;
 269 BEGIN {$_ref_change = sub {
 270         my ($proj, $user, $ref, $oldrev, $newrev) = @_;
 271         _notify_for_ref($ref) or return 0;
 272
 273         my $mail_sh_ran = 0;
 274         chdir($proj->{path});
 275
 276         # First, possibly send out various mails
 277         if (($ref =~ m{^refs/heads/.} && $proj->{notifymail}) ||
 278             ($ref =~ m{^refs/tags/.} && ($proj->{notifymail} || $proj->{notifytag}))) {
 279                 my ($sender, $xtrahdr) = _get_sender_uuid($proj, $user);
 280                 my @cmd = ($Girocco::Config::basedir.'/taskd/mail.sh',
 281                         "$ref", "$oldrev", "$newrev", $proj->{name},
 282                         $sender, $xtrahdr);
 283                 if (system(@cmd)) {
 284                         if ($? < 0 && exists($ENV{MAIL_SH_OTHER_BRANCHES})) {
 285                                 # Let's go again
 286                                 delete $ENV{MAIL_SH_OTHER_BRANCHES};
 287                                 system(@cmd);
 288                         }
 289                         $? and warn "mail.sh failed";
 290                 }
 291                 $mail_sh_ran = 1;
 292         }
 293
 294         # Next, send JSON packet to given URL if enabled.
 295         if ($proj->{notifyjson}) {
 296                 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev);
 297         }
 298
 299         # Also send CIA notifications.
 300         if ($proj->{notifycia}) {
 301                 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);
 302         }
 303
 304         return $mail_sh_ran;
 305 }}
 306
 307 # ref_changes($proj, $user, [$coderef,] [$oldrefs,] @changes)
 308 # $coderef gets called with ($oldrev, $newrev, $refname, $mail_sh_ran) as each
 309 # update is processed where $mail_sh_ran will be true if mail.sh was run
 310 # $oldrefs is an optional hash of $$oldrefs{$refname} = $oldvalue
 311 # @changes is array of [$oldrev, $newrev, $ref]
 312 sub ref_changes {
 313         use IPC::Open2;
 314
 315         my $proj = shift;
 316         my $user = shift;
 317         my $proc;
 318         my $oldrefs;
 319         $proc = shift if ref($_[0]) eq 'CODE';
 320         $oldrefs = shift if ref($_[0]) eq 'HASH';
 321         return if !@_ || ref($_[0]) ne 'ARRAY' || @{$_[0]} != 3 ||
 322                 !${$_[0]}[0] || !${$_[0]}[1] || !${$_[0]}[2];
 323
 324         # run custom notify if present
 325         # hook protocol is the same as for Git's post-receive hook where each
 326         # line sent to the hook's stdin has the form:
 327         #     oldhash newhash fullrefname
 328         # with the following additions:
 329         #   * four command line arguments are passed:
 330         #      1. project name (e.g. "proj" "proj/fork" "proj/fork/sub" etc.)
 331         #      2. "user" responsible for the changes
 332         #      3. total number of lines coming on stdin
 333         #      4. how many of those lines are "context" lines (sent first)
 334         #   * "context" lines are sent first before any actual change lines
 335         #   * "context" lines have the same format except oldhash equals newhash
 336         #   * "context" lines give the value unchanged refs had at the time
 337         #     the changes to the non-"context" refs were made
 338         #   * currently "context" lines are only provided for "refs/heads/..."
 339         #   * current directory will always be the repository's top-level $GIT_DIR
 340         #   * the PATH is guaranteed to find the correct Git, utils and $basedir/bin
 341         #   * the hook need not consume all (or any) of stdin
 342         #   * the exit code for the hook is ignored (just like Git's post-receive)
 343         #   * the GIROCCO_BASEDIR environment variable is set to $Girocco::Config::basedir
 344         my $customhook;
 345         if (($customhook = $proj->_has_notifyhook)) {{
 346                 my @argv = ();
 347                 my $argv0;
 348                 if (is_shellish($customhook)) {
 349                         $argv0 = $Girocco::Config::posix_sh_bin || "/bin/sh";
 350                         push(@argv, $argv0, "-c", $customhook.' "$@"');
 351                 } else {
 352                         -f $customhook && -x _ or last;
 353                         $argv0 = $customhook;
 354                 }
 355                 my $username = "";
 356                 $username = $user->{name} if $user && defined($user->{name});
 357                 $username ne "" or $username = "-";
 358                 push(@argv, $argv0, $proj->{name}, $username);
 359                 my @mod = grep({$$_[2] =~ m{^refs/.} && $$_[1] ne "" && $$_[2] ne "" && $$_[1] ne $$_[2]} @_);
 360                 my %modref = map({($$_[2] => 1)} @mod);
 361                 my %same = ();
 362                 do {do {$same{$_} = $$oldrefs{$_} if !exists($modref{$_})} foreach keys %$oldrefs} if $oldrefs;
 363                 my @same = ();
 364                 push(@same, [$same{$_}, $same{$_}, $_]) foreach sort keys %same;
 365                 push(@argv, @same + @mod, @same + 0);
 366                 chdir($proj->{path}) or last;
 367                 local $ENV{GIROCCO_BASEDIR} = $Girocco::Config::basedir;
 368                 local $ENV{PATH} = util_path;
 369                 if (open my $hookpipe, '|-', @argv) {
 370                         local $SIG{'PIPE'} = sub {};
 371                         print $hookpipe map("$$_[0] $$_[1] $$_[2]\n", @same, @mod);
 372                         close $hookpipe;
 373                 } else {
 374                         print STDERR "$proj->{name}: failed to run notifyhook \"$customhook\": $!\n";
 375                 }
 376         }}
 377
 378         # don't even try the fancy stuff if there are too many heads
 379         my $maxheads = int(100000 / (1 + length(${$_[0]}[0])));
 380         my $newheadsdone = 0;
 381         my @newheads = grep({$$_[2] =~ m{^refs/heads/.} && $$_[1] !~ /^0+$/} @_);
 382
 383         if ($oldrefs && @newheads && keys(%$oldrefs) + @newheads <= $maxheads) {{
 384                 my $projarg = '--git-dir='.$proj->{path};
 385
 386                 # git merge-base --independent requires v1.7.3 or later
 387                 # We run it and if it fails just end up not processing indep heads last
 388                 # There is no version of merge-base --independent that accepts stdin revs
 389                 my %indep = map { $_ => 1 } split(' ',
 390                         get_git($projarg, 'merge-base', '--independent', map($$_[1], @newheads)) || '');
 391
 392                 # We pass the revisions on stdin so this should never fail unless one of
 393                 # the input revisions is no longer valid (which should never happen).
 394                 # However, if it does, we just fall back to the old non-fancy technique.
 395                 my ($inp, $out, $pid2);
 396                 $pid2 = eval { open2($out, $inp, $Girocco::Config::git_bin, $projarg,
 397                                 'rev-list', '--no-walk', '--reverse', '--stdin') };
 398                 $pid2 or last;
 399                 {
 400                         local $SIG{'PIPE'} = sub {};
 401                         print $inp map("$$_[1]\n", @newheads);
 402                         close $inp;
 403                 }
 404                 my @ordered = <$out>;
 405                 close $out;
 406                 waitpid $pid2, 0;
 407                 @ordered or last; # if we got nothing it failed
 408                 chomp(@ordered);
 409
 410                 my %updates = ();
 411                 push(@{$updates{$$_[1]}}, $_) foreach @newheads;
 412                 my %curheads = %$oldrefs;
 413                 my $headcmp = sub {
 414                         if ($_[0] eq 'refs/heads/master') {
 415                                 return ($_[1] eq 'refs/heads/master') ? 0 : -1;
 416                         } elsif ($_[1] eq 'refs/heads/master') {
 417                                 return 1;
 418                         } else {
 419                                 return $_[0] cmp $_[1];
 420                         }
 421                 };
 422                 foreach (grep(!$indep{$_}, @ordered), grep($indep{$_}, @ordered)) {
 423                         foreach my $change (sort {&$headcmp($$a[2], $$b[2])} @{$updates{$_}}) {
 424                                 my ($old, $new, $ref) = @$change;
 425                                 $ENV{MAIL_SH_OTHER_BRANCHES} = join(' ', values(%curheads));
 426                                 my $ran_mail_sh = &$_ref_change($proj, $user, $ref, $old, $new);
 427                                 &$proc($old, $new, $ref, $ran_mail_sh) if $proc;
 428                                 $curheads{$ref} = $new;
 429                         }
 430                 }
 431                 $newheadsdone = 1;
 432         }}
 433
 434         delete $ENV{MAIL_SH_OTHER_BRANCHES};
 435         foreach (@_) {
 436                 my ($old, $new, $ref) = @$_;
 437                 if (!$newheadsdone || $ref !~ m{^refs/heads/.} || $new =~ /^0+$/) {
 438                         my $ran_mail_sh = &$_ref_change($proj, $user, $ref, $old, $new);
 439                         &$proc($old, $new, $ref, $ran_mail_sh) if $proc;
 440                 }
 441         }
 442 }
 443
 444 1;