[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
using Cuirass to track a guix packages' git
|
From: |
Jan Nieuwenhuizen |
|
Subject: |
using Cuirass to track a guix packages' git |
|
Date: |
Fri, 16 Sep 2016 00:10:58 +0200 |
Hi!
I have been playing with Cuirass and I like it a lot!
Next to replacing Hydra for GuixSD, there is another use case that I'd
like Cuirass to support: tracking an (any) upstream packages' git.
When the target of your continuous integration is not Guix itself but
some specific package, you may well want to allow usage of substitutes
(patch 1).
Assuming you have checked-out guix and cuirass in ~/src/guix and
~/src/cuirass, doing
./pre-inst-env cuirass --use-substitutes --specifications=tests/hello-git.scm
will monitor any changes to Cuirass' git repository and rebuild the
latest commit of the Cuirass package using Guix (patch 2 and 3).
Of course, a build a failure should not crash cuirass and also be
noted/stamped, not repeated every heartbeat (patch 4).
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?
Thank you!
Greetings,
Jan
>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
>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
>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+)))
+
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
>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
--
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.nl
- using Cuirass to track a guix packages' git,
Jan Nieuwenhuizen <=
- 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, 2016/09/22
- 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