diff --git a/.gitignore b/.gitignore index e53ae6a8..5663a9d6 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/configure.ac b/configure.ac index f992e49e..f99d4c9d 100644 --- a/configure.ac +++ b/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]) diff --git a/flake.nix b/flake.nix index 85d8e5e4..3037a1e3 100644 --- a/flake.nix +++ b/flake.nix @@ -106,8 +106,8 @@ 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 final.nix + boehmgc postgresql95 # for running the tests boost (nlohmann_json.override { multipleHeaders = true; }) diff --git a/src/script/Makefile.am b/src/script/Makefile.am index 9deb6f29..466d3153 100644 --- a/src/script/Makefile.am +++ b/src/script/Makefile.am @@ -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) diff --git a/src/script/hydra-eval-guile-jobs.in b/src/script/hydra-eval-guile-jobs.in deleted file mode 100644 index 8c5df125..00000000 --- a/src/script/hydra-eval-guile-jobs.in +++ /dev/null @@ -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 -;;; -;;; 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 . - -(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 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)))) diff --git a/src/script/hydra-eval-jobset b/src/script/hydra-eval-jobset index 9074955f..4ee716ba 100755 --- a/src/script/hydra-eval-jobset +++ b/src/script/hydra-eval-jobset @@ -264,53 +264,31 @@ 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} . "" . - "; inputType = \"" . $input->{type} . "\"" . - (defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") . - (defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") . - (defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") . - (defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") . - (defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") . - (defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") . - (defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") . - (defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") . - (defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") . - ";}"; - } - return $result; + my ($input) = @_; + return + "{ outPath = builtins.storePath " . $input->{storePath} . "" . + "; inputType = \"" . $input->{type} . "\"" . + (defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") . + (defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") . + (defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") . + (defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") . + (defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") . + (defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") . + (defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") . + (defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") . + (defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") . + ";}"; } 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,7 +328,7 @@ sub inputsToArgs { sub evalJobs { - my ($inputInfo, $exprType, $nixExprInputName, $nixExprPath, $flakeRef) = @_; + my ($inputInfo, $nixExprInputName, $nixExprPath, $flakeRef) = @_; my @cmd; @@ -365,13 +341,11 @@ sub evalJobs { 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"; - - @cmd = ($evaluator, + @cmd = ("hydra-eval-jobs", "<" . $nixExprInputName . "/" . $nixExprPath . ">", "--gc-roots-dir", getGCRootsDir, "--max-jobs", 1, - inputsToArgs($inputInfo, $exprType)); + inputsToArgs($inputInfo)); } if (defined $ENV{'HYDRA_DEBUG'}) { @@ -604,7 +578,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); @@ -640,7 +613,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 && $prevEval->flake eq $flakeRef) { @@ -655,7 +628,7 @@ sub checkJobsetWrapped { # Evaluate the job expression. my $evalStart = clock_gettime(CLOCK_MONOTONIC); - my $jobs = evalJobs($inputInfo, $exprType, $jobset->nixexprinput, $jobset->nixexprpath, $flakeRef); + my $jobs = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath, $flakeRef); my $evalStop = clock_gettime(CLOCK_MONOTONIC); if ($jobsetsJobset) {