diff options
Diffstat (limited to 'contrib/continuous/cidaemon')
| -rw-r--r-- | contrib/continuous/cidaemon | 503 |
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"; +} |