Girocco/Notify.pm

   1 package Girocco::Notify;
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7         use Girocco::Config;
   8
   9         use JSON;
  10         use LWP::UserAgent;
  11
  12         use RPC::XML;
  13         use RPC::XML::Client;
  14 }
  15
  16
  17 # This Perl code creates json payload within post-receive hook.
  18
  19 sub json_commit {
  20         my ($proj, $commit) = @_;
  21
  22         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
  23         my $fd;
  24
  25         open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%ae %an%n%ai%n%s%n%n%b', $commit
  26                 or die "cannot do git log: $! $?";
  27         my @l = <$fd>;
  28         chomp @l;
  29         close $fd;
  30         my ($ae, $an) = ($l[0] =~ /^(.*?) (.*)$/);
  31         my ($ai) = $l[1];
  32         my $msg = join("\n", splice(@l, 2));
  33         # Up to three trailing newlines in case of no body.
  34         chomp $msg; chomp $msg; chomp $msg;
  35
  36         my ($rf, $af, $mf) = ([], [], []);
  37         open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
  38                 or die "cannot do git diff-tree: $! $?";
  39         while (<$fd>) {
  40                 chomp;
  41                 my ($s, $file) = split(/\t/, $_);
  42                 if ($s eq 'M') {
  43                         push @$mf, $file;
  44                 } elsif ($s eq 'A') {
  45                         push @$af, $file;
  46                 } elsif ($s eq 'R') {
  47                         push @$rf, $file;
  48                 }
  49         }
  50         close $fd;
  51
  52         return {
  53                 "removed"   => $rf,
  54                 "message"   => $msg,
  55                 "added"     => $af,
  56                 "timestamp" => $ai,
  57                 "modified"  => $mf,
  58                 "url"       => $Girocco::Config::gitweburl."/".$proj->{name}.".git/commit/".$commit,
  59                 "author"    => { "name" => $an, "email" => $ae },
  60                 "id"        => $commit
  61         };
  62 }
  63
  64 sub json {
  65         my ($url, $proj, $user, $ref, $oldrev, $newrev) = @_;
  66
  67         my $pusher = {};
  68         if ($user) {
  69                 $pusher = { "name" => $user->{name} };
  70                 if ($user->{name} ne 'mob') {
  71                         $pusher->{"email"} = $user->{email};
  72                 }
  73         }
  74
  75         my $commits = [];
  76
  77         foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
  78                 push @$commits, json_commit($proj, $commit);
  79         }
  80
  81         # This is backwards-compatible with GitHub (except the GitHub-specific
  82         # full project name construction sometimes performed in clients)
  83         my $payload = encode_json {
  84                 "before" => $oldrev,
  85                 "after"  => $newrev,
  86                 "ref"    => $ref,
  87
  88                 "repository" => {
  89                         "name"  => $proj->{name},
  90                         # Girocco extension: full_name is full project name,
  91                         # equivalent to GitHub's "owner[name]/name".
  92                         "full_name" => $proj->{name}.".git",
  93
  94                         "url"   => $Girocco::Config::gitweburl.'/'.$proj->{name}.".git",
  95                         # Girocco extension: Pull URL.
  96                         "pull_url" => $Girocco::Config::gitpullurl.'/'.$proj->{name}.".git",
  97
  98                         "owner" => { "name" => "", "email" => $proj->{email} }
  99                 },
 100
 101                 # Girocco extension
 102                 "pusher" => $pusher,
 103
 104                 "commits" => $commits
 105         };
 106
 107         # print "$payload\n";
 108         my $ua = LWP::UserAgent->new;
 109         $ua->timeout(5);
 110         $ua->post($url, { payload => $payload });
 111 }
 112
 113
 114 sub cia_commit {
 115         my ($cianame, $proj, $branch, $commit) = @_;
 116
 117         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
 118         my $fd;
 119
 120         open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%an <%ae>%n%at%n%s', $commit
 121                 or die "cannot do git log: $! $?";
 122         my @l = <$fd>;
 123         chomp @l;
 124         close $fd;
 125         foreach (@l) { s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; }
 126         my ($a, $at, $subj) = @l;
 127
 128         my @f;
 129         open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
 130                 or die "cannot do git diff-tree: $! $?";
 131         while (<$fd>) {
 132                 chomp;
 133                 s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
 134                 my ($status, $file) = split(/\t/, $_);
 135                 push @f, $file;
 136         }
 137         close $fd;
 138
 139         my $rev = substr($commit, 0, 12);
 140
 141         my $msg = <<EOT;
 142         <message>
 143                 <generator>
 144                         <name>Girocco::Notify</name>
 145                         <version>1.0</version>
 146                 </generator>
 147                 <source>
 148                         <project>$cianame</project>
 149 EOT
 150         if ($branch ne 'master') { # XXX: Check HEAD instead
 151                 $msg .= "<branch>$branch</branch>";
 152         }
 153         $msg .= "</source>\n";
 154         $msg .= "<timestamp>$at</timestamp>\n";
 155         $msg .= "<body><commit><author>$a</author><revision>$rev</revision>\n";
 156         $msg .= "<url>$Girocco::Config::gitweburl/$proj->{name}.git/commit/$commit</url>\n";
 157         $msg .= "<files>\n";
 158         foreach (@f) { $msg .= "<file>$_</file>\n"; }
 159         $msg .= "</files><log>$subj</log></commit></body></message>\n";
 160
 161         # print "$msg\n";
 162         my $rpc_client = new RPC::XML::Client "http://cia.vc/RPC2";
 163         my $rpc_request = RPC::XML::request->new('hub.deliver', $msg);
 164         #my $rpc_response = $rpc_client->send_request($rpc_request);
 165         #ref $rpc_response or print STDERR "XML-RPC Error: $RPC::XML::ERROR\n";
 166         print "$proj->{name}.git: CIA.vc is defunct ($cianame)\n";
 167 }
 168
 169 sub cia {
 170         my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
 171
 172         # CIA notifications for branches only
 173         my $branch = $ref;
 174         $branch =~ s#^refs/heads/## or return;
 175
 176         foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
 177                 cia_commit($cianame, $proj, $branch, $commit);
 178         }
 179 }
 180
 181
 182 sub get_commits {
 183         my ($proj, $ref, $oldrev, $newrev) = @_;
 184
 185         return () if $newrev =~ /^0+$/;
 186
 187         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
 188         my $fd;
 189
 190         open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
 191                 or die "cannot do git for-each-ref: $! $?";
 192         my @refs = <$fd>;
 193         chomp @refs;
 194         @refs = grep { $_ ne $ref } @refs;
 195         close $fd;
 196
 197         my @revlims;
 198         if (@refs) {
 199                 open $fd, '-|', @gcmd, 'rev-parse', '--not', @refs
 200                         or die "cannot do git rev-list for revlims: $! $?";
 201                 @revlims = <$fd>;
 202                 chomp @revlims;
 203                 close $fd;
 204         }
 205
 206         my $revspec = (($oldrev =~ /^0+$/) ? $newrev : "$oldrev..$newrev");
 207         open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
 208                 or die "cannot do git rev-list: $! $?";
 209         my @revs = <$fd>;
 210         chomp @revs;
 211         close $fd;
 212
 213         return @revs;
 214 }
 215
 216 sub _get_sender_uuid {
 217         my ($proj, $user) = @_;
 218
 219         my $sender;
 220         my $xtrahdr = '';
 221         my $senderemail = $proj->{email};
 222         defined($senderemail) && $senderemail ne ''
 223                 or $senderemail = $Girocco::Config::sender;
 224         if ($user) {
 225                 if ($user->{name} eq 'mob') {
 226                         $sender = "The Mob User <$senderemail>";
 227                 } else {
 228                         my $useremail = $user->{email};
 229                         defined($useremail) && $useremail ne ''
 230                                 or $useremail = $senderemail;
 231                         $sender = "$user->{name} <$useremail>";
 232                         $xtrahdr = "X-User-UUID: $user->{uuid}" if $user->{uuid};
 233                 }
 234         } else {
 235                 $sender = "$proj->{name} <$senderemail>";
 236         }
 237
 238         return ($sender, $xtrahdr);
 239 }
 240
 241 sub _notify_for_ref {
 242         $_[0] =~ m{^refs/heads/.} || $_[0] =~ m{^refs/tags/.};
 243 }
 244
 245 sub ref_change {
 246         my ($proj, $user, $ref, $oldrev, $newrev) = @_;
 247         _notify_for_ref($ref) or return 0;
 248
 249         my $mail_sh_ran = 0;
 250         chdir($proj->{path});
 251
 252         # First, possibly send out various mails
 253         if (($ref =~ m{^refs/heads/.} && $proj->{notifymail}) ||
 254             ($ref =~ m{^refs/tags/.} && ($proj->{notifymail} || $proj->{notifytag}))) {
 255                 my ($sender, $xtrahdr) = _get_sender_uuid($proj, $user);
 256                 system($Girocco::Config::basedir.'/taskd/mail.sh',
 257                         "$ref", "$oldrev", "$newrev", $proj->{name},
 258                         $sender, $xtrahdr)
 259                         and warn "mail.sh failed";
 260                 $mail_sh_ran = 1;
 261         }
 262
 263         # Next, send JSON packet to given URL if enabled.
 264         if ($proj->{notifyjson}) {
 265                 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev);
 266         }
 267
 268         # Also send CIA notifications.
 269         if ($proj->{notifycia}) {
 270                 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);
 271         }
 272
 273         return $mail_sh_ran;
 274 }
 275
 276 # ref_changes($proj, $user, [$coderef,] [$oldrefs,] @changes)
 277 # $coderef gets called with ($oldrev, $newrev, $refname, $mail_sh_ran) as each
 278 # update is processed where $mail_sh_ran will be true if mail.sh was run
 279 # $oldrefs is an optional hash of $$oldrefs{$refname} = $oldvalue
 280 # @changes is array of [$oldrev, $newrev, $ref]
 281 sub ref_changes {
 282         my $proj = shift;
 283         my $user = shift;
 284         my $proc;
 285         my $oldrefs;
 286         $proc = shift if ref($_[0]) eq 'CODE';
 287         $oldrefs = shift if ref($_[0]) eq 'HASH';
 288         foreach (@_) {
 289                 my ($old, $new, $ref) = @$_;
 290                 my $ran_mail_sh = ref_change($proj, $user, $ref, $old, $new);
 291                 &$proc($old, $new, $ref, $ran_mail_sh) if $proc;
 292         }
 293 }
 294
 295 1;