ahuston-0/hydra
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

* Move everything up one directory.

Browse Source
This commit is contained in:
Eelco Dolstra
2009-03-05 13:41:57 +00:00
parent 6de278754a
commit 97ed2052ba
84 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

299
src/script/hydra_build.pl Executable file
View File

@ -0,0 +1,299 @@
#! /var/run/current-system/sw/bin/perl -w
use strict;
use File::Basename;
use File::stat;
use Hydra::Schema;
use Hydra::Helper::Nix;
my $db = openHydraDB;
sub doBuild {
my ($build) = @_;
my $drvPath = $build->drvpath;
my $outPath = $build->outpath;
my $isCachedBuild = 1;
my $outputCreated = 1; # i.e., the Nix build succeeded (but it could be a positive failure)
my $startTime = 0;
my $stopTime = 0;
my $buildStatus = 0; # = succeeded
my $errormsg = undef;
registerRoot $outPath;
if (!isValidPath($outPath)) {
$isCachedBuild = 0;
$startTime = time();
my $thisBuildFailed = 0;
my $someBuildFailed = 0;
# Run Nix to perform the build, and monitor the stderr output
# to get notifications about specific build steps, the
# associated log files, etc.
my $cmd = "nix-store --max-silent-time 1800 --keep-going --no-build-output " .
"--log-type flat --print-build-trace --realise $drvPath 2>&1";
my $buildStepNr = 1;
open OUT, "$cmd |" or die;
while (<OUT>) {
$errormsg .= $_;
unless (/^@\s+/) {
print STDERR "$_";
next;
}
if (/^@\s+build-started\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)$/) {
$db->txn_do(sub {
$db->resultset('BuildSteps')->create(
{ id => $build->id
, stepnr => $buildStepNr++
, type => 0 # = build
, drvpath => $1
, outpath => $2
, logfile => $4
, busy => 1
, starttime => time
});
});
}
elsif (/^@\s+build-succeeded\s+(\S+)\s+(\S+)$/) {
my $drvPath = $1;
$db->txn_do(sub {
(my $step) = $db->resultset('BuildSteps')->search(
{id => $build->id, type => 0, drvpath => $drvPath}, {});
die unless $step;
$step->busy(0);
$step->status(0);
$step->stoptime(time);
$step->update;
});
}
elsif (/^@\s+build-failed\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$/) {
my $drvPathStep = $1;
$someBuildFailed = 1;
$thisBuildFailed = 1 if $drvPath eq $drvPathStep;
$db->txn_do(sub {
(my $step) = $db->resultset('BuildSteps')->search(
{id => $build->id, type => 0, drvpath => $drvPathStep}, {});
if ($step) {
die unless $step;
$step->busy(0);
$step->status(1);
$step->errormsg($4);
$step->stoptime(time);
$step->update;
} else {
$db->resultset('BuildSteps')->create(
{ id => $build->id
, stepnr => $buildStepNr++
, type => 0 # = build
, drvpath => $drvPathStep
, outpath => $2
, logfile => $4
, busy => 0
, status => 1
, starttime => time
, stoptime => time
, errormsg => $4
});
}
});
}
elsif (/^@\s+substituter-started\s+(\S+)\s+(\S+)$/) {
my $outPath = $1;
$db->txn_do(sub {
$db->resultset('BuildSteps')->create(
{ id => $build->id
, stepnr => $buildStepNr++
, type => 1 # = substitution
, outpath => $1
, busy => 1
, starttime => time
});
});
}
elsif (/^@\s+substituter-succeeded\s+(\S+)$/) {
my $outPath = $1;
$db->txn_do(sub {
(my $step) = $db->resultset('BuildSteps')->search(
{id => $build->id, type => 1, outpath => $outPath}, {});
die unless $step;
$step->busy(0);
$step->status(0);
$step->stoptime(time);
$step->update;
});
}
elsif (/^@\s+substituter-failed\s+(\S+)\s+(\S+)\s+(\S+)$/) {
my $outPath = $1;
$db->txn_do(sub {
(my $step) = $db->resultset('BuildSteps')->search(
{id => $build->id, type => 1, outpath => $outPath}, {});
die unless $step;
$step->busy(0);
$step->status(1);
$step->errormsg($3);
$step->stoptime(time);
$step->update;
});
}
else {
print STDERR "unknown Nix trace message: $_";
}
}
close OUT;
my $res = $?;
$stopTime = time();
if ($res != 0) {
if ($thisBuildFailed) { $buildStatus = 1; }
elsif ($someBuildFailed) { $buildStatus = 2; }
else { $buildStatus = 3; }
}
# Only store the output of running Nix if we have a miscellaneous error.
$errormsg = undef unless $buildStatus == 3;
}
$db->txn_do(sub {
$build->finished(1);
$build->timestamp(time());
$build->update;
my $logPath = "/nix/var/log/nix/drvs/" . basename $drvPath;
$logPath = undef unless -e $logPath;
my $releaseName;
if (-e "$outPath/nix-support/hydra-release-name") {
open FILE, "$outPath/nix-support/hydra-release-name" or die;
$releaseName = <FILE>;
chomp $releaseName;
close FILE;
}
$db->resultset('BuildResultInfo')->create(
{ id => $build->id
, iscachedbuild => $isCachedBuild
, buildstatus => $buildStatus
, starttime => $startTime
, stoptime => $stopTime
, logfile => $logPath
, errormsg => $errormsg
, releasename => $releaseName
});
if ($buildStatus == 0) {
my $productnr = 1;
if (-e "$outPath/nix-support/hydra-build-products") {
open LIST, "$outPath/nix-support/hydra-build-products" or die;
while (<LIST>) {
/^([\w\-]+)\s+([\w\-]+)\s+(\S+)$/ or next;
my $type = $1;
my $subtype = $2 eq "none" ? "" : $2;
my $path = $3;
next unless -e $path;
my $fileSize, my $sha1, my $sha256;
if (-f $path) {
my $st = stat($path) or die "cannot stat $path: $!";
$fileSize = $st->size;
$sha1 = `nix-hash --flat --type sha1 $path`
or die "cannot hash $path: $?";;
chomp $sha1;
$sha256 = `nix-hash --flat --type sha256 $path`
or die "cannot hash $path: $?";;
chomp $sha256;
}
$db->resultset('BuildProducts')->create(
{ build => $build->id
, productnr => $productnr++
, type => $type
, subtype => $subtype
, path => $path
, filesize => $fileSize
, sha1hash => $sha1
, sha256hash => $sha256
, name => basename $path
});
}
close LIST;
}
else {
$db->resultset('BuildProducts')->create(
{ build => $build->id
, productnr => $productnr++
, type => "nix-build"
, subtype => ""
, path => $outPath
, name => $build->nixname
});
}
}
$build->schedulingInfo->delete;
});
}
my $buildId = $ARGV[0] or die;
print STDERR "performing build $buildId\n";
# Lock the build. If necessary, steal the lock from the parent
# process (runner.pl). This is so that if the runner dies, the
# children (i.e. the build.pl instances) can continue to run and won't
# have the lock taken away.
my $build;
$db->txn_do(sub {
$build = $db->resultset('Builds')->find($buildId);
die "build $buildId doesn't exist" unless defined $build;
if ($build->schedulingInfo->busy != 0 && $build->schedulingInfo->locker != getppid) {
die "build $buildId is already being built";
}
$build->schedulingInfo->busy(1);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->update;
});
die unless $build;
# Do the build. If it throws an error, unlock the build so that it
# can be retried.
eval {
doBuild $build;
print "done\n";
};
if ($@) {
warn $@;
$db->txn_do(sub {
$build->schedulingInfo->busy(0);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->update;
});
}

