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, 0 insertions, 503 deletions
diff --git a/contrib/continuous/cidaemon b/contrib/continuous/cidaemon
deleted file mode 100644
index 4009a151de..0000000000
--- a/contrib/continuous/cidaemon
+++ /dev/null
@@ -1,503 +0,0 @@
-#!/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";
-}