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.

.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

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],
+AC_CONFIG_COMMANDS([executable-scripts], [])
-  [chmod +x src/script/hydra-eval-guile-jobs])
 
 AC_CONFIG_HEADER([hydra-config.h])
 

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; })

src/script/Makefile.am

@@ -1,6 +1,5 @@
 EXTRA_DIST =					\
-  $(distributable_scripts)			\
+  $(distributable_scripts)
-  hydra-eval-guile-jobs.in
 
 distributable_scripts =				\
   hydra-backfill-ids				\
@@ -17,5 +16,4 @@ distributable_scripts =				\
   nix-prefetch-hg
 
 bin_SCRIPTS =					\
-  $(distributable_scripts)			\
+  $(distributable_scripts)
-  hydra-eval-guile-jobs

src/script/hydra-eval-guile-jobs.in

@@ -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))))

src/script/hydra-eval-jobset

@@ -264,53 +264,31 @@ sub fetchInput {
 
 
 sub booleanToString {
-    my ($exprType, $value) = @_;
+    my ($value) = @_;
-    my $result;
+    return $value;
-    if ($exprType eq "guile") {
-        if ($value eq "true") {
-            $result = "#t";
-        } else {
-            $result = "#f";
-        }
-        $result = $value;
-    } else {
-        $result = $value;
-    }
-    return $result;
 }
 
 
 sub buildInputToString {
-    my ($exprType, $input) = @_;
+    my ($input) = @_;
-    my $result;
+    return
-    if ($exprType eq "guile") {
+        "{ outPath = builtins.storePath " . $input->{storePath} . "" .
-        $result = "'((file-name . \"" . ${input}->{storePath} . "\")" .
+        "; inputType = \"" . $input->{type} . "\"" .
-            (defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .
+        (defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
-            (defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .
+        (defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
-            (defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .
+        (defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .
-            (defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .
+        (defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .
-            (defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .
+        (defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .
-            ")";
+        (defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .
-    } else {
+        (defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .
-        $result = "{ outPath = builtins.storePath " . $input->{storePath} . "" .
+        (defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
-            "; inputType = \"" . $input->{type} . "\"" .
+        (defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
-            (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;
 }
 
 
 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 = ("hydra-eval-jobs",
-
-        @cmd = ($evaluator,
                 "<" . $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) {