37
src/script/hydra_cgi.pl Executable file
View File

@ -0,0 +1,37 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Hydra;
Hydra->run;
1;
=head1 NAME
hydra_cgi.pl - Catalyst CGI
=head1 SYNOPSIS
See L<Catalyst::Manual>
=head1 DESCRIPTION
Run a Catalyst application as a cgi script.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

42
src/script/hydra_control.sh Executable file
View File

@ -0,0 +1,42 @@
#! /bin/sh
action="$1"
if test -z "$HYDRA_DATA"; then
echo "Error: \$HYDRA_DATA is not set";
exit 1
fi
if test "$action" = "start"; then
hydra_server.pl -fork > $HYDRA_DATA/server.log 2>&1 &
echo $! > $HYDRA_DATA/server.pid
hydra_scheduler.pl > $HYDRA_DATA/scheduler.log 2>&1 &
echo $! > $HYDRA_DATA/scheduler.pid
hydra_queue_runner.pl > $HYDRA_DATA/queue_runner.log 2>&1 &
echo $! > $HYDRA_DATA/queue_runner.pid
elif test "$action" = "stop"; then
kill $(cat $HYDRA_DATA/server.pid)
kill $(cat $HYDRA_DATA/scheduler.pid)
kill $(cat $HYDRA_DATA/queue_runner.pid)
elif test "$action" = "status"; then
echo -n "Hydra web server... "
(kill -0 $(cat $HYDRA_DATA/server.pid) 2> /dev/null && echo "ok") || echo "not running"
echo -n "Hydra scheduler... "
(kill -0 $(cat $HYDRA_DATA/scheduler.pid) 2> /dev/null && echo "ok") || echo "not running"
echo -n "Hydra queue runner... "
(kill -0 $(cat $HYDRA_DATA/queue_runner.pid) 2> /dev/null && echo "ok") || echo "not running"
else
echo "Syntax: $0 [start|stop|status]"
exit 1
fi

86
src/script/hydra_create.pl Executable file
View File

