install.sh: verify correct install user
[girocco.git] / Girocco / Notify.pm
blobdc96d2eaafa84d5b9073c941a50f9d8bfe8b624a
1 package Girocco::Notify;
3 use strict;
4 use warnings;
6 BEGIN {
7 use Girocco::Config;
8 use Girocco::Util;
10 use JSON;
11 use LWP::UserAgent;
13 use RPC::XML;
14 use RPC::XML::Client;
18 # This Perl code creates json payload within post-receive hook.
20 sub json_commit {
21 my ($proj, $commit) = @_;
23 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
24 my $fd;
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;
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;
51 close $fd;
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 };
65 sub json {
66 my ($url, $proj, $user, $ref, $oldrev, $newrev) = @_;
68 my $pusher = {};
69 if ($user) {
70 $pusher = { "name" => $user->{name} };
71 if ($user->{name} ne 'mob') {
72 $pusher->{"email"} = $user->{email};
76 my $commits = [];
78 foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
79 push @$commits, json_commit($proj, $commit);
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,
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",
95 "url" => $Girocco::Config::gitweburl.'/'.$proj->{name}.".git",
96 # Girocco extension: Pull URL.
97 "pull_url" => $Girocco::Config::gitpullurl.'/'.$proj->{name}.".git",
99 "owner" => { "name" => "", "email" => $proj->{email} }
102 # Girocco extension
103 "pusher" => $pusher,
105 "commits" => $commits
108 # print "$payload\n";
109 my $ua = LWP::UserAgent->new;
110 $ua->timeout(5);
111 $ua->post($url, { payload => $payload });
115 sub cia_commit {
116 my ($cianame, $proj, $branch, $commit) = @_;
118 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
119 my $fd;
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;
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;
138 close $fd;
140 my $rev = substr($commit, 0, 12);
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>
151 if ($branch ne 'master') { # XXX: Check HEAD instead
152 $msg .= "<branch>$branch</branch>";
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";
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";
170 sub cia {
171 my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
173 # CIA notifications for branches only
174 my $branch = $ref;
175 $branch =~ s#^refs/heads/## or return;
177 foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
178 cia_commit($cianame, $proj, $branch, $commit);
183 sub get_commits {
184 my ($proj, $ref, $oldrev, $newrev) = @_;
186 return () if $newrev =~ /^0+$/;
188 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
189 my $fd;
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;
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;
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;
214 return @revs;
217 sub _get_sender_uuid {
218 my ($proj, $user) = @_;
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};
235 } else {
236 $sender = "$proj->{name} <$senderemail>";
239 return ($sender, $xtrahdr);
242 sub _notify_for_ref {
243 $_[0] =~ m{^refs/heads/.} || $_[0] =~ m{^refs/tags/.};
246 my $_ref_change;
247 BEGIN {$_ref_change = sub {
248 my ($proj, $user, $ref, $oldrev, $newrev) = @_;
249 _notify_for_ref($ref) or return 0;
251 my $mail_sh_ran = 0;
252 chdir($proj->{path});
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);
267 $? and warn "mail.sh failed";
269 $mail_sh_ran = 1;
272 # Next, send JSON packet to given URL if enabled.
273 if ($proj->{notifyjson}) {
274 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev);
277 # Also send CIA notifications.
278 if ($proj->{notifycia}) {
279 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);
282 return $mail_sh_ran;
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;
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];
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 # * the GIROCCO_BASEDIR environment variable is set to $Girocco::Config::basedir
322 my $customhook;
323 if (($customhook = $proj->_has_notifyhook)) {{
324 my @argv = ();
325 my $argv0;
326 if (is_shellish($customhook)) {
327 $argv0 = $Girocco::Config::posix_sh_bin || "/bin/sh";
328 push(@argv, $argv0, "-c", $customhook.' "$@"');
329 } else {
330 -f $customhook && -x _ or last;
331 $argv0 = $customhook;
333 my $username = "";
334 $username = $user->{name} if $user && defined($user->{name});
335 $username ne "" or $username = "-";
336 push(@argv, $argv0, $proj->{name}, $username);
337 my @mod = grep({$$_[2] =~ m{^refs/.} && $$_[1] ne "" && $$_[2] ne "" && $$_[1] ne $$_[2]} @_);
338 my %modref = map({($$_[2] => 1)} @mod);
339 my %same = ();
340 do {do {$same{$_} = $$oldrefs{$_} if !exists($modref{$_})} foreach keys %$oldrefs} if $oldrefs;
341 my @same = ();
342 push(@same, [$same{$_}, $same{$_}, $_]) foreach sort keys %same;
343 push(@argv, @same + @mod, @same + 0);
344 chdir($proj->{path}) or last;
345 local $ENV{GIROCCO_BASEDIR} = $Girocco::Config::basedir;
346 local $ENV{PATH} = util_path;
347 if (open my $hookpipe, '|-', @argv) {
348 local $SIG{'PIPE'} = sub {};
349 print $hookpipe map("$$_[0] $$_[1] $$_[2]\n", @same, @mod);
350 close $hookpipe;
351 } else {
352 print STDERR "$proj->{name}: failed to run notifyhook \"$customhook\": $!\n";
356 # don't even try the fancy stuff if there are too many heads
357 my $maxheads = int(100000 / (1 + length(${$_[0]}[0])));
358 my $newheadsdone = 0;
359 my @newheads = grep({$$_[2] =~ m{^refs/heads/.} && $$_[1] !~ /^0+$/} @_);
361 if ($oldrefs && @newheads && keys(%$oldrefs) + @newheads <= $maxheads) {{
362 my $projarg = '--git-dir='.$proj->{path};
364 # git merge-base --independent requires v1.7.3 or later
365 # We run it and if it fails just end up not processing indep heads last
366 # There is no version of merge-base --independent that accepts stdin revs
367 my %indep = map { $_ => 1 } split(' ',
368 get_git($projarg, 'merge-base', '--independent', map($$_[1], @newheads)) || '');
370 # We pass the revisions on stdin so this should never fail unless one of
371 # the input revisions is no longer valid (which should never happen).
372 # However, if it does, we just fall back to the old non-fancy technique.
373 my ($inp, $out, $pid2);
374 $pid2 = eval { open2($out, $inp, $Girocco::Config::git_bin, $projarg,
375 'rev-list', '--no-walk', '--reverse', '--stdin') };
376 $pid2 or last;
378 local $SIG{'PIPE'} = sub {};
379 print $inp map("$$_[1]\n", @newheads);
380 close $inp;
382 my @ordered = <$out>;
383 close $out;
384 waitpid $pid2, 0;
385 @ordered or last; # if we got nothing it failed
386 chomp(@ordered);
388 my %updates = ();
389 push(@{$updates{$$_[1]}}, $_) foreach @newheads;
390 my %curheads = %$oldrefs;
391 my $headcmp = sub {
392 if ($_[0] eq 'refs/heads/master') {
393 return ($_[1] eq 'refs/heads/master') ? 0 : -1;
394 } elsif ($_[1] eq 'refs/heads/master') {
395 return 1;
396 } else {
397 return $_[0] cmp $_[1];
400 foreach (grep(!$indep{$_}, @ordered), grep($indep{$_}, @ordered)) {
401 foreach my $change (sort {&$headcmp($$a[2], $$b[2])} @{$updates{$_}}) {
402 my ($old, $new, $ref) = @$change;
403 $ENV{MAIL_SH_OTHER_BRANCHES} = join(' ', values(%curheads));
404 my $ran_mail_sh = &$_ref_change($proj, $user, $ref, $old, $new);
405 &$proc($old, $new, $ref, $ran_mail_sh) if $proc;
406 $curheads{$ref} = $new;
409 $newheadsdone = 1;
412 delete $ENV{MAIL_SH_OTHER_BRANCHES};
413 foreach (@_) {
414 my ($old, $new, $ref) = @$_;
415 if (!$newheadsdone || $ref !~ m{^refs/heads/.} || $new =~ /^0+$/) {
416 my $ran_mail_sh = &$_ref_change($proj, $user, $ref, $old, $new);
417 &$proc($old, $new, $ref, $ran_mail_sh) if $proc;