Girocco/Notify.pm

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