Add support for Guile & Guix.

Dependencies

• [2] R4MHON3O pass svn/bzr revisions as integers
• [3] KNJTTZ3Z Pass the abbreviated Git revision
• [4] HQGXL4MX Add validation for project and jobset names
• [5] INNOEHO6 * Fix getBuildLog for bzip2'd files.
• [6] PXUCXYZI * Pass `-j 1' to hydra_eval_jobs to ensure that it can make progress
• [7] CHQEG6WY Hydra/29: Added timeout to svn/git checkouts, job evaluation
• [8] BTOXLRG3 * Record the input containing the Nix expression (release.nix) in the
• [9] LZO3C2KI * Hack around those SQLite timeouts: just retry the transaction.
• [10] 5SHCWE7X * Prevent repeated evaluation of a jobset with the same inputs. This
• [11] FDE3BJAP * Refactoring.
• [12] SM5M2J3A Pass inputs to release expressions using -I
• [13] POPU2ATH * hydra_scheduler: use eval-jobs.
• [14] RFE6T5LG * Store jobset evaluations in the database explicitly. This includes
• [15] PDZD5QOR hydra-evaluator: handle the case where there is no previous jobset eval
• [16] P5XCKTFD Fix sysbuild input type handling
• [17] WRIU3S5E * UI for cloning builds (not functional yet).
• [18] OOQ2D3KC * Refactoring: move fetchInput out of hydra_scheduler into a separate
• [19] 3XTHEUMP * Implemented the clone feature.
• [20] YFPZ46YK * hydra: added variant of build input type, 'build output (same system)' to allow better continous integration in one jobset for multiple system. it makes sure that the system of the build that is passed as input for a job has the same system as the job.
• [21] X27GNHDV * Basic job info in the database.
• [22] 2WRTOU2Z Cleanup
• [23] 4FWDVNWA Pass additional attributes for Git inputs
• [24] KN3VYE5P * Cleaned up the foreign key constraints.
• [25] 2WUNXJGW Hydra/26: Go back to using "svn export" as default for svn, added svn-checkout type for jobset which need .svn dirs. export is much more efficient
• [26] RXVJFQ5A Evaluator cleanups
• [27] JOYONH2K Prevent multiple builds with the same (job, outPath) tuple from being added
• [28] DDMYFZ5X Fix the jobset unchanged check
• [29] O25D52TA initial support for mercurial
• [30] ARD6Z67T Do incremental SVN checkouts
• [31] 2YXO5ZGQ Hydra/28: Rename "scheduler" to "evaluator"
• [32] BSOLESYK * hydra: project members can do stuff that the owner can do
• [33] WVX47J4E properly pass bazaar inputs
• [34] PIMGMGAF Rename hydra_eval_jobs to hydra-eval-jobs
• [35] JTRG7RDQ add support for git as jobinput
• [*] FV2M6MOT hydra: use autoconf/-make
• [*] M3A5PZIH hydra: Clarify the dependency on BDW-GC.
• [*] FAIJDQKZ
• [*] LBNVQXUB * Build the /build stuff in a separate controller.
• [*] 3HZY24CX * Make jobsets viewable under
• [*] ODNCGFQ5 * Improved the navigation bar: don't include all projects (since that
• [*] FPK5LF53 * Put the project-related actions in a separate controller. Put the
• [*] L4AI5YL6 Rename hydra_*.pl to hydra-*
• [*] D5QIOJGP * Move everything up one directory.
• [*] N22GPKYT * Put info about logs / build products in the DB.
• [*] 3ZCEPLNO

Change contents

• edit in configure.ac at line 78
  [38.39]

  [39.0]
  + PKG_CHECK_MODULES([GUILE], [guile-2.0], [HAVE_GUILE=yes], [HAVE_GUILE=no])
• edit in src/lib/Hydra/Controller/Build.pm at line 466
  [6.410]

  [6.125]
  + # When the expression is in a .scm file, assume it's a Guile + Guix

  + # build expression.

  + my $exprType =

  + $c->request->params->{"nixexprpath"} =~ /.scm$/ ? "guile" : "nix";

  +
• replacement in src/lib/Hydra/Controller/Build.pm at line 496
  [6.847]→[6.466:553](∅→∅)
  − my ($jobs, $nixExprInput) = evalJobs($inputInfo, $nixExprInputName, $nixExprPath);
  [6.847]

  [6.553]
  + my ($jobs, $nixExprInput) = evalJobs($inputInfo, $exprType, $nixExprInputName, $nixExprPath);
• edit in src/lib/Hydra/Controller/Jobset.pm at line 226
  [42.1668]

  [6.2155]
  + # When the expression is in a .scm file, assume it's a Guile + Guix

  + # build expression.

  + my $exprType =

  + $c->request->params->{"nixexprpath"} =~ /.scm$/ ? "guile" : "nix";

  +
• edit in src/lib/Hydra/Controller/Project.pm at line 149
  [42.5257]

  [4.1274]
  + my $exprType =

  + $c->request->params->{"nixexprpath"} =~ /.scm$/ ? "guile" : "nix";
• edit in src/lib/Hydra/Helper/AddBuilds.pm at line 644
  [6.931]

  [6.1356]
  + }

  +

  +

  + 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;
• edit in src/lib/Hydra/Helper/AddBuilds.pm at line 663
  [6.1359]

  [6.1359]
  + 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} . "" .

  + (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} . "\"" : "") .

  + ";}";

  + }

  + return $result;

  + }
• replacement in src/lib/Hydra/Helper/AddBuilds.pm at line 687
  [6.1379]→[6.1379:1405](∅→∅)
  − my ($inputInfo) = @_;
  [6.1379]

  [6.1405]
  + my ($inputInfo, $exprType) = @_;
• replacement in src/lib/Hydra/Helper/AddBuilds.pm at line 700
  [6.1709]→[6.1709:1772](∅→∅)
  − push @res, "--arg", $input, $alt->{value};
  [6.1709]

  [6.1772]
  + push @res, "--arg", $input, booleanToString($exprType, $alt->{value});
• replacement in src/lib/Hydra/Helper/AddBuilds.pm at line 703
  [2.68]→[6.1840:2074](∅→∅),[6.114]→[6.1840:2074](∅→∅),[6.553]→[6.1840:2074](∅→∅),[6.1709]→[6.1840:2074](∅→∅),[6.2668]→[6.1840:2074](∅→∅),[6.2766]→[6.1840:2074](∅→∅),[6.1840]→[6.1840:2074](∅→∅),[6.2074]→[6.487:685](∅→∅),[6.685]→[3.324:428](∅→∅),[3.428]→[6.2074:2227](∅→∅),[6.685]→[6.2074:2227](∅→∅),[6.2074]→[6.2074:2227](∅→∅)
  − push @res, "--arg", $input, (

  − "{ outPath = builtins.storePath " . $alt->{storePath} . "" .

  − (defined $alt->{revision} ? "; rev = \"" . $alt->{revision} . "\"" : "") .

  − (defined $alt->{revCount} ? "; revCount = " . $alt->{revCount} . "" : "") .

  − (defined $alt->{gitTag} ? "; gitTag = \"" . $alt->{gitTag} . "\"" : "") .

  − (defined $alt->{shortRev} ? "; shortRev = \"" . $alt->{shortRev} . "\"" : "") .

  − (defined $alt->{version} ? "; version = \"" . $alt->{version} . "\"" : "") .

  − ";}"

  − );
  [2.68]

  [6.2227]
  + push @res, "--arg", $input, buildInputToString($exprType, $alt);
• replacement in src/lib/Hydra/Helper/AddBuilds.pm at line 745
  [6.2489]→[6.2489:2548](∅→∅)
  − my ($inputInfo, $nixExprInputName, $nixExprPath) = @_;
  [6.2489]

  [6.2548]
  + my ($inputInfo, $exprType, $nixExprInputName, $nixExprPath) = @_;
• edit in src/lib/Hydra/Helper/AddBuilds.pm at line 753
  [5.414]

  [6.838]
  + my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";

  + print STDERR "evaluator ${evaluator}\n";

  +
• replacement in src/lib/Hydra/Helper/AddBuilds.pm at line 757
  [6.906]→[6.120:236](∅→∅)
  − ("hydra-eval-jobs", $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo)));
  [6.906]

  [6.3093]
  + ($evaluator, $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo, $exprType)));
• edit in src/script/Makefile.am at line 9
  [44.93]

  [44.93]
  + hydra-eval-guile-jobs \
• file addition: hydra-eval-guile-jobs (---r------)
  [45.2543]
  + #!/bin/sh

  + # Aside from this initial boilerplate, this is actually -*- scheme -*- code.

  + main="(module-ref (resolve-interface '(hydra-eval-guile-jobs)) 'eval-guile-jobs)"

  +

  + # Make sure no undeclared dependency is leaked. Guix has to be

  + # provided as an input through Hydra. Guix itself must thus be built via a

  + # recipe written in the Nix language.

  + unset GUILE_LOAD_PATH

  + unset GUILE_LOAD_COMPILED_PATH

  +

  + exec ${GUILE:-guile} --no-auto-compile \

  + -l "$0" -c "(apply $main (cdr (command-line)))" "$@"

  + !#

  + ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>

  + ;;;

  + ;;; 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-path-rx

  + (make-regexp "^.*/nix/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 (job-evaluations->sxml jobs)

  + "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)))

  + (_

  + '())))

  +

  + ;; XXX: Add <arg ...> tags?

  + `(job (@ (jobName ,name)

  + (drvPath ,drv)

  + (outPath

  + ;; Resolve Guix modules lazily.

  + ,((guix-variable 'derivations

  + 'derivation-path->output-path)

  + drv))

  + ,@(opt-attr 'homepage 'home-page)

  + ,@(opt-attr 'license 'license)

  + ,@(opt-attr 'description 'description)

  + ,@(opt-attr 'longDescription 'long-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)

  + 7200)))

  + (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)))))

  + "\n"))))

  + jobs))))

  +

  + (define (job-evaluations->xml jobs port)

  + (set-port-encoding! port "UTF-8")

  + (sxml->xml (job-evaluations->sxml jobs) 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)))

  + (job-evaluations->xml jobs (current-output-port)))))
