Girocco/Notify.pm

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