src/Hydra/programs/Build.pl

@@ -0,0 +1,295 @@
+#! @perl@ -w
+
+use strict;
+use File::Basename;
+use File::stat;
+use Hydra::Schema;
+
+
+my $db = Hydra::Schema->connect("dbi:SQLite:dbname=hydra.sqlite", "", "", {});
+
+$db->storage->dbh->do("PRAGMA synchronous = OFF;");
+
+
+sub isValidPath {
+    my $path = shift;
+    return system("nix-store --check-validity $path 2> /dev/null") == 0;
+}
+
+
+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;
+    
+    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 --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;
+        
+        $db->resultset('Buildresultinfo')->create(
+            { id => $build->id
+            , iscachedbuild => $isCachedBuild
+            , buildstatus => $buildStatus
+            , starttime => $startTime
+            , stoptime => $stopTime
+            , logfile => $logPath
+            , errormsg => $errormsg
+            });
+
+        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;
+                    die 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')->search({id => $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;
+    });
+}

src/Hydra/programs/Runner.pl

@@ -0,0 +1,95 @@
+#! @perl@ -w
+
+use strict;
+use Cwd;
+use POSIX qw(dup2);
+use Hydra::Schema;
+
+
+my $db = Hydra::Schema->connect("dbi:SQLite:dbname=hydra.sqlite", "", "", {});
+
+$db->storage->dbh->do("PRAGMA synchronous = OFF;");
+
+
+# Unlock jobs whose building process has died.
+$db->txn_do(sub {
+    my @jobs = $db->resultset('Builds')->search(
+        {finished => 0, busy => 1}, {join => 'schedulingInfo'});
+    foreach my $job (@jobs) {
+        my $pid = $job->schedulingInfo->locker;
+        if (kill(0, $pid) != 1) { # see if we can signal the process
+            print "job ", $job->id, " pid $pid died, unlocking\n";
+            $job->schedulingInfo->busy(0);
+            $job->schedulingInfo->locker("");
+            $job->schedulingInfo->update;
+        }
+    }
+});
+
+
+sub checkJobs {
+    print "looking for runnable jobs...\n";
+
+    my $job;
+    my $logfile;
+
+    $db->txn_do(sub {
+    
+        my @jobs = $db->resultset('Builds')->search(
+            {finished => 0, busy => 0},
+            {join => 'schedulingInfo', order_by => ["priority", "timestamp"]});
+
+        print "# of available jobs: ", scalar(@jobs), "\n";
+
+        if (scalar @jobs > 0) {
+            $job = $jobs[0];
+            $logfile = getcwd . "/logs/" . $job->id;
+            unlink $logfile;
+            $job->schedulingInfo->busy(1);
+            $job->schedulingInfo->locker($$);
+            $job->schedulingInfo->logfile($logfile);
+            $job->schedulingInfo->update;
+            $job->buildsteps->delete_all;
+        }
+
+    });
+
+    # Start the job.  We need to do this outside the transaction in
+    # case it aborts or something.
+    if (defined $job) {
+        my $id = $job->id;
+        print "starting job $id\n";
+        eval {
+            my $child = fork();
+            die unless defined $child;
+            if ($child == 0) {
+                open LOG, ">$logfile" or die;
+                POSIX::dup2(fileno(LOG), 1) or die;
+                POSIX::dup2(fileno(LOG), 2) or die;
+                exec("perl", "-IHydra/lib", "-w",
+                     "./Hydra/programs/Build.pl", $id);
+                warn "cannot start job " . $id;
+                _exit(1);
+            }
+        };
+        if ($@) {
+            warn $@;
+            $db->txn_do(sub {
+                $job->schedulingInfo->busy(0);
+                $job->schedulingInfo->locker($$);
+                $job->schedulingInfo->update;
+            });
+        }
+    }
+}
+
+
+while (1) {
+    eval {
+        checkJobs;
+    };
+    warn $@ if $@;
+
+    print "sleeping...\n";
+    sleep(5);
+}

src/Hydra/programs/Scheduler.pl

