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 STDERR "$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         my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
 186         my $fd;
 187
 188         open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
 189                 or die "cannot do git for-each-ref: $! $?";
 190         my @refs = <$fd>;
 191         chomp @refs;
 192         @refs = grep { $_ ne $ref } @refs;
 193         close $fd;
 194
 195         my @revlims;
 196         if (@refs) {
 197                 open $fd, '-|', @gcmd, 'rev-parse', '--not', @refs
 198                         or die "cannot do git rev-list for revlims: $! $?";
 199                 @revlims = <$fd>;
 200                 chomp @revlims;
 201                 close $fd;
 202         }
 203
 204         my $revspec = (($oldrev =~ /^0+$/) ? $newrev : "$oldrev..$newrev");
 205         open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
 206                 or die "cannot do git rev-list: $! $?";
 207         my @revs = <$fd>;
 208         chomp @revs;
 209         close $fd;
 210
 211         return @revs;
 212 }
 213
 214
 215 sub ref_change {
 216         my ($proj, $user, $ref, $oldrev, $newrev) = @_;
 217
 218         chdir($proj->{path});
 219
 220         # First, possibly send out various mails
 221         if ($proj->{notifymail}) {
 222                 my $sender;
 223                 my $xtrahdr = '';
 224                 if ($user) {
 225                         if ($user->{name} eq 'mob') {
 226                                 $sender = "The Mob User <$proj->{email}>";
 227                         } else {
 228                                 $sender = "$user->{name} <$user->{email}>";
 229                                 $xtrahdr = "X-User-UUID: $user->{uuid}" if $user->{uuid};
 230                         }
 231                 } else {
 232                         $sender = "$proj->{name} <$proj->{email}>";
 233                 }
 234                 system($Girocco::Config::basedir.'/taskd/mail.sh',
 235                         "$ref", "$oldrev", "$newrev", $proj->{name},
 236                         $sender, $xtrahdr)
 237                         and warn "mail.sh failed";
 238         }
 239
 240         # Next, send JSON packet to given URL if enabled.
 241         if ($proj->{notifyjson}) {
 242                 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev);
 243         }
 244
 245         # Also send CIA notifications.
 246         if ($proj->{notifycia}) {
 247                 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);
 248         }
 249 }
 250
 251
 252 1;