hydra/src/script/hydra_evaluator.pl

249 lines
7.3 KiB
Perl
Raw Normal View History

2008-11-28 16:13:06 +00:00
#! /var/run/current-system/sw/bin/perl -w
use strict;
2009-03-09 13:04:46 +00:00
use feature 'switch';
2008-11-25 11:09:15 +00:00
use Hydra::Schema;
2008-11-28 14:36:04 +00:00
use Hydra::Helper::Nix;
use Hydra::Helper::AddBuilds;
use Digest::SHA qw(sha256_hex);
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP;
use Email::Simple;
use Email::Simple::Creator;
use Sys::Hostname::Long;
use Config::General;
use Data::Dump qw(dump);
2009-04-22 22:59:54 +00:00
STDOUT->autoflush();
2008-11-28 14:36:04 +00:00
my $db = openHydraDB;
my %config = new Config::General($ENV{"HYDRA_CONFIG"})->getall;
2008-11-05 04:52:52 +00:00
2009-03-09 13:04:46 +00:00
sub fetchInputs {
my ($project, $jobset, $inputInfo) = @_;
2009-03-09 13:04:46 +00:00
foreach my $input ($jobset->jobsetinputs->all) {
foreach my $alt ($input->jobsetinputalts->all) {
if($input->type eq "sysbuild") {
my @info = fetchInput($db, $project, $jobset, $input->name, $input->type, $alt->value);
foreach my $info_el (@info) {
push @{$$inputInfo{$input->name}}, $info_el if defined $info_el;
}
} else {
my $info = fetchInput($db, $project, $jobset, $input->name, $input->type, $alt->value);
push @{$$inputInfo{$input->name}}, $info if defined $info;
}
2009-03-09 13:04:46 +00:00
}
}
}
sub setJobsetError {
my ($jobset, $errorMsg) = @_;
eval {
txn_do($db, sub {
2009-03-09 16:22:41 +00:00
$jobset->update({errormsg => $errorMsg, errortime => time});
});
};
sendJobsetErrorNotification($jobset, $errorMsg);
}
sub sendJobsetErrorNotification() {
my ($jobset, $errorMsg) = @_;
return if $jobset->project->owner->emailonerror == 0;
return if $errorMsg eq "";
my $url = hostname_long;
my $projectName = $jobset->project->name;
my $jobsetName = $jobset->name;
my $sender = $config{'notification_sender'} ||
(($ENV{'USER'} || "hydra") . "@" . $url);
my $body = "Hi,\n"
. "\n"
. "This is to let you know that Hydra jobset evalation of $projectName:$jobsetName "
. "resulted in the following error:\n"
. "\n"
. "$errorMsg"
. "\n"
. "Regards,\n\nThe Hydra build daemon.\n";
my $email = Email::Simple->create(
header => [
To => $jobset->project->owner->emailaddress,
From => "Hydra Build Daemon <$sender>",
Subject => "Hydra $projectName:$jobsetName evaluation error",
'X-Hydra-Instance' => $url,
'X-Hydra-Project' => $projectName,
'X-Hydra-Jobset' => $jobsetName
],
body => ""
);
$email->body_set($body);
print $email->as_string if $ENV{'HYDRA_MAIL_TEST'};
sendmail($email);
}
sub permute {
my @list = @_;
for (my $n = scalar @list - 1; $n > 0; $n--) {
my $k = int(rand($n + 1)); # 0 <= $k <= $n
@list[$n, $k] = @list[$k, $n];
}
return @list;
}
sub checkJobset {
2008-11-07 14:51:44 +00:00
my ($project, $jobset) = @_;
my $inputInfo = {};
2008-11-26 13:39:15 +00:00
2009-03-09 13:04:46 +00:00
# Fetch all values for all inputs.
my $checkoutStart = time;
fetchInputs($project, $jobset, $inputInfo);
my $checkoutStop = time;
2008-11-07 14:51:44 +00:00
# Hash the arguments to hydra_eval_jobs and check the
# JobsetInputHashes to see if we've already evaluated this set of
# inputs. If so, bail out.
my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo));
my $argsHash = sha256_hex("@args");
if ($jobset->jobsetevals->find({hash => $argsHash})) {
print " already evaluated, skipping\n";
txn_do($db, sub {
$jobset->update({lastcheckedtime => time});
});
return;
}
2009-03-09 13:04:46 +00:00
# Evaluate the job expression.
my $evalStart = time;
2009-10-26 17:01:23 +00:00
my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
my $evalStop = time;
2009-03-09 15:16:11 +00:00
txn_do($db, sub {
# Schedule each successfully evaluated job.
my %currentBuilds;
foreach my $job (permute @{$jobs->{job}}) {
next if $job->{jobName} eq "";
print "considering job " . $job->{jobName} . "\n";
checkBuild($db, $project, $jobset, $inputInfo, $nixExprInput, $job, \%currentBuilds);
}
# Update the last checked times and error messages for each
# job.
my %failedJobNames;
push @{$failedJobNames{$_->{location}}}, $_->{msg} foreach @{$jobs->{error}};
$jobset->update({lastcheckedtime => time});
2009-10-26 15:55:19 +00:00
foreach my $job ($jobset->jobs->all) {
if ($failedJobNames{$job->name}) {
$job->update({errormsg => join '\n', @{$failedJobNames{$job->name}}});
2009-03-13 14:49:25 +00:00
} else {
2009-10-26 15:55:19 +00:00
$job->update({errormsg => undef});
2009-03-13 14:49:25 +00:00
}
}
# Clear the "current" flag on all builds that are no longer
# current.
foreach my $build ($jobset->builds->search({iscurrent => 1})) {
2010-03-05 17:48:00 +00:00
$build->update({iscurrent => 0}) unless defined $currentBuilds{$build->id};
}
my $hasNewBuilds = 0;
while (my ($id, $new) = each %currentBuilds) {
$hasNewBuilds = 1 if $new;
}
my $ev = $jobset->jobsetevals->create(
{ hash => $argsHash
, timestamp => time
, checkouttime => abs($checkoutStop - $checkoutStart)
, evaltime => abs($evalStop - $evalStart)
, hasnewbuilds => $hasNewBuilds
});
if ($hasNewBuilds) {
while (my ($id, $new) = each %currentBuilds) {
$ev->jobsetevalmembers->create({ build => $id, isnew => $new });
}
}
});
2009-03-09 15:16:11 +00:00
# Store the errors messages for jobs that failed to evaluate.
my $msg = "";
foreach my $error (@{$jobs->{error}}) {
my $bindings = "";
foreach my $arg (@{$error->{arg}}) {
my $input = $inputInfo->{$arg->{name}}->[$arg->{altnr}] or die "invalid input";
$bindings .= ", " if $bindings ne "";
$bindings .= $arg->{name} . " = ";
given ($input->{type}) {
when ("string") { $bindings .= "\"" . $input->{value} . "\""; }
when ("boolean") { $bindings .= $input->{value}; }
default { $bindings .= "..."; }
}
}
$msg .= "at `" . $error->{location} . "' [$bindings]:\n" . $error->{msg} . "\n\n";
2009-03-09 15:16:11 +00:00
}
setJobsetError($jobset, $msg);
2008-11-04 18:23:28 +00:00
}
sub checkJobsetWrapped {
my ($project, $jobset) = @_;
print "considering jobset ", $jobset->name, " in ", $project->name, "\n";
eval {
checkJobset($project, $jobset);
};
if ($@) {
my $msg = $@;
print "error evaluating jobset ", $jobset->name, ": $msg";
txn_do($db, sub {
$jobset->update({lastcheckedtime => time});
setJobsetError($jobset, $msg);
});
}
}
2008-11-04 18:23:28 +00:00
2009-10-26 15:55:19 +00:00
sub checkProjects {
2008-11-18 12:48:58 +00:00
foreach my $project ($db->resultset('Projects')->search({enabled => 1})) {
print "considering project ", $project->name, "\n";
2009-10-08 11:39:16 +00:00
checkJobsetWrapped($project, $_)
foreach $project->jobsets->search({enabled => 1});
2008-11-04 18:23:28 +00:00
}
}
2009-03-05 12:32:14 +00:00
# For testing: evaluate a single jobset, then exit.
if (scalar @ARGV == 2) {
my $projectName = $ARGV[0];
my $jobsetName = $ARGV[1];
my $jobset = $db->resultset('Jobsets')->find($projectName, $jobsetName) or die;
checkJobsetWrapped($jobset->project, $jobset);
2009-03-05 12:32:14 +00:00
exit 0;
}
while (1) {
2009-03-23 01:13:37 +00:00
eval {
2009-10-26 15:55:19 +00:00
checkProjects;
2009-03-23 01:13:37 +00:00
};
if ($@) { print "$@"; }
print "sleeping...\n";
sleep 30;
}