@ -0,0 +1,86 @@
#!/var/run/current-system/sw/bin/perl -w
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
eval "use Catalyst::Helper;";
if ($@) {
die <<END;
To use the Catalyst development tools including catalyst.pl and the
generated script/myapp_create.pl you need Catalyst::Helper, which is
part of the Catalyst-Devel distribution. Please install this via a
vendor package or by running one of -
perl -MCPAN -e 'install Catalyst::Devel'
perl -MCPANPLUS -e 'install Catalyst::Devel'
END
}
my $force = 0;
my $mech = 0;
my $help = 0;
GetOptions(
'nonew|force' => \$force,
'mech|mechanize' => \$mech,
'help|?' => \$help
);
pod2usage(1) if ( $help || !$ARGV[0] );
my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
pod2usage(1) unless $helper->mk_component( 'Hydra', @ARGV );
1;
=head1 NAME
hydra_create.pl - Create a new Catalyst Component
=head1 SYNOPSIS
hydra_create.pl [options] model|view|controller name [helper] [options]
Options:
-force don't create a .new file where a file to be created exists
-mechanize use Test::WWW::Mechanize::Catalyst for tests if available
-help display this help and exits
Examples:
hydra_create.pl controller My::Controller
hydra_create.pl controller My::Controller BindLex
hydra_create.pl -mechanize controller My::Controller
hydra_create.pl view My::View
hydra_create.pl view MyView TT
hydra_create.pl view TT TT
hydra_create.pl model My::Model
hydra_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
dbi:SQLite:/tmp/my.db
hydra_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
dbi:Pg:dbname=foo root 4321
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Create a new Catalyst Component.
Existing component files are not overwritten. If any of the component files
to be created already exist the file will be written with a '.new' suffix.
This behavior can be suppressed with the C<-force> option.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

79
src/script/hydra_fastcgi.pl Executable file
View File

@ -0,0 +1,79 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Hydra;
my $help = 0;
my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
GetOptions(
'help|?' => \$help,
'listen|l=s' => \$listen,
'nproc|n=i' => \$nproc,
'pidfile|p=s' => \$pidfile,
'manager|M=s' => \$manager,
'daemon|d' => \$detach,
'keeperr|e' => \$keep_stderr,
);
pod2usage(1) if $help;
Hydra->run(
$listen,
{ nproc => $nproc,
pidfile => $pidfile,
manager => $manager,
detach => $detach,
keep_stderr => $keep_stderr,
}
);
1;
=head1 NAME
hydra_fastcgi.pl - Catalyst FastCGI
=head1 SYNOPSIS
hydra_fastcgi.pl [options]
Options:
-? -help display this help and exits
-l -listen Socket path to listen on
(defaults to standard input)
can be HOST:PORT, :PORT or a
filesystem path
-n -nproc specify number of processes to keep
to serve requests (defaults to 1,
requires -listen)
-p -pidfile specify filename for pid file
(requires -listen)
-d -daemon daemonize (requires -listen)
-M -manager specify alternate process manager
(FCGI::ProcManager sub-class)
or empty string to disable
-e -keeperr send error messages to STDOUT, not
to the webserver
=head1 DESCRIPTION
Run a Catalyst application as fastcgi.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

15
src/script/hydra_init.pl Executable file
View File

@ -0,0 +1,15 @@
#!/var/run/current-system/sw/bin/perl -w
use strict;
use Hydra::Helper::Nix;
my $hydraHome = $ENV{"HYDRA_HOME"};
die "The HYDRA_HOME environment variable is not set!\n" unless defined $hydraHome;
my $hydraData = $ENV{"HYDRA_DATA"};
mkdir $hydraData unless -d $hydraData;
my $dbPath = getHydraPath . "/hydra.sqlite";
system("sqlite3 $dbPath < $hydraHome/sql/hydra.sql") == 0
or warn "Cannot initialise database in $dbPath";

150
src/script/hydra_queue_runner.pl Executable file
View File

