[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: using Cuirass to track a guix packages' git
|
From: |
Mathieu Lirzin |
|
Subject: |
Re: using Cuirass to track a guix packages' git |
|
Date: |
Fri, 23 Sep 2016 00:03:24 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
Hello Jan,
Jan Nieuwenhuizen <address@hidden> writes:
> I had some trouble with the #:no-compile? option, it's currently
> specified twice. On the Cuirass side I think it should be a property
> of the spec, but it seems it gets only passed as part of the
> arguments. Ideas?
OK, I think I got it. With the idea to move to a client/server
architecture in the future, Cuirass uses the database to keep track of
the specifications (in a weird way). When new specifications are added
with --specifications, they are first put in the database before being
fetched back with the previously added ones. As a consequence if a key
in the specification is not handle when adding the spec to the database
in 'db-add-specification' procedure, then it will be ignored.
Does it make sense?
If yes, then I guess that patch 2 and 3 can easily be adapted to use
only '#:no-compile?' as a property.
> From a26857176da63b36ec446654c79528a02fa4a3d1 Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <address@hidden>
> Date: Thu, 15 Sep 2016 22:50:42 +0200
> Subject: [PATCH 1/4] cuirass: optionally support using of substitutes.
>
> bin/cuirass.in (options): Add --use-substitutes.
> (show-help): Idem.
> (main): Set %use-substitutes?.
> ---
> bin/cuirass.in | 5 ++++-
> bin/evaluate.in | 8 +++++---
> src/cuirass/base.scm | 10 ++++++++--
> 3 files changed, 17 insertions(+), 6 deletions(-)
>
> diff --git a/bin/cuirass.in b/bin/cuirass.in
> index 553a5d0..88813b8 100644
> --- a/bin/cuirass.in
> +++ b/bin/cuirass.in
> @@ -35,6 +35,7 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> Add specifications from SPECFILE to database.
> -D --database=DB Use DB to store build results.
> -I, --interval=N Wait N seconds between each poll
> + --use-substitutes Allow usage of pre-built substitutes
> -V, --version Display version
> -h, --help Display this help message")
> (newline)
> @@ -46,6 +47,7 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> (specifications (single-char #\S) (value #t))
> (database (single-char #\D) (value #t))
> (interval (single-char #\I) (value #t))
> + (use-substitutes (value #f))
> (version (single-char #\V) (value #f))
> (help (single-char #\h) (value #f))))
>
> @@ -60,7 +62,8 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> ((%program-name (car args))
> (%package-database (option-ref opts 'database (%package-database)))
> (%package-cachedir
> - (option-ref opts 'cache-directory (%package-cachedir))))
> + (option-ref opts 'cache-directory (%package-cachedir)))
> + (%use-substitutes? (option-ref opts 'use-substitutes #f)))
> (cond
> ((option-ref opts 'help #f)
> (show-help)
> diff --git a/bin/evaluate.in b/bin/evaluate.in
> index f0542ce..767e15e 100644
> --- a/bin/evaluate.in
> +++ b/bin/evaluate.in
> @@ -44,8 +44,9 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> (string-append cachedir "/" (assq-ref spec #:name))
> (primitive-load (assq-ref spec #:file)))))
> (with-store store
> - ;; Make sure we don't resort to substitutes.
> - (set-build-options store #:use-substitutes? #f #:substitute-urls
> '())
> + (unless (assoc-ref spec #:use-substitutes?)
> + ;; Make sure we don't resort to substitutes.
> + (set-build-options store #:use-substitutes? #f #:substitute-urls
> '()))
> ;; Grafts can trigger early builds. We do not want that to happen
> ;; during evaluation, so use a sledgehammer to catch such problems.
> (set! build-things
> @@ -54,7 +55,8 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> stderr)
> (simple-format stderr "'build-things' arguments: ~S~%" args)
> (exit 1)))
> - (parameterize ((%package-database database))
> + (parameterize ((%package-database database)
> + (%use-substitutes? (assoc-ref spec
> #:use-substitutes?)))
> ;; Call the entry point of FILE and print the resulting job sexp.
> (let* ((proc (module-ref %user-module 'hydra-jobs))
> (thunks (proc store (assq-ref spec #:arguments)))
> diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
> index 52e0d00..8ad6af4 100644
> --- a/src/cuirass/base.scm
> +++ b/src/cuirass/base.scm
> @@ -34,7 +34,12 @@
> build-packages
> process-specs
> ;; Parameters.
> - %package-cachedir))
> + %package-cachedir
> + %use-substitutes?))
> +
> +(define %use-substitutes?
> + ;; Define whether to use substitutes
> + (make-parameter #f))
>
> (define %package-cachedir
> ;; Define to location of cache directory of this package.
> @@ -149,7 +154,8 @@ if required."
> (with-store store
> (let* ((spec* (acons #:current-commit commit spec))
> (jobs (evaluate store db spec*)))
> - (set-build-options store #:use-substitutes? #f)
> + (unless (%use-substitutes?)
> + (set-build-options store #:use-substitutes? #f))
> (build-packages store db jobs))))
> (db-add-stamp db spec commit)))
> jobspecs))
> --
> 2.10.0
OK.
> From c7af2c3459135577a5e1565ec780854959035f5f Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <address@hidden>
> Date: Thu, 15 Sep 2016 23:15:54 +0200
> Subject: [PATCH 2/4] cuirass: support tracking of a guix package's git.
>
> * src/cuirass/base.scm (process-specs): Skip compilation if #:no-compile?.
> ---
> src/cuirass/base.scm | 9 ++++++---
> 1 file changed, 6 insertions(+), 3 deletions(-)
>
> diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
> index 8ad6af4..e040f71 100644
> --- a/src/cuirass/base.scm
> +++ b/src/cuirass/base.scm
> @@ -147,10 +147,13 @@ if required."
> "Evaluate and build JOBSPECS and store results in DB."
> (for-each (λ (spec)
> (let ((commit (fetch-repository spec))
> - (stamp (db-get-stamp db spec)))
> + (stamp (db-get-stamp db spec))
> + (arguments (assq-ref spec #:arguments)))
> (unless (string=? commit stamp)
> - (compile (string-append (%package-cachedir) "/"
> - (assq-ref spec #:name)))
> + (when (and (not (assq-ref spec #:no-compile?))
> + (not (assq-ref arguments 'no-compile?)))
> + (compile (string-append (%package-cachedir) "/"
> + (assq-ref spec #:name))))
> (with-store store
> (let* ((spec* (acons #:current-commit commit spec))
> (jobs (evaluate store db spec*)))
> --
> 2.10.0
OK with the #no-compile? fix described above.
>
> From 5595b346fd82c619035d2ce202064f37bc47dbe6 Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <address@hidden>
> Date: Wed, 14 Sep 2016 23:14:57 +0200
> Subject: [PATCH 3/4] tests: track cuirass' git.
>
> * guix/ci.scm: New file.
> * build-aux/pre-inst-env.in: Add it to GUIX_PACKAGE_PATH.
> * bin/evaluate.in (main): Lookup proc using name specified by #:proc.
> * tests/guix-track-git.scm: New file.
> * tests/hello-git.scm: Test it.
> ---
> bin/evaluate.in | 3 +-
> build-aux/pre-inst-env.in | 3 +
> guix/ci.scm | 65 ++++++++++++++
> tests/guix-track-git.scm | 225
> ++++++++++++++++++++++++++++++++++++++++++++++
> tests/hello-git.scm | 53 +++++++++++
> 5 files changed, 348 insertions(+), 1 deletion(-)
> create mode 100644 guix/ci.scm
> create mode 100644 tests/guix-track-git.scm
> create mode 100644 tests/hello-git.scm
>
> diff --git a/bin/evaluate.in b/bin/evaluate.in
> index 767e15e..872d0b0 100644
> --- a/bin/evaluate.in
> +++ b/bin/evaluate.in
> @@ -58,7 +58,8 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s
> "$0" "$@"
> (parameterize ((%package-database database)
> (%use-substitutes? (assoc-ref spec
> #:use-substitutes?)))
> ;; Call the entry point of FILE and print the resulting job sexp.
> - (let* ((proc (module-ref %user-module 'hydra-jobs))
> + (let* ((proc-name (assq-ref spec #:proc))
> + (proc (module-ref %user-module proc-name))
> (thunks (proc store (assq-ref spec #:arguments)))
> (db (db-open))
> (commit (assq-ref spec #:current-commit))
> diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in
> index e8d9487..b67dc5e 100644
> --- a/build-aux/pre-inst-env.in
> +++ b/build-aux/pre-inst-env.in
> @@ -30,4 +30,7 @@ export CUIRASS_DATADIR
> PATH="$abs_top_builddir/bin:$PATH"
> export PATH
>
> +GUIX_PACKAGE_PATH="guix${GUIX_PACKAGE_PATH:+:}$GUIX_PACKAGE_PATH"
> +export GUIX_PACKAGE_PATH
> +
> exec "$@"
> diff --git a/guix/ci.scm b/guix/ci.scm
> new file mode 100644
> index 0000000..0eb886a
> --- /dev/null
> +++ b/guix/ci.scm
> @@ -0,0 +1,65 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix 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.
> +;;;
> +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (ci)
> + #:use-module ((guix licenses) #:prefix l:)
> + #:use-module (gnu packages)
> + #:use-module (guix packages)
> + #:use-module (guix git-download)
> + #:use-module (gnu packages autotools)
> + #:use-module (gnu packages base)
> + #:use-module (gnu packages databases)
> + #:use-module (gnu packages guile)
> + #:use-module (gnu packages package-management)
> + #:use-module (gnu packages pkg-config)
> + #:use-module (guix build-system gnu))
> +
> +(define-public cuirass-git
> + (package
> + (name "cuirass-git")
> + (version "0.0")
> + (source (origin
> + (method git-fetch)
> + (uri (git-reference
> + (url "https://notabug.org/mthl/cuirass";)
> + (commit "master")))
> + (sha256
> + (base32
> + "1jw3smw6axqr58ahkyjncygv0nk3hdrqkv0hm4awwj0hg5nl3d2p"))))
> + (build-system gnu-build-system)
> + (arguments
> + `(#:phases
> + (modify-phases %standard-phases
> + (add-after 'unpack 'bootstrap
> + (lambda _ (zero? (system* "sh" "bootstrap")))))))
> + (native-inputs
> + `(("autoconf" ,autoconf)
> + ("automake" ,automake)
> + ("guile" ,guile-2.0)
> + ("guile-json" ,guile-json)
> + ("guile-sqlite3" ,guile-sqlite3)
> + ("guix" ,guix)
> + ("pkg-config" ,pkg-config)
> + ("sqlite" ,sqlite)))
> + (synopsis "Continuous integration system")
> + (description
> + "Cuirass is a continuous integration system which uses GNU Guix. It is
> +intended as replacement for Hydra.")
> + (home-page "https://notabug.org/mthl/cuirass";)
> + (license l:gpl3+)))
> +
Since this is a package definition of Cuirass, would it make sense to
rename it to "guix.scm" recommended in Guix manual? Is the (ci) module
definition required?
> diff --git a/tests/guix-track-git.scm b/tests/guix-track-git.scm
> new file mode 100644
> index 0000000..15fd575
> --- /dev/null
> +++ b/tests/guix-track-git.scm
> @@ -0,0 +1,225 @@
> +;;; guix-track-git.scm -- job specification tracking a guix packages's git
> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
> +;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
> +;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
> +;;;
> +;;; This file is part of Cuirass.
> +;;;
> +;;; GNU Guix 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.
> +;;;
> +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
> +
> +;;;
> +;;; This file defines build jobs for the Hydra continuation integration
> +;;; tool.
> +;;;
> +
> +(define local-guix (string-append (getenv "HOME") "/src/guix"))
> +(define local-cuirass (string-append (getenv "HOME") "/src/cuirass/src"))
> +
> +;; Attempt to use our very own Guix modules.
> +(eval-when (compile load eval)
> +
> + (set! %load-path (cons* local-guix local-cuirass %load-path))
> + (set! %load-path (cons (string-append local-cuirass
> "/gnu/packages/patches") %load-path))
> + (set! %load-compiled-path (cons local-guix %load-compiled-path))
> + (set! %load-compiled-path (cons local-cuirass %load-compiled-path))
> +
> + ;; Ignore any available .go, and force recompilation. This is because our
> + ;; checkout in the store has mtime set to the epoch, and thus .go files
> look
> + ;; newer, even though they may not correspond.
> + (set! %fresh-auto-compile #t))
> +
> +(use-modules (guix config)
> + (guix store)
> + (guix grafts)
> + (guix packages)
> + (guix derivations)
> + (guix monads)
> + ((guix licenses)
> + #:select (gpl3+ license-name license-uri license-comment))
> + ((guix utils) #:select (%current-system))
> + ((guix scripts system) #:select (read-operating-system))
> + (gnu packages)
> + (gnu packages gcc)
> + (gnu packages base)
> + (gnu packages gawk)
> + (gnu packages guile)
> + (gnu packages gettext)
> + (gnu packages compression)
> + (gnu packages multiprecision)
> + (gnu packages make-bootstrap)
> + (gnu packages commencement)
> + (gnu packages package-management)
> + (gnu system)
> + (gnu system vm)
> + (gnu system install)
> + (gnu tests)
> + (srfi srfi-1)
> + (srfi srfi-26)
> + (ice-9 optargs)
> + (ice-9 match))
> +
> +(use-modules (gnu packages dezyne)
> + (gnu system development-verum)
> + (guix dezyne-dev))
> +
> +;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
> +;; port to the bit bucket, let us write to the error port instead.
> +(setvbuf (current-error-port) _IOLBF)
> +(set-current-output-port (current-error-port))
> +
> +(define (license->alist lcs)
> + "Return LCS <license> object as an alist."
> + ;; Sometimes 'license' field is a list of licenses.
> + (if (list? lcs)
> + (map license->alist lcs)
> + `((name . ,(license-name lcs))
> + (uri . ,(license-uri lcs))
> + (comment . ,(license-comment lcs)))))
> +
> +(define (package-metadata package)
> + "Convert PACKAGE to an alist suitable for Hydra."
> + `((#:description . ,(package-synopsis package))
> + (#:long-description . ,(package-description package))
> + (#:license . ,(license->alist (package-license package)))
> + (#:home-page . ,(package-home-page package))
> + (#:maintainers . ("address@hidden"))
> + (#:max-silent-time . ,(or (assoc-ref (package-properties package)
> + 'max-silent-time)
> + 3600)) ;1 hour by default
> + (#:timeout . ,(or (assoc-ref (package-properties package) 'timeout)
> + 72000)))) ;20 hours by default
> +
> +(define (package-job store job-name package system)
> + "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
> + (λ ()
> + `((#:job-name . ,(string-append (symbol->string job-name) "." system))
> + (#:derivation . ,(derivation-file-name
> + (parameterize ((%graft? #f))
> + (package-derivation store package system
> + #:graft? #f))))
> + ,@(package-metadata package))))
> +
> +(define job-name
> + ;; Return the name of a package's job.
> + (compose string->symbol package-full-name))
> +
> +(define package->job
> + (let ((base-packages
> + (delete-duplicates
> + (append-map (match-lambda
> + ((_ package _ ...)
> + (match (package-transitive-inputs package)
> + (((_ inputs _ ...) ...)
> + inputs))))
> + %final-inputs))))
> + (lambda (store package system)
> + "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
> +valid."
> + (cond ((member package base-packages)
> + #f)
> + ((supported-package? package system)
> + (package-job store (job-name package) package system))
> + (else
> + #f)))))
> +
> +;;; END hydra/gnu-system.scm
> +
> +
> +;;;
> +;;; Cuirass CI tracking packages' git
> +;;;
> +
> +(use-modules (srfi srfi-11)
> + (srfi srfi-9 gnu)
> + (rnrs io ports)
> + (gnu packages)
> + (guix base32)
> + (guix git-download)
> + (guix hash)
> + (guix packages)
> + (guix serialization)
> + (guix utils)
> + (guix ui)
> + (cuirass base))
> +
> +(define (url->file-name url)
> + (string-trim
> + (string-map (lambda (c) (if (memq c (string->list ":/")) #\- c)) url)
> + #\-))
> +
> +(define* (package->spec pkg #:key (branch "master") commit url)
> + (let ((url (or url ((compose git-reference-url origin-uri package-source)
> pkg))))
> + `((#:name . ,(url->file-name url))
> + (#:url . ,url)
> + (#:branch . ,branch)
> + (#:commit . ,commit))))
> +
> +(define (vcs-file? file stat)
> + (case (stat:type stat)
> + ((directory)
> + (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
> + (else
> + #f)))
> +
> +(define select? (negate vcs-file?))
> +
> +(define (file-hash file)
> + ;; Compute the hash of FILE.
> + ;; Catch and gracefully report possible '&nar-error' conditions.
> + (with-error-handling
> + (let-values (((port get-hash) (open-sha256-port)))
> + (write-file file port #:select? select?)
> + (flush-output-port port)
> + (get-hash))))
> +
> +(define (commit? string)
> + (string-every (string->char-set "0123456789abcdef") string))
> +
> +(define (call-with-output-fdes fdes new-file thunk)
> + (let ((outport (fdes->outport fdes))
> + (port (open-file new-file "w")))
> + (move->fdes port fdes)
> + (let ((result (thunk)))
> + (move->fdes port fdes)
> + result)))
> +
> +(define* (package->git-tracked pkg #:key (branch "master") commit url)
> + (let* ((source (package-source pkg))
> + (uri (origin-uri source)))
> + (if (not branch) pkg
> + (let* ((spec (package->spec pkg #:branch branch #:commit commit
> #:url url))
> + (commit (call-with-output-fdes 1 "/dev/null"
> + (lambda () (fetch-repository
> spec))))
> + (url (or url (git-reference-url uri)))
> + (git-dir (string-append (%package-cachedir) "/"
> (url->file-name url)))
> + (hash (bytevector->nix-base32-string (file-hash git-dir)))
> + (source (origin (uri (git-reference (url url) (commit
> commit)))
> + (method git-fetch)
> + (sha256 (base32 hash)))))
> + (set-fields pkg ((package-source) source))))))
> +
> +
> +;;;
> +;;; Guix entry point.
> +;;;
> +
> +(define (guix-jobs store arguments)
> + (let* ((name (or (assoc-ref arguments 'name) "hello"))
> + (pkg (specification->package name))
> + (branch (or (assoc-ref arguments 'branch) "master"))
> + (url (assoc-ref arguments 'url))
> + (pkg.git (package->git-tracked pkg #:branch branch #:url url))
> + (system (or (assoc-ref arguments 'system) "x86_64-linux")))
> + (parameterize ((%graft? #f))
> + (list (package-job store (job-name pkg) pkg.git system)))))
> diff --git a/tests/hello-git.scm b/tests/hello-git.scm
> new file mode 100644
> index 0000000..dc68782
> --- /dev/null
> +++ b/tests/hello-git.scm
> @@ -0,0 +1,53 @@
> +;;; hello-singleton.scm -- job specification test for hello in master
> +;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
> +;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
> +;;;
> +;;; This file is part of Cuirass.
> +;;;
> +;;; Cuirass 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.
> +;;;
> +;;; Cuirass 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 Cuirass. If not, see <http://www.gnu.org/licenses/>.
> +
> +(use-modules (srfi srfi-1))
> +
> +(define (local-file file)
> + ;; In the common case jobs will be defined relative to the repository.
> + ;; However for testing purpose use local gnu-system.scm instead.
> + (string-append (dirname (current-filename)) "/" file))
> +
> +(define (url->file-name url)
> + (string-trim
> + (string-map (lambda (c) (if (memq c (string->list ":/")) #\- c)) url)
> + #\-))
> +
> +(define vc
> + ;; where your version-control checkouts live
> + (string-append (getenv "HOME") "/src"))
> +(define guix-checkout (string-append vc "/guix"))
> +
> +;; building GNU hello from git is too much work
> +;; (define hello-checkout (string-append vc "/hello"))
> +;; (define hello-git "http://git.savannah.gnu.org/r/hello.git";)
> +;; ... so let's track cuirass' git
> +(define cuirass-checkout (string-append vc "/cuirass"))
> +(define cuirass-git "https://notabug.org/mthl/cuirass";)
> +;;(define cuirass-git "https://gitlab.com/janneke/cuirass.git";)
> +
> +(list
> + `((#:name . ,(url->file-name cuirass-checkout))
> + (#:url . ,cuirass-git)
> + (#:branch . "master")
> + (#:no-compile? . #t)
> + (#:load-path . ,guix-checkout)
> + (#:proc . guix-jobs)
> + (#:file . ,(local-file "guix-track-git.scm"))
> + (#:arguments (name . "cuirass-git") (no-compile? . #t) (url .
> ,cuirass-git))))
> --
> 2.10.0
OK with the #no-compile? fix described above.
> From 67c3e529a811705c69047380414ba4687544b129 Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <address@hidden>
> Date: Fri, 16 Sep 2016 09:25:55 +0200
> Subject: [PATCH 4/4] cuirass: handle build failure.
>
> * src/cuirass/base.scm (build-packages): Catch build failures, write error log
> and update database.
> ---
> src/cuirass/base.scm | 30 +++++++++++++++++++++---------
> 1 file changed, 21 insertions(+), 9 deletions(-)
>
> diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
> index e040f71..a65c412 100644
> --- a/src/cuirass/base.scm
> +++ b/src/cuirass/base.scm
> @@ -124,22 +124,34 @@ if required."
> (define (build-packages store db jobs)
> "Build JOBS and return a list of Build results."
> (map (λ (job)
> - (let ((log-port (%make-void-port "w0"))
> - (name (assq-ref job #:job-name))
> - (drv (assq-ref job #:derivation))
> - (eval-id (assq-ref job #:eval-id)))
> + (let* ((name (assq-ref job #:job-name))
> + (drv (assq-ref job #:derivation))
> + (eval-id (assq-ref job #:eval-id))
> + (success? #t)
> + (error-log (string-append (%package-cachedir) "/"
> + name ".log")))
> (simple-format #t "building ~A...\n" drv)
> - (parameterize ((current-build-output-port log-port))
> - (build-derivations store (list drv))
> - (let* ((output (derivation-path->output-path drv))
> - (log (log-file store output))
> + (let ((log (call-with-output-string
> + (λ (port)
> + (parameterize ((current-build-output-port port))
> + (catch 'srfi-34
> + (λ ()
> + (build-derivations store (list drv)))
> + (λ (key . args)
> + (set! success? #f)
> + (pk "kets key:" key "args:" args))))))))
> + (when (not success?)
> + (with-output-to-file error-log
> + (lambda () (display log)))
> + (simple-format #t "build failed: ~a\n" error-log))
> + (let* ((output (and success? (derivation-path->output-path
> drv)))
> + (log (if success? (log-file store output) error-log))
> (build `((#:derivation . ,drv)
> (#:eval-id . ,eval-id)
> (#:log . ,log)
> (#:output . ,output))))
> (db-add-build db build)
> (simple-format #t "~A\n" output)
> - (close-port log-port)
> build))))
> jobs))
>
> --
> 2.10.0
OK.
Can you send the updated patches?
I think you have done an amazing job. Thank you!
--
Mathieu Lirzin
- using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/16
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/20
- Re: using Cuirass to track a guix packages' git,
Mathieu Lirzin <=
- Re: using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/23
- Re: using Cuirass to track a guix packages' git, David Craven, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/23
- Re: using Cuirass to track a guix packages' git, Jan Nieuwenhuizen, 2016/09/24