Remove hydra-eval-guile-jobs
This hasn't been used in a long time (Guix uses its own CI system),
and it probably doesn't work anymore.
(cherry picked from commit 23c9ca3e94)
This commit is contained in:
Eelco Dolstra
parent
027668f0db
commit
15187b059b
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -15,7 +15,6 @@ Makefile.in
|
|||
/aclocal.m4
|
||||
/missing
|
||||
/install-sh
|
||||
/src/script/hydra-eval-guile-jobs
|
||||
/src/sql/hydra-postgresql.sql
|
||||
/src/sql/hydra-sqlite.sql
|
||||
/src/sql/tmp.sqlite
|
||||
|
|
|
|||
13
configure.ac
13
configure.ac
|
|
@ -53,15 +53,6 @@ fi
|
|||
|
||||
PKG_CHECK_MODULES([NIX], [nix-main nix-expr nix-store])
|
||||
|
||||
PKG_CHECK_MODULES([GUILE], [guile-2.0], [HAVE_GUILE=yes], [HAVE_GUILE=no])
|
||||
|
||||
if test "x$HAVE_GUILE" = xyes; then
|
||||
AC_PATH_PROG([GUILE], [guile])
|
||||
else
|
||||
GUILE="guile"
|
||||
fi
|
||||
AC_SUBST([GUILE])
|
||||
|
||||
testPath="$(dirname $(type -p expr))"
|
||||
AC_SUBST(testPath)
|
||||
|
||||
|
|
@ -80,13 +71,11 @@ AC_CONFIG_FILES([
|
|||
src/lib/Makefile
|
||||
src/root/Makefile
|
||||
src/script/Makefile
|
||||
src/script/hydra-eval-guile-jobs
|
||||
tests/Makefile
|
||||
tests/jobs/config.nix
|
||||
])
|
||||
|
||||
AC_CONFIG_COMMANDS([executable-scripts],
|
||||
[chmod +x src/script/hydra-eval-guile-jobs])
|
||||
AC_CONFIG_COMMANDS([executable-scripts], [])
|
||||
|
||||
AC_CONFIG_HEADER([hydra-config.h])
|
||||
|
||||
|
|
|
|||
|
|
@ -129,7 +129,6 @@ rec {
|
|||
buildInputs =
|
||||
[ makeWrapper autoconf automake libtool unzip nukeReferences pkgconfig sqlite libpqxx
|
||||
gitAndTools.topGit mercurial darcs subversion bazaar openssl bzip2 libxslt
|
||||
guile # optional, for Guile + Guix support
|
||||
perlDeps perl nix
|
||||
postgresql95 # for running the tests
|
||||
boost
|
||||
|
|
|
|||
|
|
@ -223,11 +223,6 @@ sub updateJobset {
|
|||
error($c, "Cannot rename jobset to ‘$jobsetName’ since that identifier is already taken.")
|
||||
if $jobsetName ne $oldName && defined $c->stash->{project}->jobsets->find({ name => $jobsetName });
|
||||
|
||||
# When the expression is in a .scm file, assume it's a Guile + Guix
|
||||
# build expression.
|
||||
my $exprType =
|
||||
$c->stash->{params}->{"nixexprpath"} =~ /.scm$/ ? "guile" : "nix";
|
||||
|
||||
my ($nixExprPath, $nixExprInput) = nixExprPathFromParams $c;
|
||||
|
||||
my $enabled = int($c->stash->{params}->{enabled});
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
EXTRA_DIST = \
|
||||
$(distributable_scripts) \
|
||||
hydra-eval-guile-jobs.in
|
||||
$(distributable_scripts)
|
||||
|
||||
distributable_scripts = \
|
||||
hydra-backfill-ids \
|
||||
|
|
@ -17,5 +16,4 @@ distributable_scripts = \
|
|||
nix-prefetch-hg
|
||||
|
||||
bin_SCRIPTS = \
|
||||
$(distributable_scripts) \
|
||||
hydra-eval-guile-jobs
|
||||
$(distributable_scripts)
|
||||
|
|
|
|||
|
|
@ -1,249 +0,0 @@
|
|||
#!/bin/sh
|
||||
# Aside from this initial boilerplate, this is actually -*- scheme -*- code.
|
||||
main="(module-ref (resolve-interface '(hydra-eval-guile-jobs)) 'eval-guile-jobs)"
|
||||
|
||||
# Keep the host's GUILE_LOAD_PATH unchanged to allow the installed Guix to
|
||||
# be used. This moves Guix modules possibly out of control, but solves
|
||||
# bootstrapping issues.
|
||||
#
|
||||
# Use `--fresh-auto-compile' to ignore any available .go, and force
|
||||
# recompilation. This is because checkouts in the store has mtime set to
|
||||
# the epoch, and thus .go files look newer, even though they may not
|
||||
# correspond.
|
||||
|
||||
exec ${GUILE:-@GUILE@} --no-auto-compile --fresh-auto-compile \
|
||||
-l "$0" -c "(apply $main (cdr (command-line)))" "$@"
|
||||
!#
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of Hydra.
|
||||
;;;
|
||||
;;; Hydra 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 3 of the License, or
|
||||
;;; (at your option) any later version.
|
||||
;;;
|
||||
;;; Hydra 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 Hydra. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (hydra-eval-guile-jobs)
|
||||
#:use-module (sxml simple)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:export (job-evaluations->xml
|
||||
eval-guile-jobs))
|
||||
|
||||
(define (guix-variable module name)
|
||||
"Dynamically link variable NAME under Guix module MODULE and return it.
|
||||
Note: this is used instead of `@', because when using `@' in an uncompiled
|
||||
file, Guile tries to load the module directly as it reads the source, which
|
||||
fails in our case, leading to the creation of empty (guix ...) modules."
|
||||
;; TODO: fail with an XML error description
|
||||
(let ((m (resolve-interface `(guix ,module))))
|
||||
(module-ref m name)))
|
||||
|
||||
(define (%derivation-system drv)
|
||||
;; XXX: Awful hack to workaround the fact that `derivation-system', which
|
||||
;; is a macro, cannot be referred to dynamically.
|
||||
(struct-ref drv 3))
|
||||
|
||||
(define strip-store-path
|
||||
(let* ((store (or (getenv "NIX_STORE_DIR") "/nix/store"))
|
||||
(store-path-rx
|
||||
(make-regexp (string-append "^.*" (regexp-quote store)
|
||||
"/[^-]+-(.+)$"))))
|
||||
(lambda (path)
|
||||
(or (and=> (regexp-exec store-path-rx path)
|
||||
(lambda (match)
|
||||
(let ((path (match:substring match 1)))
|
||||
path)))
|
||||
path))))
|
||||
|
||||
(define (derivation-path->name drv)
|
||||
"Return the base name of DRV, sans hash and `.drv' extension."
|
||||
(let ((d (strip-store-path drv)))
|
||||
(if (string-suffix? ".drv" d)
|
||||
(string-drop-right d 4)
|
||||
d)))
|
||||
|
||||
(define (register-gc-root drv roots-dir)
|
||||
"Register a permanent garbage collector root under ROOTS-DIR for DRV."
|
||||
(let ((root (string-append roots-dir "/" (basename drv))))
|
||||
(unless (file-exists? root)
|
||||
(symlink drv root))))
|
||||
|
||||
(define* (job-evaluations->sxml jobs
|
||||
#:key gc-roots-dir)
|
||||
"Return the hydra-eval-jobs SXML form for the result of JOBS, a list of
|
||||
symbol/thunk pairs."
|
||||
`(*TOP*
|
||||
(*PI* xml "version='1.0' encoding='utf-8'")
|
||||
"\n"
|
||||
(jobs "\n"
|
||||
,@(map (match-lambda
|
||||
(((? symbol? name) . (? thunk? thunk))
|
||||
(let* ((result (save-module-excursion
|
||||
(lambda ()
|
||||
(set-current-module %user-module)
|
||||
(with-output-to-port (%make-void-port "w")
|
||||
thunk))))
|
||||
(drv (assoc-ref result 'derivation)))
|
||||
(define (opt-attr xml-name name)
|
||||
(match (assoc name result)
|
||||
((_ . value)
|
||||
`((,xml-name ,value)))
|
||||
(_
|
||||
'())))
|
||||
|
||||
(when gc-roots-dir
|
||||
;; Register DRV as a GC root so that it's not collected by
|
||||
;; the time 'hydra-queue-runner' attempts to build it.
|
||||
(register-gc-root drv gc-roots-dir))
|
||||
|
||||
;; XXX: Add <arg ...> tags?
|
||||
`(job (@ (jobName ,name)
|
||||
(drvPath ,drv)
|
||||
,@(opt-attr 'homepage 'home-page)
|
||||
(license
|
||||
,(let loop ((license (assoc-ref result 'license)))
|
||||
(match license
|
||||
((? struct?)
|
||||
(struct-ref license 0))
|
||||
((l ...)
|
||||
(string-join (map loop l)))
|
||||
(_ ""))))
|
||||
,@(opt-attr 'description 'description)
|
||||
(maintainers
|
||||
,(string-join (or (assoc-ref result 'maintainers)
|
||||
'())
|
||||
", "))
|
||||
(maxSilent
|
||||
,(number->string (or (assoc-ref result
|
||||
'max-silent-time)
|
||||
3600)))
|
||||
(timeout
|
||||
,(number->string (or (assoc-ref result 'timeout)
|
||||
72000)))
|
||||
(nixName ,(derivation-path->name drv))
|
||||
(schedulingPriority
|
||||
,(number->string (or (assoc-ref result
|
||||
'scheduling-priority)
|
||||
10)))
|
||||
(system
|
||||
,(call-with-input-file drv
|
||||
(compose %derivation-system
|
||||
(guix-variable 'derivations
|
||||
'read-derivation)))))
|
||||
;; Resolve Guix modules lazily.
|
||||
,(map (match-lambda
|
||||
((name . path)
|
||||
`(output (@ (name ,name) (path ,path)))))
|
||||
((guix-variable 'derivations
|
||||
'derivation-path->output-paths)
|
||||
drv))
|
||||
|
||||
"\n"))))
|
||||
jobs))))
|
||||
|
||||
(define* (job-evaluations->xml jobs port
|
||||
#:key gc-roots-dir)
|
||||
(set-port-encoding! port "UTF-8")
|
||||
(sxml->xml (job-evaluations->sxml jobs #:gc-roots-dir gc-roots-dir)
|
||||
port))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Command-line entry point.
|
||||
;;;
|
||||
|
||||
(define (parse-arguments args)
|
||||
"Traverse ARGS, a list of command-line arguments compatible with
|
||||
`hydra-eval-jobs', and return the name of the file that defines the jobs, an
|
||||
expression that returns the entry point in that file (a unary procedure), the
|
||||
list of name/value pairs passed to that entry point, as well as a GC root
|
||||
directory or #f."
|
||||
(define (module-directory dir)
|
||||
(let ((d (string-append dir "/share/guile/site/2.0")))
|
||||
(if (file-exists? d)
|
||||
d
|
||||
dir)))
|
||||
|
||||
(let loop ((args args)
|
||||
(result '())
|
||||
(file #f)
|
||||
(entry 'hydra-jobs)
|
||||
(roots-dir #f))
|
||||
(match args
|
||||
(()
|
||||
(if (not file)
|
||||
(error "hydra-eval-guile-jobs: no expression file given")
|
||||
(values file entry (reverse result) roots-dir)))
|
||||
(("-I" name=dir rest ...)
|
||||
(let* ((dir (match (string-tokenize name=dir
|
||||
(char-set-complement (char-set
|
||||
#\=)))
|
||||
((_ dir) dir)
|
||||
((dir) dir)))
|
||||
(dir* (module-directory dir)))
|
||||
(format (current-error-port) "adding `~a' to the load path~%" dir*)
|
||||
(set! %load-path (cons dir* %load-path))
|
||||
(set! %load-compiled-path (cons dir* %load-compiled-path)))
|
||||
(loop rest result file entry roots-dir))
|
||||
(("--argstr" name value rest ...)
|
||||
(loop rest (alist-cons (string->symbol name) value result)
|
||||
file entry roots-dir))
|
||||
(("--arg" name expr rest ...)
|
||||
(let ((value (eval (call-with-input-string expr read)
|
||||
(current-module))))
|
||||
(loop rest (alist-cons (string->symbol name) value result)
|
||||
file entry roots-dir)))
|
||||
(("--gc-roots-dir" dir rest ...)
|
||||
(loop rest result file entry dir))
|
||||
(("-j" _ rest ...) ; XXX: what's this?
|
||||
(loop rest result file entry roots-dir))
|
||||
(("--entry" expr rest ...) ; entry point, like `guile -e'
|
||||
(let ((expr (call-with-input-string expr read)))
|
||||
(loop rest result file expr roots-dir)))
|
||||
((file rest ...) ; source file that defines the jobs
|
||||
(loop rest result file entry roots-dir))
|
||||
(_
|
||||
(error "hydra-eval-guile-jobs: invalid arguments" args)))))
|
||||
|
||||
(define %user-module
|
||||
;; Hydra user module.
|
||||
;; TODO: Make it a sandbox.
|
||||
(let ((m (make-module)))
|
||||
(beautify-user-module! m)
|
||||
m))
|
||||
|
||||
(define (eval-guile-jobs . args)
|
||||
(setlocale LC_ALL "")
|
||||
|
||||
(let-values (((file entry args gc-roots-dir)
|
||||
(parse-arguments args)))
|
||||
|
||||
(save-module-excursion
|
||||
(lambda ()
|
||||
(set-current-module %user-module)
|
||||
|
||||
;; The standard output must contain only XML.
|
||||
(with-output-to-port (%make-void-port "w")
|
||||
(lambda ()
|
||||
(primitive-load file)))))
|
||||
|
||||
(let* ((entry (eval entry %user-module))
|
||||
(store ((guix-variable 'store 'open-connection)))
|
||||
(jobs (entry store args)))
|
||||
(unless (string? gc-roots-dir)
|
||||
(format (current-error-port)
|
||||
"warning: --gc-roots-dir not specified~%"))
|
||||
|
||||
(job-evaluations->xml jobs (current-output-port)
|
||||
#:gc-roots-dir gc-roots-dir))))
|
||||
|
|
@ -264,35 +264,15 @@ sub fetchInput {
|
|||
|
||||
|
||||
sub booleanToString {
|
||||
my ($exprType, $value) = @_;
|
||||
my $result;
|
||||
if ($exprType eq "guile") {
|
||||
if ($value eq "true") {
|
||||
$result = "#t";
|
||||
} else {
|
||||
$result = "#f";
|
||||
}
|
||||
$result = $value;
|
||||
} else {
|
||||
$result = $value;
|
||||
}
|
||||
return $result;
|
||||
my ($value) = @_;
|
||||
return $value;
|
||||
}
|
||||
|
||||
|
||||
sub buildInputToString {
|
||||
my ($exprType, $input) = @_;
|
||||
my $result;
|
||||
if ($exprType eq "guile") {
|
||||
$result = "'((file-name . \"" . ${input}->{storePath} . "\")" .
|
||||
(defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .
|
||||
(defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .
|
||||
(defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .
|
||||
(defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .
|
||||
(defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .
|
||||
")";
|
||||
} else {
|
||||
$result = "{ outPath = builtins.storePath " . $input->{storePath} . "" .
|
||||
my ($input) = @_;
|
||||
return
|
||||
"{ outPath = builtins.storePath " . $input->{storePath} . "" .
|
||||
"; inputType = \"" . $input->{type} . "\"" .
|
||||
(defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
|
||||
(defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
|
||||
|
|
@ -304,13 +284,11 @@ sub buildInputToString {
|
|||
(defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
|
||||
(defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
|
||||
";}";
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
|
||||
sub inputsToArgs {
|
||||
my ($inputInfo, $exprType) = @_;
|
||||
my ($inputInfo) = @_;
|
||||
my @res = ();
|
||||
|
||||
foreach my $input (sort keys %{$inputInfo}) {
|
||||
|
|
@ -327,14 +305,12 @@ sub inputsToArgs {
|
|||
push @res, "--argstr", $input, $alt->{value};
|
||||
}
|
||||
elsif ($alt->{type} eq "boolean") {
|
||||
push @res, "--arg", $input, booleanToString($exprType, $alt->{value});
|
||||
push @res, "--arg", $input, booleanToString($alt->{value});
|
||||
}
|
||||
elsif ($alt->{type} eq "nix") {
|
||||
die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
||||
push @res, "--arg", $input, $alt->{value};
|
||||
}
|
||||
elsif ($alt->{type} eq "eval") {
|
||||
die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
||||
my $s = "{ ";
|
||||
# FIXME: escape $_. But dots should not be escaped.
|
||||
$s .= "$_ = builtins.storePath ${\$alt->{jobs}->{$_}}; "
|
||||
|
|
@ -343,7 +319,7 @@ sub inputsToArgs {
|
|||
push @res, "--arg", $input, $s;
|
||||
}
|
||||
else {
|
||||
push @res, "--arg", $input, buildInputToString($exprType, $alt);
|
||||
push @res, "--arg", $input, buildInputToString($alt);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -352,18 +328,16 @@ sub inputsToArgs {
|
|||
|
||||
|
||||
sub evalJobs {
|
||||
my ($inputInfo, $exprType, $nixExprInputName, $nixExprPath) = @_;
|
||||
my ($inputInfo, $nixExprInputName, $nixExprPath) = @_;
|
||||
|
||||
my $nixExprInput = $inputInfo->{$nixExprInputName}->[0]
|
||||
or die "cannot find the input containing the job expression\n";
|
||||
|
||||
my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";
|
||||
|
||||
my @cmd = ($evaluator,
|
||||
my @cmd = ("hydra-eval-jobs",
|
||||
"<" . $nixExprInputName . "/" . $nixExprPath . ">",
|
||||
"--gc-roots-dir", getGCRootsDir,
|
||||
"-j", 1,
|
||||
inputsToArgs($inputInfo, $exprType));
|
||||
inputsToArgs($inputInfo));
|
||||
|
||||
if (defined $ENV{'HYDRA_DEBUG'}) {
|
||||
sub escape {
|
||||
|
|
@ -376,7 +350,7 @@ sub evalJobs {
|
|||
}
|
||||
|
||||
(my $res, my $jobsJSON, my $stderr) = captureStdoutStderr(21600, @cmd);
|
||||
die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))
|
||||
die "hydra-eval-jobs returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))
|
||||
. ":\n" . ($stderr ? decode("utf-8", $stderr) : "(no output)\n")
|
||||
if $res;
|
||||
|
||||
|
|
@ -595,7 +569,6 @@ sub checkJobsetWrapped {
|
|||
$jobset->discard_changes;
|
||||
$inputInfo->{"declInput"} = [ $declInput ];
|
||||
}
|
||||
my $exprType = $jobset->nixexprpath =~ /.scm$/ ? "guile" : "nix";
|
||||
|
||||
# Fetch all values for all inputs.
|
||||
my $checkoutStart = clock_gettime(CLOCK_MONOTONIC);
|
||||
|
|
@ -621,7 +594,7 @@ sub checkJobsetWrapped {
|
|||
# Hash the arguments to hydra-eval-jobs and check the
|
||||
# JobsetInputHashes to see if the previous evaluation had the same
|
||||
# inputs. If so, bail out.
|
||||
my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo, $exprType));
|
||||
my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo));
|
||||
my $argsHash = sha256_hex("@args");
|
||||
my $prevEval = getPrevJobsetEval($db, $jobset, 0);
|
||||
if (defined $prevEval && $prevEval->hash eq $argsHash && !$dryRun && !$jobset->forceeval) {
|
||||
|
|
@ -636,7 +609,7 @@ sub checkJobsetWrapped {
|
|||
|
||||
# Evaluate the job expression.
|
||||
my $evalStart = clock_gettime(CLOCK_MONOTONIC);
|
||||
my ($jobs, $nixExprInput) = evalJobs($inputInfo, $exprType, $jobset->nixexprinput, $jobset->nixexprpath);
|
||||
my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
|
||||
my $evalStop = clock_gettime(CLOCK_MONOTONIC);
|
||||
|
||||
if ($jobsetsJobset) {
|
||||
|
|
|
|||
Loading…
Reference in a new issue