@ -0,0 +1,150 @@
#! /var/run/current-system/sw/bin/perl -w
use strict;
use Cwd;
use File::Basename;
use POSIX qw(dup2 :sys_wait_h);
use Hydra::Schema;
use Hydra::Helper::Nix;
chdir getHydraPath or die;
my $db = openHydraDB;
my $hydraHome = $ENV{"HYDRA_HOME"};
die "The HYDRA_HOME environment variable is not set!\n" unless defined $hydraHome;
#$SIG{CHLD} = 'IGNORE';
sub unlockDeadBuilds {
# Unlock builds whose building process has died.
$db->txn_do(sub {
my @builds = $db->resultset('Builds')->search(
{finished => 0, busy => 1}, {join => 'schedulingInfo'});
foreach my $build (@builds) {
my $pid = $build->schedulingInfo->locker;
my $unlock = 0;
if ($pid == $$) {
# Work around sqlite locking timeouts: if the child
# barfed because of a locked DB before updating the
# `locker' field, then `locker' is still set to $$.
# So if after a minute it hasn't been updated,
# unlock the build. !!! need a better fix for those
# locking timeouts.
if ($build->schedulingInfo->starttime + 60 < time) {
$unlock = 1;
}
} elsif (kill(0, $pid) != 1) { # see if we can signal the process
$unlock = 1;
}
if ($unlock) {
print "build ", $build->id, " pid $pid died, unlocking\n";
$build->schedulingInfo->busy(0);
$build->schedulingInfo->locker("");
$build->schedulingInfo->update;
}
}
});
}
sub checkBuilds {
print "looking for runnable builds...\n";
my @buildsStarted;
$db->txn_do(sub {
# Get the system types for the runnable builds.
my @systemTypes = $db->resultset('Builds')->search(
{ finished => 0, busy => 0, enabled => 1, disabled => 0 },
{ join => ['schedulingInfo', 'project'], select => [{distinct => 'system'}], as => ['system'] });
# For each system type, select up to the maximum number of
# concurrent build for that system type. Choose the highest
# priority builds first, then the oldest builds.
foreach my $system (@systemTypes) {
# How many builds are already currently executing for this
# system type?
my $nrActive = $db->resultset('Builds')->search(
{finished => 0, busy => 1, system => $system->system},
{join => 'schedulingInfo'})->count;
# How many extra builds can we start?
(my $systemTypeInfo) = $db->resultset('SystemTypes')->search({system => $system->system});
my $maxConcurrent = defined $systemTypeInfo ? $systemTypeInfo->maxconcurrent : 2;
my $extraAllowed = $maxConcurrent - $nrActive;
$extraAllowed = 0 if $extraAllowed < 0;
# Select the highest-priority builds to start.
my @builds = $extraAllowed == 0 ? () : $db->resultset('Builds')->search(
{ finished => 0, busy => 0, system => $system->system, enabled => 1, disabled => 0 },
{ join => ['schedulingInfo', 'project'], order_by => ["priority DESC", "timestamp"],
rows => $extraAllowed });
print "system type `", $system->system,
"': $nrActive active, $maxConcurrent allowed, ",
"starting ", scalar(@builds), " builds\n";
foreach my $build (@builds) {
my $logfile = getcwd . "/logs/" . $build->id;
mkdir(dirname $logfile);
unlink($logfile);
$build->schedulingInfo->busy(1);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->logfile($logfile);
$build->schedulingInfo->starttime(time);
$build->schedulingInfo->update;
$build->buildsteps->delete_all;
push @buildsStarted, $build;
}
}
});
# Actually start the builds we just selected. We need to do this
# outside the transaction in case it aborts or something.
foreach my $build (@buildsStarted) {
my $id = $build->id;
print "starting build $id (", $build->project->name, ":", $build->attrname, ") on ", $build->system, "\n";
eval {
my $logfile = $build->schedulingInfo->logfile;
my $child = fork();
die unless defined $child;
if ($child == 0) {
eval {
open LOG, ">$logfile" or die "cannot create logfile $logfile";
POSIX::dup2(fileno(LOG), 1) or die;
POSIX::dup2(fileno(LOG), 2) or die;
exec("hydra_build.pl", $id);
};
warn "cannot start build $id: $@";
POSIX::_exit(1);
}
};
if ($@) {
warn $@;
$db->txn_do(sub {
$build->schedulingInfo->busy(0);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->update;
});
}
}
}
while (1) {
eval {
# Clean up zombies.
while ((waitpid(-1, &WNOHANG)) > 0) { };
unlockDeadBuilds;
checkBuilds;
};
warn $@ if $@;
print "sleeping...\n";
sleep(5);
}

459
src/script/hydra_scheduler.pl Executable file
View File