• edit in src/script/hydra-evaluator at line 103
  [6.3692]

  [47.2021]
  + my $exprType = $jobset->nixexprpath =~ /.scm$/ ? "guile" : "nix";
• replacement in src/script/hydra-evaluator at line 113
  [6.2206]→[6.2206:2294](∅→∅)
  − my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo));
  [6.2206]

  [6.2294]
  + my @args = ($jobset->nixexprinput, $jobset->nixexprpath, inputsToArgs($inputInfo, $exprType));
• replacement in src/script/hydra-evaluator at line 126
  [6.5549]→[6.6997:7096](∅→∅),[6.2226]→[6.6997:7096](∅→∅)
  − my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
  [6.5549]

  [6.5550]
  + my ($jobs, $nixExprInput) = evalJobs($inputInfo, $exprType, $jobset->nixexprinput, $jobset->nixexprpath);
• replacement in src/sql/hydra.sql at line 52
  [6.5039]→[6.5039:5201](∅→∅)
  − nixExprInput text not null, -- name of the jobsetInput containing the Nix expression

  − nixExprPath text not null, -- relative path of the Nix expression
  [6.5039]

  [6.5201]
  + nixExprInput text not null, -- name of the jobsetInput containing the Nix or Guix expression

  + nixExprPath text not null, -- relative path of the Nix or Guix expression