@@ -0,0 +1,282 @@
+#! @perl@ -w
+
+use strict;
+use XML::Simple;
+use Hydra::Schema;
+
+
+my $db = Hydra::Schema->connect("dbi:SQLite:dbname=hydra.sqlite", "", "", {});
+
+$db->storage->dbh->do("PRAGMA synchronous = OFF;");
+
+
+sub isValidPath {
+    my $path = shift;
+    return system("nix-store --check-validity $path 2> /dev/null") == 0;
+}
+
+
+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 $storePath = `nix-store --add "$uri"`
+            or die "cannot copy path $uri to the Nix store";
+        chomp $storePath;
+        print "          copied to $storePath\n";
+        
+        $$inputInfo{$input->name} =
+            { type => $type
+            , uri => $uri
+            , storePath => $storePath
+            , sha256hash => getStorePathHash $storePath
+            };
+    }
+
+    elsif ($type eq "string") {
+        die unless defined $alt->value;
+        $$inputInfo{$input->name} = {type => $type, value => $alt->value};
+    }
+    
+    else {
+        die "input `" . $input->type . "' has unknown type `$type'";
+    }
+}
+
+
+sub checkJob {
+    my ($project, $jobset, $inputInfo, $nixExprPath, $jobName, $jobExpr, $extraArgs) = @_;
+    
+    # Instantiate the store derivation.
+    my $drvPath = `nix-instantiate $nixExprPath --attr $jobName $extraArgs`
+        or die "cannot evaluate the Nix expression containing the job definitions: $?";
+    chomp $drvPath;
+
+    # Call nix-env --xml to get info about this job (drvPath, outPath, meta attributes, ...).
+    my $infoXml = `nix-env -f $nixExprPath --query --available "*" --attr-path --out-path --drv-path --meta --xml --system-filter "*" --attr $jobName $extraArgs`
+        or die "cannot get information about the job: $?";
+
+    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} : "";
+    die unless $job->{drvPath} eq $drvPath;
+    my $outPath = $job->{outPath};
+
+    $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
+            , nixname => $job->{name}
+            , drvpath => $drvPath
+            , outpath => $outPath
+            , system => $job->{system}
+            });
+
+        $db->resultset('Buildschedulinginfo')->create(
+            { id => $build->id
+            , priority => 0
+            , 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->{orig}->revision
+                #, tag => $input->{orig}->tag
+                , value => $input->{value}
+                , dependency => $input->{id}
+                , path => ($input->{storePath} or "") # !!! temporary hack
+                , sha256hash => $input->{sha256hash}
+                });
+        }
+    });
+};
+
+
+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);
+        };
+        warn $@ if $@;
+        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); # !!! caching
+            my $newArgs = "";
+            if (defined $inputInfo->{$argName}->{storePath}) {
+                # !!! escaping
+                $newArgs = " --arg $argName '{path = " . $inputInfo->{$argName}->{storePath} . ";}'";
+            } elsif (defined $inputInfo->{$argName}->{value}) {
+                $newArgs = " --argstr $argName '" . $inputInfo->{$argName}->{value} . "'";
+            }
+            checkJobAlternatives(
+                $project, $jobset, $inputInfo, $nixExprPath,
+                $jobName, $jobExpr, $extraArgs . $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
+            };
+
+        checkJobAlternatives(
+            $project, $jobset, $inputInfo, $nixExprPath,
+            $jobName, $jobExpr,
+            $extraArgs . " --arg $argName '{path = " . $prevBuild->outpath . ";}'",
+            $argsNeeded, $n + 1);
+    }
+}
+
+    
+sub checkJobSet {
+    my ($project, $jobset) = @_;
+    my $inputInfo = {};
+
+    # Fetch the input containing the Nix expression.
+    (my $exprInput) = $jobset->jobsetinputs->search({name => $jobset->nixexprinput});
+    die unless defined $exprInput;
+
+    die "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 $jobsXml = `nix-instantiate $nixExprPath --eval-only --strict --xml`
+        or die "cannot evaluate the Nix expression containing the jobs: $?";
+
+    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 "    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);
+        };
+        warn $@ if $@;
+    }
+}
+
+
+sub checkJobs {
+
+    foreach my $project ($db->resultset('Projects')->search({enabled => 1})) {
+        print "PROJECT ", $project->name, "\n";
+        foreach my $jobset ($project->jobsets->all) {
+            print "  JOBSET ", $jobset->name, "\n";
+            eval {
+                checkJobSet($project, $jobset);
+            }; 
+            warn $@ if $@;
+       }
+    }
+    
+}
+
+
+while (1) {
+    checkJobs;
+    print "sleeping...\n";
+    sleep 10;
+}

src/Hydra/root/layout.tt

@@ -112,7 +112,7 @@
         [% content %]
         <div id="footer">
           <hr />
-          Generated at [% date.format %].
+          Generated on [% date.format %].
         </div>
       </div>