@ -0,0 +1,459 @@
#! /var/run/current-system/sw/bin/perl -w
use strict;
use XML::Simple;
use Hydra::Schema;
use Hydra::Helper::Nix;
use IPC::Run;
use POSIX qw(strftime);
my $db = openHydraDB;
sub captureStdoutStderr {
my $stdin = ""; my $stdout; my $stderr;
my $res = IPC::Run::run(\@_, \$stdin, \$stdout, \$stderr);
return ($res, $stdout, $stderr);
}
sub getStorePathHash {
my ($storePath) = @_;
my $hash = `nix-store --query --hash $storePath`
or die "cannot get hash of $storePath";
chomp $hash;
die unless $hash =~ /^sha256:(.*)$/;
$hash = $1;
$hash = `nix-hash --to-base16 --type sha256 $hash`
or die "cannot convert hash";
chomp $hash;
return $hash;
}
sub fetchInput {
my ($input, $alt, $inputInfo) = @_;
my $type = $input->type;
if ($type eq "path") {
my $uri = $alt->value;
my $timestamp = time;
my $sha256;
my $storePath;
# Some simple caching: don't check a path more than once every N seconds.
(my $cachedInput) = $db->resultset('CachedPathInputs')->search(
{srcpath => $uri, lastseen => {">", $timestamp - 60}},
{rows => 1, order_by => "lastseen DESC"});
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
$storePath = $cachedInput->storepath;
$sha256 = $cachedInput->sha256hash;
$timestamp = $cachedInput->timestamp;
} else {
print "copying input ", $input->name, " from $uri\n";
$storePath = `nix-store --add "$uri"`
or die "cannot copy path $uri to the Nix store";
chomp $storePath;
$sha256 = getStorePathHash $storePath;
($cachedInput) = $db->resultset('CachedPathInputs')->search(
{srcpath => $uri, sha256hash => $sha256});
# Path inputs don't have a natural notion of a "revision",
# so we simulate it by using the timestamp that we first
# saw this path have this SHA-256 hash. So if the
# contents of the path changes, we get a new "revision",
# but if it doesn't change (or changes back), we don't get
# a new "revision".
if (!defined $cachedInput) {
$db->txn_do(sub {
$db->resultset('CachedPathInputs')->create(
{ srcpath => $uri
, timestamp => $timestamp
, lastseen => $timestamp
, sha256hash => $sha256
, storepath => $storePath
});
});
} else {
$timestamp = $cachedInput->timestamp;
$db->txn_do(sub {
$cachedInput->lastseen(time);
$cachedInput->update;
});
}
}
$$inputInfo{$input->name} =
{ type => $type
, uri => $uri
, storePath => $storePath
, sha256hash => $sha256
, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp)
};
}
elsif ($type eq "svn") {
my $uri = $alt->value;
my $sha256;
my $storePath;
# First figure out the last-modified revision of the URI.
my @cmd = (["svn", "ls", "-v", "--depth", "empty", $uri],
"|", ["sed", 's/^ *\([0-9]*\).*/\1/']);
my $stdout; my $stderr;
die "cannot get head revision of Subversion repository at `$uri':\n$stderr"
unless IPC::Run::run(@cmd, \$stdout, \$stderr);
my $revision = $stdout; chomp $revision;
die unless $revision =~ /^\d+$/;
(my $cachedInput) = $db->resultset('CachedSubversionInputs')->search(
{uri => $uri, revision => $revision});
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
$storePath = $cachedInput->storepath;
$sha256 = $cachedInput->sha256hash;
} else {
# Then download this revision into the store.
print "checking out Subversion input ", $input->name, " from $uri revision $revision\n";
$ENV{"NIX_HASH_ALGO"} = "sha256";
$ENV{"PRINT_PATH"} = "1";
(my $res, $stdout, $stderr) = captureStdoutStderr(
"nix-prefetch-svn", $uri, $revision);
die "cannot check out Subversion repository `$uri':\n$stderr" unless $res;
($sha256, $storePath) = split ' ', $stdout;
$db->txn_do(sub {
$db->resultset('CachedSubversionInputs')->create(
{ uri => $uri
, revision => $revision
, sha256hash => $sha256
, storepath => $storePath
});
});
}
$$inputInfo{$input->name} =
{ type => $type
, uri => $uri
, storePath => $storePath
, sha256hash => $sha256
, revision => $revision
};
}
elsif ($type eq "string") {
die unless defined $alt->value;
$$inputInfo{$input->name} = {type => $type, value => $alt->value};
}
elsif ($type eq "boolean") {
die unless defined $alt->value && ($alt->value eq "true" || $alt->value eq "false");
$$inputInfo{$input->name} = {type => $type, value => $alt->value};
}
else {
die "input `" . $input->name . "' has unknown type `$type'";
}
}
sub checkJob {
my ($project, $jobset, $inputInfo, $nixExprPath, $jobName, $jobExpr, $extraArgs) = @_;
# Instantiate the store derivation.
(my $res, my $drvPath, my $stderr) = captureStdoutStderr(
"nix-instantiate", $nixExprPath, "--attr", $jobName, @{$extraArgs});
die "cannot evaluate the Nix expression for job `$jobName':\n$stderr" unless $res;
chomp $drvPath;
# Call nix-env --xml to get info about this job (drvPath, outPath, meta attributes, ...).
($res, my $infoXml, $stderr) = captureStdoutStderr(
qw(nix-env --query --available * --attr-path --out-path --drv-path --meta --xml --system-filter *),
"-f", $nixExprPath, "--attr", $jobName, @{$extraArgs});
die "cannot get information about the job `$jobName':\n$stderr" unless $res;
my $info = XMLin($infoXml, ForceArray => 1, KeyAttr => ['attrPath', 'name'])
or die "cannot parse XML output";
my $job = $info->{item}->{$jobName};
die if !defined $job;
my $description = defined $job->{meta}->{description} ? $job->{meta}->{description}->{value} : "";
my $longDescription = defined $job->{meta}->{longDescription} ? $job->{meta}->{longDescription}->{value} : "";
my $license = defined $job->{meta}->{license} ? $job->{meta}->{license}->{value} : "";
my $homepage = defined $job->{meta}->{homepage} ? $job->{meta}->{homepage}->{value} : "";
die unless $job->{drvPath} eq $drvPath;
my $outPath = $job->{outPath};
my $priority = 100;
if (defined $job->{meta}->{schedulingPriority} &&
$job->{meta}->{schedulingPriority}->{value} =~ /^\d+$/)
{
$priority = int($job->{meta}->{schedulingPriority}->{value});
}
$db->txn_do(sub {
if (scalar($db->resultset('Builds')->search(
{ project => $project->name, jobset => $jobset->name
, attrname => $jobName, outPath => $outPath })) > 0)
{
print "already scheduled/done\n";
return;
}
print "adding to queue\n";
my $build = $db->resultset('Builds')->create(
{ finished => 0
, timestamp => time()
, project => $project->name
, jobset => $jobset->name
, attrname => $jobName
, description => $description
, longdescription => $longDescription
, license => $license
, nixname => $job->{name}
, drvpath => $drvPath
, outpath => $outPath
, system => $job->{system}
});
$db->resultset('BuildSchedulingInfo')->create(
{ id => $build->id
, priority => $priority
, busy => 0
, locker => ""
});
foreach my $inputName (keys %{$inputInfo}) {
my $input = $inputInfo->{$inputName};
$db->resultset('BuildInputs')->create(
{ build => $build->id
, name => $inputName
, type => $input->{type}
, uri => $input->{uri}
, revision => $input->{revision}
, value => $input->{value}
, dependency => $input->{id}
, path => ($input->{storePath} or "") # !!! temporary hack
, sha256hash => $input->{sha256hash}
});
}
# !!! this should really by done by nix-instantiate to prevent a GC race.
registerRoot $drvPath;
});
};
sub setJobsetError {
my ($jobset, $errorMsg) = @_;
eval {
$db->txn_do(sub {
$jobset->errormsg($errorMsg);
$jobset->errortime(time);
$jobset->update;
});
};
}
sub checkJobAlternatives {
my ($project, $jobset, $inputInfo, $nixExprPath, $jobName, $jobExpr, $extraArgs, $argsNeeded, $n) = @_;
if ($n >= scalar @{$argsNeeded}) {
eval {
checkJob($project, $jobset, $inputInfo, $nixExprPath, $jobName, $jobExpr, $extraArgs);
};
if ($@) {
print "error evaluating job `", $jobName, "': $@";
setJobsetError($jobset, $@);
}
return;
}
my $argName = @{$argsNeeded}[$n];
#print "finding alternatives for argument $argName\n";
my ($input) = $jobset->jobsetinputs->search({name => $argName});
my %newInputInfo = %{$inputInfo}; $inputInfo = \%newInputInfo; # clone
if (defined $input) {
foreach my $alt ($input->jobsetinputalts) {
#print "input ", $input->name, " (type ", $input->type, ") alt ", $alt->altnr, "\n";
fetchInput($input, $alt, $inputInfo);
my @newArgs = @{$extraArgs};
if (defined $inputInfo->{$argName}->{storePath}) {
push @newArgs, "--arg", $argName,
"{path = builtins.storePath " . $inputInfo->{$argName}->{storePath} . ";" .
" outPath = builtins.storePath " . $inputInfo->{$argName}->{storePath} . ";" .
" rev = \"" . $inputInfo->{$argName}->{revision} . "\";}";
} elsif ($inputInfo->{$argName}->{type} eq "string") {
push @newArgs, "--argstr", $argName, $inputInfo->{$argName}->{value};
} elsif ($inputInfo->{$argName}->{type} eq "boolean") {
push @newArgs, "--arg", $argName, $inputInfo->{$argName}->{value};
}
checkJobAlternatives(
$project, $jobset, $inputInfo, $nixExprPath,
$jobName, $jobExpr, \@newArgs, $argsNeeded, $n + 1);
}
}
else {
(my $prevBuild) = $db->resultset('Builds')->search(
{finished => 1, project => $project->name, jobset => $jobset->name, attrname => $argName, buildStatus => 0},
{join => 'resultInfo', order_by => "timestamp DESC", rows => 1});
if (!defined $prevBuild) {
# !!! reschedule?
die "missing input `$argName'";
}
# The argument name matches a previously built job in this
# jobset. Pick the most recent build. !!! refine the
# selection criteria: e.g., most recent successful build.
if (!isValidPath($prevBuild->outpath)) {
die "input path " . $prevBuild->outpath . " has been garbage-collected";
}
$$inputInfo{$argName} =
{ type => "build"
, storePath => $prevBuild->outpath
, id => $prevBuild->id
};
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
my $relName = ($prevBuild->resultInfo->releasename or $prevBuild->nixname);
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
my @newArgs = @{$extraArgs};
push @newArgs, "--arg", $argName,
"{ path = builtins.storePath " . $prevBuild->outpath . "; " .
" outPath = builtins.storePath " . $prevBuild->outpath . "; " .
($version ? " version = \"$version\"; " : "") . # !!! escape
"}";
checkJobAlternatives(
$project, $jobset, $inputInfo, $nixExprPath,
$jobName, $jobExpr, \@newArgs, $argsNeeded, $n + 1);
}
}
sub checkJobSet {
my ($project, $jobset) = @_;
my $inputInfo = {};
$db->txn_do(sub {
$jobset->lastcheckedtime(time);
$jobset->update;
});
# Fetch the input containing the Nix expression.
(my $exprInput) = $jobset->jobsetinputs->search({name => $jobset->nixexprinput});
die "No input named " . $jobset->nixexprinput unless defined $exprInput;
die "Multiple alternatives for the Nix expression input not supported yet"
if scalar($exprInput->jobsetinputalts) != 1;
fetchInput($exprInput, $exprInput->jobsetinputalts->first, $inputInfo);
# Evaluate the Nix expression.
my $nixExprPath = $inputInfo->{$jobset->nixexprinput}->{storePath} . "/" . $jobset->nixexprpath;
print "evaluating $nixExprPath\n";
(my $res, my $jobsXml, my $stderr) = captureStdoutStderr(
"nix-instantiate", $nixExprPath, "--eval-only", "--strict", "--xml");
die "cannot evaluate the Nix expression containing the jobs:\n$stderr" unless $res;
my $jobs = XMLin($jobsXml,
ForceArray => ['value', 'attr'],
KeyAttr => ['name'],
SuppressEmpty => '',
ValueAttr => [value => 'value'])
or die "cannot parse XML output";
die unless defined $jobs->{attrs};
# Iterate over the attributes listed in the Nix expression and
# perform the builds described by them. If an attribute is a
# function, then fill in the function arguments with the
# (alternative) values supplied in the jobsetinputs table.
foreach my $jobName (keys(%{$jobs->{attrs}->{attr}})) {
print "considering job $jobName\n";
my @argsNeeded = ();
my $jobExpr = $jobs->{attrs}->{attr}->{$jobName};
# !!! fix the case where there is only 1 attr, XML::Simple fucks up as usual
if (defined $jobExpr->{function}->{attrspat}) {
foreach my $argName (keys(%{$jobExpr->{function}->{attrspat}->{attr}})) {
#print "needs input $argName\n";
push @argsNeeded, $argName;
}
}
eval {
checkJobAlternatives(
$project, $jobset, {}, $nixExprPath,
$jobName, $jobExpr, [], \@argsNeeded, 0);
};
if ($@) {
print "error checking job ", $jobName, ": $@";
setJobsetError($jobset, $@);
}
}
}
sub checkJobs {
foreach my $project ($db->resultset('Projects')->search({enabled => 1})) {
print "considering project ", $project->name, "\n";
foreach my $jobset ($project->jobsets->all) {
print "considering jobset ", $jobset->name, " in ", $project->name, "\n";
eval {
checkJobSet($project, $jobset);
};
if ($@) {
print "error evaluating jobset ", $jobset->name, ": $@";
setJobsetError($jobset, $@);
}
}
}
}
# 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;
checkJobSet($jobset->project, $jobset);
exit 0;
}
while (1) {
checkJobs;
print "sleeping...\n";
sleep 30;
}

