# -*- perl -*-
#
# Test::AutoBuild::Stage::EmailAlert by Daniel P. Berrange <dan@berrange.com>
#
# Copyright (C) 2002-2006 Daniel Berrange <dan@berrange.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# $Id$
=pod
=head1 NAME
Test::AutoBuild::Stage::EmailAlert - Send email alerts with build status
=head1 SYNOPSIS
use Test::AutoBuild::Stage::EmailAlert
=head1 DESCRIPTION
This module generates email alerts at the end of a build containing
status information. They can be sent on every cycle, or just when
the cycle has a failure.
=head1 METHODS
=over 4
=cut
package Test::AutoBuild::Stage::EmailAlert;
use base qw(Test::AutoBuild::Stage);
use warnings;
use strict;
use Net::SMTP;
use IO::Scalar;
use Log::Log4perl;
use POSIX qw(strftime);
use Template;
use Sys::Hostname;
use Test::AutoBuild::Lib;
sub process {
my $self = shift;
my $runtime = shift;
my $log = Log::Log4perl->get_logger();
my $from = $self->option("from");
unless (defined $from) {
my ($name,$passwd,$uid,$gid,
$quota,$comment,$gcos,$dir,$shell,$expire) = getpwuid($>);
my $email = $name . '@' . hostname;
if ($comment) {
$from = $comment . " <" . $email . ">";
} else {
$from = $email;
}
$log->debug("No from address set, so using '$from'");
}
my $trigger = $self->option("trigger");
$trigger = "first-fail" unless defined $trigger;
my $scope = $self->option("scope");
$scope = "global" unless $scope;
if ($scope eq "module") {
$log->info("Sending one mail per module");
foreach my $name (sort { $a cmp $b } $runtime->modules) {
my $module = $runtime->module($name);
my $to = $self->option("to");
$to = "admin" unless defined $to;
my @to;
foreach my $addr (split /,/, $to) {
$addr =~ s/^\s*//g;
$addr =~ s/\s*$//g;
if ((lc $addr) eq "admin") {
if (defined $module->admin_email) {
push @to, $module->admin_name . " <" . $module->admin_email . ">";
} else {
push @to, $runtime->admin_name . " <" . $runtime->admin_email . ">";
}
$log->debug("Resolved module administrator address to '" . $to[$#to] . "'");
} elsif ((lc $addr) eq "group") {
if (defined $module->group_email) {
push @to, $module->group_name . " <" . $module->group_email . ">";
} else {
push @to, $runtime->group_name . " <" . $runtime->group_email . ">";
}
$log->debug("Resolved module developer group address to '" . $to[$#to] . "'");
} else {
push @to, $addr;
}
}
if ((lc $trigger) eq "always") {
$log->debug("Sending regardless of status");
$self->dispatch_message($runtime, $from, \@to, [$name]);
} elsif ($module->status eq "failed") {
if ((lc $trigger) eq "fail") {
$log->debug("Sending due to failure");
$self->dispatch_message($runtime, $from, \@to, [$name]);
} else {
my $newfail = 0;
my $arcman = $runtime->archive_manager;
if ($arcman) {
my $cache = $arcman->get_previous_archive;
if ($cache) {
my $result = $cache->get_data($module->name, "build");
if ($result->{status} ne "failed") {
$log->debug("Previous status was " . $result->{status});
$newfail = 1;
}
} else {
$log->debug("No cache, treating as new failure");
$newfail = 1;
}
} else {
$log->debug("No archive manager, treating as new failure");
$newfail = 1;
}
if ($newfail) {
$log->debug("Sending due to new failure");
$self->dispatch_message($runtime, $from, \@to, [$name]);
} else {
$log->debug("Not sending because failure was not new");
}
}
} else {
$log->debug("Not sending because no failures occurred");
}
}
} else {
$log->info("Sending one mail for entire cycle");
my $to = $self->option("to");
$to = "admin" unless defined $to;
my @to;
foreach my $addr (split /,/, $to) {
$addr =~ s/^\s*//g;
$addr =~ s/\s*$//g;
if ((lc $addr) eq "admin") {
push @to, $runtime->admin_name . " <" . $runtime->admin_email . ">";
$log->debug("Resolved build administrator address to '" . $to[$#to] . "'");
} elsif ((lc $addr) eq "group") {
push @to, $runtime->group_name . " <" . $runtime->group_email . ">";
$log->debug("Resolved build developer group address to '" . $to[$#to] . "'");
} else {
push @to, $addr;
}
}
my @modules = $runtime->modules;
if ((lc $trigger) eq "always") {
$log->debug("Sending regardless of status");
$self->dispatch_message($runtime, $from, \@to, \@modules);
} else {
my $failed = 0;
foreach my $name (@modules) {
if ($runtime->module($name)->status eq "failed") {
$failed = 1;
}
}
if ($failed) {
if ((lc $trigger) eq "fail") {
$log->debug("Sending due to failure");
$self->dispatch_message($runtime, $from, \@to, \@modules);
} else {
my $newfail = 0;
my $arcman = $runtime->archive_manager;
if ($arcman) {
my $cache = $arcman->get_previous_archive;
if ($cache) {
foreach my $name (@modules) {
if ($runtime->module($name)->status eq "failed") {
my $result = $cache->get_data($name, "build");
if (!$result->{status} || $result->{status} ne "failed") {
$log->debug("Previous status was " . $result->{status});
$newfail = 1;
}
}
}
} else {
$log->debug("No cache, treating as new failure");
$newfail = 1;
}
} else {
$log->debug("No archive manager, treating as new failure");
$newfail = 1;
}
if ($newfail) {
$log->debug("Sending due to new failure");
$self->dispatch_message($runtime, $from, \@to, \@modules);
} else {
$log->debug("Not sending because failure was not new");
}
}
} else {
$log->debug("Not sending because no failures occurred");
}
}
}
}
sub prepare {
my $self = shift;
my $runtime = shift;
$self->{cycle_start_time} = time;
$self->SUPER::prepare($runtime);
}
# XXX need to refactor wrt to TemplateGenerator & HTMLStatus classes
sub dispatch_message {
my $self = shift;
my $runtime = shift;
my $from = shift;
my $to = shift;
my $modules = shift;
my $log = Log::Log4perl->get_logger();
$log->debug("Dispatching messages");
my $path = $self->option("template-dir");
my %config = (
INCLUDE_PATH => $path
);
my $template = Template->new(\%config);
my $globalvars = {};
my $now = time;
my $then = $self->{cycle_start_time};
my $cycle_time = $now - $then + 1;
my $overall_status = 'success';
foreach my $name ($runtime->modules()) {
if ($runtime->module($name)->status() eq 'failed') {
$overall_status = 'failed';
}
}
$globalvars->{'status'} = $overall_status;
$globalvars->{'cycle_end_date'} = strftime ("%a %b %e %Y", gmtime $now);
$globalvars->{'cycle_end_time_utc'} = strftime ("%H:%M:%S", gmtime $now) . " UTC";
$globalvars->{'cycle_end_time_local'} = strftime ("%H:%M:%S %Z", localtime $now);
$globalvars->{'cycle_start_date'} = strftime ("%a %b %e %Y", gmtime $then);
$globalvars->{'cycle_start_time_utc'} = strftime ("%H:%M:%S", gmtime $then) . " UTC";
$globalvars->{'cycle_start_time_local'} = strftime ("%H:%M:%S %Z", localtime $then);
$globalvars->{'cycle_duration'} = Test::AutoBuild::Lib::pretty_time($cycle_time);
$globalvars->{'build_counter'} = $runtime->build_counter;
$globalvars->{'build_timestamp'} = $runtime->timestamp;
$globalvars->{'admin_email'} = $runtime->admin_email;
$globalvars->{'admin_name'} = $runtime->admin_name;
$globalvars->{'hostname'} = hostname();
my $smtp_server = $self->option("smtp_server");
$smtp_server = "localhost" unless defined $smtp_server;
my @mods;
# Grab data from modules
foreach my $name (sort @{$modules}) {
my $module = $runtime->module($name);
my $build_start = $module->build_start_date;
my $build_end = $module->build_end_date;
my $mod = {
'name' => $name,
'label' => $module->label,
'status' => $module->status,
'build_status' => $module->build_status,
'build_duration' => Test::AutoBuild::Lib::pretty_time($build_end - $build_start),
'build_date' => scalar (Test::AutoBuild::Lib::pretty_date($build_start)),
'admin_email' => $module->admin_email,
'admin_name' => $module->admin_name,
};
push @mods, $mod;
}
foreach my $addr (@{$to}) {
$log->debug("Generating message to '$addr'");
my %vars = %{$globalvars};
$vars{'to'} = $addr;
$vars{'from'} = $from;
$vars{'modules'} = \@mods;
my $localvars = $self->option("variables");
if ($localvars) {
foreach my $name (keys %{$localvars}) {
$vars{$name} = $localvars->{$name};
}
}
my $body;
my $template_file = $self->option("template-file") || "email.txt";
if (!$template->process($template_file, \%vars, IO::Scalar->new(\$body))) {
$self->fail($template->error->as_string);
$log->warn("Could not format mail body: " . $template->error->as_string);
return;
}
$self->send_message($smtp_server, $from, $addr, $body);
}
}
sub send_message {
my $self = shift;
my $smtp_server = shift;
my $from = shift;
my $to = shift;
my $body = shift;
my $log = Log::Log4perl->get_logger();
my $smtp = Net::SMTP->new($smtp_server);
die "Couldn't connect to server $smtp_server" unless $smtp;
$log->info("Sending a message to $to");
$smtp->mail($from);
$smtp->to($to);
$smtp->data();
$smtp->datasend ($body);
$smtp->dataend();
$smtp->quit();
}
1 # So that the require or use succeeds.
__END__
=back
=head1 AUTHORS
Daniel P. Berrange <dan@berrange.com>
=head1 COPYRIGHT
Copyright (C) 2002-2006 Daniel Berrange <dan@berrange.com>
=head1 SEE ALSO
C<perl(1)>, L<Net::SMTP>, L<Test::AutoBuild::Stage>, L<Test::AutoBuild::Runtime>, L<Test::AutoBuild::Module>,
L<Template>, L<http://template-toolkit.org>
=cut