Girocco/Notify.pm: implement application/json POST type
[girocco/readme.git] / Girocco / Notify.pm
blob898e8435d7e49701c0a170ada3b2446bb7445fb4
1 package Girocco::Notify;
3 use strict;
4 use warnings;
6 use Girocco::Config;
7 use Girocco::Util;
9 use LWP::UserAgent;
11 #use RPC::XML;
12 #use RPC::XML::Client;
14 # This Perl code creates json payload within post-receive hook.
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 $_;
26 sub json_commit {
27 my ($proj, $commit, $root) = @_;
29 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
30 my $fd;
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;
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;
61 close $fd;
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 };
78 sub json {
79 my ($url, $proj, $user, $ref, $oldrev, $newrev, $forced) = @_;
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};
91 my $commits = [];
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);
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($forced ? 1 : 0),
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",
115 "url" => $Girocco::Config::gitweburl.'/'.$proj->{name}.".git",
116 # Girocco extension: Pull URL.
117 "pull_url" => $Girocco::Config::gitpullurl.'/'.$proj->{name}.".git",
119 "owner" => { "name" => "", "email" => $proj->{email} }
122 "pusher" => $pusher,
123 "sender" => $sender,
124 "commits" => $commits
127 # print "$payload\n";
128 my $ua = LWP::UserAgent->new;
129 $ua->timeout(5);
130 if (defined($proj->{jsontype}) && $proj->{jsontype} eq 'application/json') {
131 $ua->post($url, Content_Type => 'application/json', Content => $payload);
132 } else {
133 $ua->post($url, { payload => $payload });
138 sub cia_commit {
139 my ($cianame, $proj, $branch, $commit, $root) = @_;
141 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
142 my $fd;
144 open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%an <%ae>%n%at%n%s', $commit, '--'
145 or die "cannot do git log: $! $?";
146 my @l = <$fd>;
147 chomp @l;
148 close $fd;
149 foreach (@l) { s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; }
150 my ($a, $at, $subj) = @l;
152 my @f;
153 my $parent = ($commit eq $root) ? "--root" : "$commit^";
154 open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', $parent, $commit, '--'
155 or die "cannot do git diff-tree: $! $?";
156 while (<$fd>) {
157 chomp;
158 s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
159 my ($status, $file) = split(/\t/, $_);
160 push @f, $file;
162 close $fd;
164 my $rev = substr($commit, 0, 12);
166 my $msg = <<EOT;
167 <message>
168 <generator>
169 <name>Girocco::Notify</name>
170 <version>1.0</version>
171 </generator>
172 <source>
173 <project>$cianame</project>
175 if ($branch ne 'master') { # XXX: Check HEAD instead
176 $msg .= "<branch>$branch</branch>";
178 $msg .= "</source>\n";
179 $msg .= "<timestamp>$at</timestamp>\n";
180 $msg .= "<body><commit><author>$a</author><revision>$rev</revision>\n";
181 $msg .= "<url>$Girocco::Config::gitweburl/$proj->{name}.git/commit/$commit</url>\n";
182 $msg .= "<files>\n";
183 foreach (@f) { $msg .= "<file>$_</file>\n"; }
184 $msg .= "</files><log>$subj</log></commit></body></message>\n";
186 # print "$msg\n";
187 #my $rpc_client = new RPC::XML::Client "http://cia.vc/RPC2";
188 #my $rpc_request = RPC::XML::request->new('hub.deliver', $msg);
189 #my $rpc_response = $rpc_client->send_request($rpc_request);
190 #ref $rpc_response or print STDERR "XML-RPC Error: $RPC::XML::ERROR\n";
193 sub cia {
194 my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
196 # CIA notifications for branches only
197 my $branch = $ref;
198 $branch =~ s#^refs/heads/## or return;
200 my @commits = get_commits($proj, $ref, $oldrev, $newrev);
201 my $root = ($oldrev =~ /^0+$/) ? $commits[$#commits] : "";
202 foreach my $commit (@commits) {
203 cia_commit($cianame, $proj, $branch, $commit, $root);
205 print "$proj->{name}.git: CIA.vc is defunct ($cianame)\n";
209 sub get_commits {
210 my ($proj, $ref, $oldrev, $newrev) = @_;
212 return () if $newrev =~ /^0+$/;
214 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
215 my $fd;
217 open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
218 or die "cannot do git for-each-ref: $! $?";
219 my @refs = <$fd>;
220 chomp @refs;
221 @refs = grep { $_ ne $ref } @refs;
222 close $fd;
224 my @revlims;
225 if (@refs) {
226 open $fd, '-|', @gcmd, 'rev-parse', '--not', @refs
227 or die "cannot do git rev-list for revlims: $! $?";
228 @revlims = <$fd>;
229 chomp @revlims;
230 close $fd;
233 my $revspec = (($oldrev =~ /^0+$/) ? $newrev : "$oldrev..$newrev");
234 open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
235 or die "cannot do git rev-list: $! $?";
236 my @revs = <$fd>;
237 chomp @revs;
238 close $fd;
240 return @revs;
243 sub _get_sender_uuid {
244 my ($proj, $user) = @_;
246 my $sender;
247 my $xtrahdr = '';
248 my $senderemail = $proj->{email};
249 defined($senderemail) && $senderemail ne ''
250 or $senderemail = $Girocco::Config::sender;
251 if ($user) {
252 if ($user->{name} eq 'mob') {
253 $sender = "The Mob User <$senderemail>";
254 } else {
255 my $useremail = $user->{email};
256 defined($useremail) && $useremail ne ''
257 or $useremail = $senderemail;
258 $sender = "$user->{name} <$useremail>";
259 $xtrahdr = "X-User-UUID: $user->{uuid}" if $user->{uuid};
261 } else {
262 $sender = "$proj->{name} <$senderemail>";
265 return ($sender, $xtrahdr);
268 sub _notify_for_ref {
269 $_[0] =~ m{^refs/heads/.} || $_[0] =~ m{^refs/tags/.};
272 my $_ref_change;
273 BEGIN {$_ref_change = sub {
274 my ($proj, $user, $ref, $oldrev, $newrev) = @_;
275 _notify_for_ref($ref) or return (0, 0, undef);
277 my $mail_sh_ran = 0;
278 my $git_ran = 0;
279 my $ind = undef;
280 chdir($proj->{path});
282 # First, possibly send out various mails
283 if (($ref =~ m{^refs/heads/.} && $proj->{notifymail}) ||
284 ($ref =~ m{^refs/tags/.} && ($proj->{notifymail} || $proj->{notifytag}))) {
285 my ($sender, $xtrahdr) = _get_sender_uuid($proj, $user);
286 my @cmd = ($Girocco::Config::basedir.'/taskd/mail.sh',
287 "$ref", "$oldrev", "$newrev", $proj->{name},
288 $sender, $xtrahdr);
289 if (system(@cmd)) {
290 if ($? < 0 && exists($ENV{MAIL_SH_OTHER_BRANCHES})) {
291 # Let's go again
292 delete $ENV{MAIL_SH_OTHER_BRANCHES};
293 system(@cmd);
295 $? and warn "mail.sh failed";
297 $mail_sh_ran = 1;
300 # Next, send JSON packet to given URL if enabled.
301 if ($proj->{notifyjson}) {
302 ($ind, $git_ran) = ref_indicator($proj->{path}, $oldrev, $newrev);
303 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev, $ind eq '...');
306 # Also send CIA notifications.
307 if ($proj->{notifycia}) {
308 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);
311 return ($mail_sh_ran, $git_ran, $ind);
314 # ref_changes($proj, $user, [$coderef,] [$oldrefs,] @changes)
315 # $coderef gets called with ($oldrev, $newrev, $refname, $mail_sh_ran, $git_ran, $ind)
316 # as each update is processed where $mail_sh_ran will be true if mail.sh was run
317 # $ran_git will be true if git was run and $ind will be undef unless ref_indicator
318 # was run in which case it will be the ref_indicator '..' or '...' result
319 # $oldrefs is an optional hash of $$oldrefs{$refname} = $oldvalue
320 # @changes is array of [$oldrev, $newrev, $ref]
321 sub ref_changes {
322 use IPC::Open2;
324 my $proj = shift;
325 my $user = shift;
326 my $proc;
327 my $oldrefs;
328 $proc = shift if ref($_[0]) eq 'CODE';
329 $oldrefs = shift if ref($_[0]) eq 'HASH';
330 return if !@_ || ref($_[0]) ne 'ARRAY' || @{$_[0]} != 3 ||
331 !${$_[0]}[0] || !${$_[0]}[1] || !${$_[0]}[2];
333 # run custom notify if present
334 # hook protocol is the same as for Git's post-receive hook where each
335 # line sent to the hook's stdin has the form:
336 # oldhash newhash fullrefname
337 # with the following additions:
338 # * four command line arguments are passed:
339 # 1. project name (e.g. "proj" "proj/fork" "proj/fork/sub" etc.)
340 # 2. "user" responsible for the changes
341 # 3. total number of lines coming on stdin
342 # 4. how many of those lines are "context" lines (sent first)
343 # * "context" lines are sent first before any actual change lines
344 # * "context" lines have the same format except oldhash equals newhash
345 # * "context" lines give the value unchanged refs had at the time
346 # the changes to the non-"context" refs were made
347 # * currently "context" lines are only provided for "refs/heads/..."
348 # * current directory will always be the repository's top-level $GIT_DIR
349 # * the PATH is guaranteed to find the correct Git, utils and $basedir/bin
350 # * the hook need not consume all (or any) of stdin
351 # * the exit code for the hook is ignored (just like Git's post-receive)
352 # * the GIROCCO_BASEDIR environment variable is set to $Girocco::Config::basedir
353 my $customhook;
354 if (($customhook = $proj->_has_notifyhook)) {{
355 my @argv = ();
356 my $argv0;
357 if (is_shellish($customhook)) {
358 $argv0 = $Girocco::Config::posix_sh_bin || "/bin/sh";
359 push(@argv, $argv0, "-c", $customhook.' "$@"');
360 } else {
361 -f $customhook && -x _ or last;
362 $argv0 = $customhook;
364 my $username = "";
365 $username = $user->{name} if $user && defined($user->{name});
366 $username ne "" or $username = "-";
367 push(@argv, $argv0, $proj->{name}, $username);
368 my @mod = grep({$$_[2] =~ m{^refs/.} && $$_[1] ne "" && $$_[2] ne "" && $$_[1] ne $$_[2]} @_);
369 my %modref = map({($$_[2] => 1)} @mod);
370 my %same = ();
371 do {do {$same{$_} = $$oldrefs{$_} if !exists($modref{$_})} foreach keys %$oldrefs} if $oldrefs;
372 my @same = ();
373 push(@same, [$same{$_}, $same{$_}, $_]) foreach sort keys %same;
374 push(@argv, @same + @mod, @same + 0);
375 chdir($proj->{path}) or last;
376 local $ENV{GIROCCO_BASEDIR} = $Girocco::Config::basedir;
377 local $ENV{PATH} = util_path;
378 if (open my $hookpipe, '|-', @argv) {
379 local $SIG{'PIPE'} = sub {};
380 print $hookpipe map("$$_[0] $$_[1] $$_[2]\n", @same, @mod);
381 close $hookpipe;
382 } else {
383 print STDERR "$proj->{name}: failed to run notifyhook \"$customhook\": $!\n";
387 # don't even try the fancy stuff if there are too many heads
388 my $maxheads = int(100000 / (1 + length(${$_[0]}[0])));
389 my $newheadsdone = 0;
390 my @newheads = grep({$$_[2] =~ m{^refs/heads/.} && $$_[1] !~ /^0+$/} @_);
392 if ($oldrefs && @newheads && keys(%$oldrefs) + @newheads <= $maxheads) {{
393 my $projarg = '--git-dir='.$proj->{path};
395 # git merge-base --independent requires v1.7.3 or later
396 # We run it and if it fails just end up not processing indep heads last
397 # There is no version of merge-base --independent that accepts stdin revs
398 my %indep = map { $_ => 1 } split(' ',
399 get_git($projarg, 'merge-base', '--independent', map($$_[1], @newheads)) || '');
401 # We pass the revisions on stdin so this should never fail unless one of
402 # the input revisions is no longer valid (which should never happen).
403 # However, if it does, we just fall back to the old non-fancy technique.
404 my ($inp, $out, $pid2);
405 $pid2 = eval { open2($out, $inp, $Girocco::Config::git_bin, $projarg,
406 'rev-list', '--no-walk', '--reverse', '--stdin') };
407 $pid2 or last;
409 local $SIG{'PIPE'} = sub {};
410 print $inp map("$$_[1]\n", @newheads);
411 close $inp;
413 my @ordered = <$out>;
414 close $out;
415 waitpid $pid2, 0;
416 @ordered or last; # if we got nothing it failed
417 chomp(@ordered);
419 my %updates = ();
420 push(@{$updates{$$_[1]}}, $_) foreach @newheads;
421 my %curheads = %$oldrefs;
422 my $headcmp = sub {
423 if ($_[0] eq 'refs/heads/master') {
424 return ($_[1] eq 'refs/heads/master') ? 0 : -1;
425 } elsif ($_[1] eq 'refs/heads/master') {
426 return 1;
427 } else {
428 return $_[0] cmp $_[1];
431 foreach (grep(!$indep{$_}, @ordered), grep($indep{$_}, @ordered)) {
432 foreach my $change (sort {&$headcmp($$a[2], $$b[2])} @{$updates{$_}}) {
433 my ($old, $new, $ref) = @$change;
434 $ENV{MAIL_SH_OTHER_BRANCHES} = join(' ', values(%curheads));
435 my ($mail_sh_ran, $git_ran, $ind) =
436 &$_ref_change($proj, $user, $ref, $old, $new);
437 &$proc($old, $new, $ref, $mail_sh_ran, $git_ran, $ind) if $proc;
438 $curheads{$ref} = $new;
441 $newheadsdone = 1;
444 delete $ENV{MAIL_SH_OTHER_BRANCHES};
445 foreach (@_) {
446 my ($old, $new, $ref) = @$_;
447 if (!$newheadsdone || $ref !~ m{^refs/heads/.} || $new =~ /^0+$/) {
448 my $ran_mail_sh = &$_ref_change($proj, $user, $ref, $old, $new);
449 &$proc($old, $new, $ref, $ran_mail_sh) if $proc;