114
src/script/hydra_server.pl Executable file
View File

@ -0,0 +1,114 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN {
$ENV{CATALYST_ENGINE} ||= 'HTTP';
$ENV{CATALYST_SCRIPT_GEN} = 32;
require Catalyst::Engine::HTTP;
}
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
my $debug = 0;
my $fork = 0;
my $help = 0;
my $host = undef;
my $port = $ENV{HYDRA_PORT} || $ENV{CATALYST_PORT} || 3000;
my $keepalive = 0;
my $restart = $ENV{HYDRA_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
my $restart_delay = 1;
my $restart_regex = '(?:/|^)(?!\.#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$';
my $restart_directory = undef;
my $follow_symlinks = 0;
my @argv = @ARGV;
GetOptions(
'debug|d' => \$debug,
'fork' => \$fork,
'help|?' => \$help,
'host=s' => \$host,
'port=s' => \$port,
'keepalive|k' => \$keepalive,
'restart|r' => \$restart,
'restartdelay|rd=s' => \$restart_delay,
'restartregex|rr=s' => \$restart_regex,
'restartdirectory=s@' => \$restart_directory,
'followsymlinks' => \$follow_symlinks,
);
pod2usage(1) if $help;
if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
$ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
}
if ( $debug ) {
$ENV{CATALYST_DEBUG} = 1;
}
# This is require instead of use so that the above environment
# variables can be set at runtime.
require Hydra;
Hydra->run( $port, $host, {
argv => \@argv,
'fork' => $fork,
keepalive => $keepalive,
restart => $restart,
restart_delay => $restart_delay,
restart_regex => qr/$restart_regex/,
restart_directory => $restart_directory,
follow_symlinks => $follow_symlinks,
} );
1;
=head1 NAME
hydra_server.pl - Catalyst Testserver
=head1 SYNOPSIS
hydra_server.pl [options]
Options:
-d -debug force debug mode
-f -fork handle each request in a new process
(defaults to false)
-? -help display this help and exits
-host host (defaults to all)
-p -port port (defaults to 3000)
-k -keepalive enable keep-alive connections
-r -restart restart when files get modified
(defaults to false)
-rd -restartdelay delay between file checks
-rr -restartregex regex match files that trigger
a restart when modified
(defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
-restartdirectory the directory to search for
modified files, can be set mulitple times
(defaults to '[SCRIPT_DIR]/..')
-follow_symlinks follow symlinks in search directories
(defaults to false. this is a no-op on Win32)
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Run a Catalyst Testserver for this application.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

53
src/script/hydra_test.pl Executable file
View File

@ -0,0 +1,53 @@
#!/var/run/current-system/sw/bin/perl -w
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Catalyst::Test 'Hydra';
my $help = 0;
GetOptions( 'help|?' => \$help );
pod2usage(1) if ( $help || !$ARGV[0] );
print request($ARGV[0])->content . "\n";
1;
=head1 NAME
hydra_test.pl - Catalyst Test
=head1 SYNOPSIS
hydra_test.pl [options] uri
Options:
-help display this help and exits
Examples:
hydra_test.pl http://localhost/some_action
hydra_test.pl /some_action
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Run a Catalyst action from the command line.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

117
src/script/hydra_update_gc_roots.pl Executable file
View File

@ -0,0 +1,117 @@
#! /var/run/current-system/sw/bin/perl -w
use strict;
use File::Path;
use File::Basename;
use Hydra::Schema;
use Hydra::Helper::Nix;
use POSIX qw(strftime);
my $db = openHydraDB;
my %roots;
sub registerRoot {
my ($path) = @_;
Hydra::Helper::Nix::registerRoot($path);
$roots{$path} = 1;
}
sub keepBuild {
my ($build) = @_;
print "keeping build ", $build->id, " (",
strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
if (isValidPath($build->outpath)) {
registerRoot $build->outpath;
} else {
print STDERR "warning: output ", $build->outpath, " has disappeared\n";
}
}
# Go over all projects.
foreach my $project ($db->resultset('Projects')->all) {
# Go over all jobs in this project.
foreach my $job ($project->builds->search({},
{select => [{distinct => 'attrname'}], as => ['attrname']}))
{
print "*** looking for builds to keep in job ", $project->name, ":", $job->attrname, "\n";
# Keep the N most recent successful builds for each job and
# platform.
my @recentBuilds = $project->builds->search(
{ attrname => $job->attrname
, finished => 1
, buildStatus => 0 # == success
},
{ join => 'resultInfo'
, order_by => 'timestamp DESC'
, rows => 3 # !!! should make this configurable
});
keepBuild $_ foreach @recentBuilds;
}
# Go over all releases in this project.
foreach my $releaseSet ($project->releasesets->all) {
print "*** looking for builds to keep in release set ", $project->name, ":", $releaseSet->name, "\n";
(my $primaryJob) = $releaseSet->releasesetjobs->search({isprimary => 1});
my $jobs = [$releaseSet->releasesetjobs->all];
# Keep all builds belonging to the most recent successful release.
my $latest = getLatestSuccessfulRelease($project, $primaryJob, $jobs);
if (defined $latest) {
print "keeping latest successful release ", $latest->id, " (", $latest->get_column('releasename'), ")\n";
my $release = getRelease($latest, $jobs);
keepBuild $_->{build} foreach @{$release->{jobs}};
}
}
}
# Keep all builds that have been marked as "keep".
print "*** looking for kept builds\n";
my @buildsToKeep = $db->resultset('Builds')->search({finished => 1, keep => 1}, {join => 'resultInfo'});
keepBuild $_ foreach @buildsToKeep;
# For scheduled builds, we register the derivation and the output as a GC root.
print "*** looking for scheduled builds\n";
foreach my $build ($db->resultset('Builds')->search({finished => 0}, {join => 'schedulingInfo'})) {
if (isValidPath($build->drvpath)) {
print "keeping scheduled build ", $build->id, " (",
strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
registerRoot $build->drvpath;
registerRoot $build->outpath;
} else {
print STDERR "warning: derivation ", $build->drvpath, " has disappeared\n";
}
}
# Remove existing roots that are no longer wanted. !!! racy
print "*** removing unneeded GC roots\n";
my $gcRootsDir = getGCRootsDir;
opendir DIR, $gcRootsDir or die;
foreach my $link (readdir DIR) {
next if !-l "$gcRootsDir/$link";
my $path = readlink "$gcRootsDir/$link" or die;
if (!defined $roots{$path}) {
print STDERR "removing root $path\n";
unlink "$gcRootsDir/$link" or die "cannot remove $gcRootsDir/$link";
}
}
closedir DIR;