summaryrefslogtreecommitdiff
path: root/contrib/continuous/cidaemon
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/continuous/cidaemon')
-rw-r--r--contrib/continuous/cidaemon503
1 files changed, 503 insertions, 0 deletions
diff --git a/contrib/continuous/cidaemon b/contrib/continuous/cidaemon
new file mode 100644
index 0000000000..4009a151de
--- /dev/null
+++ b/contrib/continuous/cidaemon
@@ -0,0 +1,503 @@
+#!/usr/bin/perl
+#
+# A daemon that waits for update events sent by its companion
+# post-receive-cinotify hook, checks out a new copy of source,
+# compiles it, and emails the guilty parties if the compile
+# (and optionally test suite) fails.
+#
+# To use this daemon, configure it and run it. It will disconnect
+# from your terminal and fork into the background. The daemon must
+# have local filesystem access to the source repositories, as it
+# uses objects/info/alternates to avoid copying objects.
+#
+# Add its companion post-receive-cinotify hook as the post-receive
+# hook to each repository that the daemon should monitor. Yes, a
+# single daemon can monitor more than one repository.
+#
+# To use multiple daemons on the same system, give them each a
+# unique queue file and tmpdir.
+#
+# Global Config
+# -------------
+# Reads from a Git style configuration file. This will be
+# ~/.gitconfig by default but can be overridden by setting
+# the GIT_CONFIG_FILE environment variable before starting.
+#
+# cidaemon.smtpHost
+# Hostname of the SMTP server the daemon will send email
+# through. Defaults to 'localhost'.
+#
+# cidaemon.smtpUser
+# Username to authenticate to the SMTP server as. This
+# variable is optional; if it is not supplied then no
+# authentication will be performed.
+#
+# cidaemon.smtpPassword
+# Password to authenticate to the SMTP server as. This
+# variable is optional. If not supplied but smtpUser was,
+# the daemon prompts for the password before forking into
+# the background.
+#
+# cidaemon.smtpAuth
+# Type of authentication to perform with the SMTP server.
+# If set to 'login' and smtpUser was defined, this will
+# use the AUTH LOGIN command, which is suitable for use
+# with at least one version of Microsoft Exchange Server.
+# If not set the daemon will use whatever auth methods
+# are supported by your version of Net::SMTP.
+#
+# cidaemon.email
+# Email address that daemon generated emails will be sent
+# from. This should be a useful email address within your
+# organization. Required.
+#
+# cidaemon.name
+# Human friendly name that the daemon will send emails as.
+# Defaults to 'cidaemon'.
+#
+# cidaemon.scanDelay
+# Number of seconds to sleep between polls of the queue file.
+# Defaults to 60.
+#
+# cidaemon.recentCache
+# Number of recent commit SHA-1s per repository to cache and
+# skip building if they appear again. This is useful to avoid
+# rebuilding the same commit multiple times just because it was
+# pushed into more than one branch. Defaults to 100.
+#
+# cidaemon.tmpdir
+# Scratch directory to create the builds within. The daemon
+# makes a new subdirectory for each build, then deletes it when
+# the build has finished. The pid file is also placed here.
+# Defaults to '/tmp'.
+#
+# cidaemon.queue
+# Path to the queue file that the post-receive-cinotify hook
+# appends events to. This file is polled by the daemon. It
+# must not be on an NFS mount (uses flock). Required.
+#
+# cidaemon.nocc
+# Perl regex patterns to match against author and committer
+# lines. If a pattern matches, that author or committer will
+# not be notified of a build failure.
+#
+# Per Repository Config
+# ----------------------
+# Read from the source repository's config file.
+#
+# builder.command
+# Shell command to execute the build. This command must
+# return 0 on "success" and non-zero on failure. If you
+# also want to run a test suite, make sure your command
+# does that too. Required.
+#
+# builder.queue
+# Queue file to notify the cidaemon through. Should match
+# cidaemon.queue. If not set the hook will not notify the
+# cidaemon.
+#
+# builder.skip
+# Perl regex patterns of refs that should not be sent to
+# cidaemon. Updates of these refs will be ignored.
+#
+# builder.newBranchBase
+# Glob patterns of refs that should be used to form the
+# 'old' revions of a newly created ref. This should set
+# to be globs that match your 'mainline' branches. This
+# way a build failure of a brand new topic branch does not
+# attempt to email everyone since the beginning of time;
+# instead it only emails those authors of commits not in
+# these 'mainline' branches.
+
+local $ENV{PATH} = join ':', qw(
+ /opt/git/bin
+ /usr/bin
+ /bin
+ );
+
+use strict;
+use warnings;
+use FindBin qw($RealBin);
+use File::Spec;
+use lib File::Spec->catfile($RealBin, '..', 'perl5');
+use Storable qw(retrieve nstore);
+use Fcntl ':flock';
+use POSIX qw(strftime);
+use Getopt::Long qw(:config no_auto_abbrev auto_help);
+
+sub git_config ($;$)
+{
+ my $var = shift;
+ my $required = shift || 0;
+ local *GIT;
+ open GIT, '-|','git','config','--get',$var;
+ my $r = <GIT>;
+ chop $r if $r;
+ close GIT;
+ die "error: $var not set.\n" if ($required && !$r);
+ return $r;
+}
+
+package EXCHANGE_NET_SMTP;
+
+# Microsoft Exchange Server requires an 'AUTH LOGIN'
+# style of authentication. This is different from
+# the default supported by Net::SMTP so we subclass
+# and override the auth method to support that.
+
+use Net::SMTP;
+use Net::Cmd;
+use MIME::Base64 qw(encode_base64);
+our @ISA = qw(Net::SMTP);
+our $auth_type = ::git_config 'cidaemon.smtpAuth';
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ $type->SUPER::new(@_);
+}
+
+sub auth
+{
+ my $self = shift;
+ return $self->SUPER::auth(@_) unless $auth_type eq 'login';
+
+ my $user = encode_base64 shift, '';
+ my $pass = encode_base64 shift, '';
+ return 0 unless CMD_MORE == $self->command("AUTH LOGIN")->response;
+ return 0 unless CMD_MORE == $self->command($user)->response;
+ CMD_OK == $self->command($pass)->response;
+}
+
+package main;
+
+my ($debug_flag, %recent);
+
+my $ex_host = git_config('cidaemon.smtpHost') || 'localhost';
+my $ex_user = git_config('cidaemon.smtpUser');
+my $ex_pass = git_config('cidaemon.smtpPassword');
+
+my $ex_from_addr = git_config('cidaemon.email', 1);
+my $ex_from_name = git_config('cidaemon.name') || 'cidaemon';
+
+my $scan_delay = git_config('cidaemon.scanDelay') || 60;
+my $recent_size = git_config('cidaemon.recentCache') || 100;
+my $tmpdir = git_config('cidaemon.tmpdir') || '/tmp';
+my $queue_name = git_config('cidaemon.queue', 1);
+my $queue_lock = "$queue_name.lock";
+
+my @nocc_list;
+open GIT,'git config --get-all cidaemon.nocc|';
+while (<GIT>) {
+ chop;
+ push @nocc_list, $_;
+}
+close GIT;
+
+sub nocc_author ($)
+{
+ local $_ = shift;
+ foreach my $pat (@nocc_list) {
+ return 1 if /$pat/;
+ }
+ 0;
+}
+
+sub input_echo ($)
+{
+ my $prompt = shift;
+
+ local $| = 1;
+ print $prompt;
+ my $input = <STDIN>;
+ chop $input;
+ return $input;
+}
+
+sub input_noecho ($)
+{
+ my $prompt = shift;
+
+ my $end = sub {system('stty','echo');print "\n";exit};
+ local $SIG{TERM} = $end;
+ local $SIG{INT} = $end;
+ system('stty','-echo');
+
+ local $| = 1;
+ print $prompt;
+ my $input = <STDIN>;
+ system('stty','echo');
+ print "\n";
+ chop $input;
+ return $input;
+}
+
+sub rfc2822_date ()
+{
+ strftime("%a, %d %b %Y %H:%M:%S %Z", localtime);
+}
+
+sub send_email ($$$)
+{
+ my ($subj, $body, $to) = @_;
+ my $now = rfc2822_date;
+ my $to_str = '';
+ my @rcpt_to;
+ foreach (@$to) {
+ my $s = $_;
+ $s =~ s/^/"/;
+ $s =~ s/(\s+<)/"$1/;
+ $to_str .= ', ' if $to_str;
+ $to_str .= $s;
+ push @rcpt_to, $1 if $s =~ /<(.*)>/;
+ }
+ die "Nobody to send to.\n" unless @rcpt_to;
+ my $msg = <<EOF;
+From: "$ex_from_name" <$ex_from_addr>
+To: $to_str
+Date: $now
+Subject: $subj
+
+$body
+EOF
+
+ my $smtp = EXCHANGE_NET_SMTP->new(Host => $ex_host)
+ or die "Cannot connect to $ex_host: $!\n";
+ if ($ex_user && $ex_pass) {
+ $smtp->auth($ex_user,$ex_pass)
+ or die "$ex_host rejected $ex_user\n";
+ }
+ $smtp->mail($ex_from_addr)
+ or die "$ex_host rejected $ex_from_addr\n";
+ scalar($smtp->recipient(@rcpt_to, { SkipBad => 1 }))
+ or die "$ex_host did not accept any addresses.\n";
+ $smtp->data($msg)
+ or die "$ex_host rejected message data\n";
+ $smtp->quit;
+}
+
+sub pop_queue ()
+{
+ open LOCK, ">$queue_lock" or die "Can't open $queue_lock: $!";
+ flock LOCK, LOCK_EX;
+
+ my $queue = -f $queue_name ? retrieve $queue_name : [];
+ my $ent = shift @$queue;
+ nstore $queue, $queue_name;
+
+ flock LOCK, LOCK_UN;
+ close LOCK;
+ $ent;
+}
+
+sub git_exec (@)
+{
+ system('git',@_) == 0 or die "Cannot git " . join(' ', @_) . "\n";
+}
+
+sub git_val (@)
+{
+ open(C, '-|','git',@_);
+ my $r = <C>;
+ chop $r if $r;
+ close C;
+ $r;
+}
+
+sub do_build ($$)
+{
+ my ($git_dir, $new) = @_;
+
+ my $tmp = File::Spec->catfile($tmpdir, "builder$$");
+ system('rm','-rf',$tmp) == 0 or die "Cannot clear $tmp\n";
+ die "Cannot clear $tmp.\n" if -e $tmp;
+
+ my $result = 1;
+ eval {
+ my $command;
+ {
+ local $ENV{GIT_DIR} = $git_dir;
+ $command = git_val 'config','builder.command';
+ }
+ die "No builder.command for $git_dir.\n" unless $command;
+
+ git_exec 'clone','-n','-l','-s',$git_dir,$tmp;
+ chmod 0700, $tmp or die "Cannot lock $tmp\n";
+ chdir $tmp or die "Cannot enter $tmp\n";
+
+ git_exec 'update-ref','HEAD',$new;
+ git_exec 'read-tree','-m','-u','HEAD','HEAD';
+ system $command;
+ if ($? == -1) {
+ print STDERR "failed to execute '$command': $!\n";
+ $result = 1;
+ } elsif ($? & 127) {
+ my $sig = $? & 127;
+ print STDERR "'$command' died from signal $sig\n";
+ $result = 1;
+ } else {
+ my $r = $? >> 8;
+ print STDERR "'$command' exited with $r\n" if $r;
+ $result = $r;
+ }
+ };
+ if ($@) {
+ $result = 2;
+ print STDERR "$@\n";
+ }
+
+ chdir '/';
+ system('rm','-rf',$tmp);
+ rmdir $tmp;
+ $result;
+}
+
+sub build_failed ($$$$$)
+{
+ my ($git_dir, $ref, $old, $new, $msg) = @_;
+
+ $git_dir =~ m,/([^/]+)$,;
+ my $repo_name = $1;
+ $ref =~ s,^refs/(heads|tags)/,,;
+
+ my %authors;
+ my $shortlog;
+ my $revstr;
+ {
+ local $ENV{GIT_DIR} = $git_dir;
+ my @revs = ($new);
+ push @revs, '--not', @$old if @$old;
+ open LOG,'-|','git','rev-list','--pretty=raw',@revs;
+ while (<LOG>) {
+ if (s/^(author|committer) //) {
+ chomp;
+ s/>.*$/>/;
+ $authors{$_} = 1 unless nocc_author $_;
+ }
+ }
+ close LOG;
+ open LOG,'-|','git','shortlog',@revs;
+ $shortlog .= $_ while <LOG>;
+ close LOG;
+ $revstr = join(' ', @revs);
+ }
+
+ my @to = sort keys %authors;
+ unless (@to) {
+ print STDERR "error: No authors in $revstr\n";
+ return;
+ }
+
+ my $subject = "[$repo_name] $ref : Build Failed";
+ my $body = <<EOF;
+Project: $git_dir
+Branch: $ref
+Commits: $revstr
+
+$shortlog
+Build Output:
+--------------------------------------------------------------
+$msg
+EOF
+ send_email($subject, $body, \@to);
+}
+
+sub run_build ($$$$)
+{
+ my ($git_dir, $ref, $old, $new) = @_;
+
+ if ($debug_flag) {
+ my @revs = ($new);
+ push @revs, '--not', @$old if @$old;
+ print "BUILDING $git_dir\n";
+ print " BRANCH: $ref\n";
+ print " COMMITS: ", join(' ', @revs), "\n";
+ }
+
+ local(*R, *W);
+ pipe R, W or die "cannot pipe builder: $!";
+
+ my $builder = fork();
+ if (!defined $builder) {
+ die "cannot fork builder: $!";
+ } elsif (0 == $builder) {
+ close R;
+ close STDIN;open(STDIN, '/dev/null');
+ open(STDOUT, '>&W');
+ open(STDERR, '>&W');
+ exit do_build $git_dir, $new;
+ } else {
+ close W;
+ my $out = '';
+ $out .= $_ while <R>;
+ close R;
+ waitpid $builder, 0;
+ build_failed $git_dir, $ref, $old, $new, $out if $?;
+ }
+
+ print "DONE\n\n" if $debug_flag;
+}
+
+sub daemon_loop ()
+{
+ my $run = 1;
+ my $stop_sub = sub {$run = 0};
+ $SIG{HUP} = $stop_sub;
+ $SIG{INT} = $stop_sub;
+ $SIG{TERM} = $stop_sub;
+
+ mkdir $tmpdir, 0755;
+ my $pidfile = File::Spec->catfile($tmpdir, "cidaemon.pid");
+ open(O, ">$pidfile"); print O "$$\n"; close O;
+
+ while ($run) {
+ my $ent = pop_queue;
+ if ($ent) {
+ my ($git_dir, $ref, $old, $new) = @$ent;
+
+ $ent = $recent{$git_dir};
+ $recent{$git_dir} = $ent = [[], {}] unless $ent;
+ my ($rec_arr, $rec_hash) = @$ent;
+ next if $rec_hash->{$new}++;
+ while (@$rec_arr >= $recent_size) {
+ my $to_kill = shift @$rec_arr;
+ delete $rec_hash->{$to_kill};
+ }
+ push @$rec_arr, $new;
+
+ run_build $git_dir, $ref, $old, $new;
+ } else {
+ sleep $scan_delay;
+ }
+ }
+
+ unlink $pidfile;
+}
+
+$debug_flag = 0;
+GetOptions(
+ 'debug|d' => \$debug_flag,
+ 'smtp-user=s' => \$ex_user,
+) or die "usage: $0 [--debug] [--smtp-user=user]\n";
+
+$ex_pass = input_noecho("$ex_user SMTP password: ")
+ if ($ex_user && !$ex_pass);
+
+if ($debug_flag) {
+ daemon_loop;
+ exit 0;
+}
+
+my $daemon = fork();
+if (!defined $daemon) {
+ die "cannot fork daemon: $!";
+} elsif (0 == $daemon) {
+ close STDIN;open(STDIN, '/dev/null');
+ close STDOUT;open(STDOUT, '>/dev/null');
+ close STDERR;open(STDERR, '>/dev/null');
+ daemon_loop;
+ exit 0;
+} else {
+ print "Daemon $daemon running in the background.\n";
+}