From mboxrd@z Thu Jan 1 00:00:00 1970 From: Jan Nieuwenhuizen Subject: Re: using Cuirass to track a guix packages' git Date: Fri, 23 Sep 2016 15:11:36 +0200 Message-ID: <871t0adalz.fsf@gnu.org> References: <87fup0rqwz.fsf@gnu.org> <8760pn7ftf.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:33279) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bnQGt-00071z-Cm for guix-devel@gnu.org; Fri, 23 Sep 2016 09:12:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bnQGo-0005FY-Nk for guix-devel@gnu.org; Fri, 23 Sep 2016 09:12:07 -0400 In-Reply-To: <8760pn7ftf.fsf@gnu.org> (Mathieu Lirzin's message of "Fri, 23 Sep 2016 00:03:24 +0200") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Mathieu Lirzin Cc: guix-devel@gnu.org --=-=-= Content-Type: text/plain Mathieu Lirzin writes: Hi Mathieu! >> 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? That makes sense; thanks, I understand. > If yes, then I guess that patch 2 and 3 can easily be adapted to use > only '#:no-compile?' as a property. Yes, that works. I was wondering if using #:compile? would be better, but I kind of like the sqlite default of `0' being translated to #f and I did not want to change the default setting. WDYT? >> Subject: [PATCH 1/4] cuirass: optionally support using of substitutes. > OK. Thanks! >> Subject: [PATCH 2/4] cuirass: support tracking of a guix package's git. > OK with the #no-compile? fix described above. Ok, new version attached. >> Subject: [PATCH 3/4] tests: track cuirass' git. >> +(define-public cuirass-git >> + (package >> + (name "cuirass-git") > > Since this is a package definition of Cuirass, would it make sense to > rename it to "guix.scm" recommended in Guix manual? Sure, done. > Is the (ci) module definition required? Not in guix.scm per se, so I have removed it there. However, in tracking of a packages' git it is necessary for the package description being available to guix build, which AIUI means that its package definition must be available in a module in the GUIX_PACKAGE_PATH. I am using this Guix package definition of Cuirass in the tests/hello-git.scm test, tracking Cuirass's git. So, therefore we need something like the (ci) module in guix/. This now works by pre-inst-env adding the guix/ sub-directory to the GUIX_PACKAGE_PATH. >> +(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. Ok, done. >> Subject: [PATCH 4/4] cuirass: handle build failure. > OK. Great! > Can you send the updated patches? Sure, find attached. I have refrained from describing this Git-tracking feature in README because it would need a version of these patches to go in first. When it works with your notabug git source url, we can add a description. to help people going. > I think you have done an amazing job. Thank you! Thanks! I'd really love to get a working Guix-based ci system and Cuirass is already very close to the minimal set that I need. I have a working patch to add building of VMs (a la hydra/guix-system.scm) but it needs a bit of cleanup work. I'm wondering about the status of the http integration. I have played a bit with what there is now but do not understand how to use it or what steps would be needed, what direction to go, to help getting a minimal web view up. Greetings, Jan --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-cuirass-optionally-support-using-of-substitutes.patch >From a26857176da63b36ec446654c79528a02fa4a3d1 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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:-@GUILE@} --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:-@GUILE@} --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:-@GUILE@} --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:-@GUILE@} --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:-@GUILE@} --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.9.3 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-cuirass-support-tracking-of-a-Guix-package-s-git.patch >From baf3f8eca7272258d276c244218a7ab3be416462 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 15 Sep 2016 23:15:54 +0200 Subject: [PATCH 2/4] cuirass: support tracking of a Guix package's git. * src/schema.sql (Specifications): Add no_compile_p column. * src/cuirass/database.scm (db-add-specification, db-get-specifications): Handle #:no-compile? property. * src/cuirass/base.scm (process-specs): Skip compilation if #:no-compile?. --- src/cuirass/base.scm | 5 +++-- src/cuirass/database.scm | 12 +++++++----- src/schema.sql | 3 ++- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 8ad6af4..3d542b1 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -149,8 +149,9 @@ if required." (let ((commit (fetch-repository spec)) (stamp (db-get-stamp db spec))) (unless (string=? commit stamp) - (compile (string-append (%package-cachedir) "/" - (assq-ref spec #:name))) + (unless (assq-ref spec #: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*))) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 2d2dfd2..0dcf544 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -116,11 +116,12 @@ database object." "Store specification SPEC in database DB and return its ID." (apply sqlite-exec db "\ INSERT INTO Specifications\ - (repo_name, url, load_path, file, proc, arguments, branch, tag, revision)\ - VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A');" + (repo_name, url, load_path, file, proc, arguments, branch, tag, revision, no_compile_p)\ + VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);" (append (assq-refs spec '(#:name #:url #:load-path #:file #:proc #:arguments)) - (assq-refs spec '(#:branch #:tag #:commit) "NULL"))) + (assq-refs spec '(#:branch #:tag #:commit) "NULL") + (list (if (assq-ref spec #:no-compile?) "1" "0")))) (last-insert-rowid db)) (define (db-get-specifications db) @@ -128,7 +129,7 @@ INSERT INTO Specifications\ (specs '())) (match rows (() specs) - ((#(id name url load-path file proc args branch tag rev) . rest) + ((#(id name url load-path file proc args branch tag rev no-compile?) . rest) (loop rest (cons `((#:id . ,id) (#:name . ,name) @@ -139,7 +140,8 @@ INSERT INTO Specifications\ (#:arguments . ,(with-input-from-string args read)) (#:branch . ,branch) (#:tag . ,(if (string=? tag "NULL") #f tag)) - (#:commit . ,(if (string=? rev "NULL") #f rev))) + (#:commit . ,(if (string=? rev "NULL") #f rev)) + (#:no-compile? . ,(zero? no-compile?))) specs)))))) (define (db-add-derivation db job) diff --git a/src/schema.sql b/src/schema.sql index a545da5..f8042d1 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -11,7 +11,8 @@ CREATE TABLE Specifications ( -- The following columns are optional. branch TEXT, tag TEXT, - revision TEXT + revision TEXT, + no_compile_p INTEGER ); CREATE TABLE Stamps ( -- 2.9.3 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0003-tests-track-Cuirass-git.patch Content-Transfer-Encoding: quoted-printable >From 51a0675a3dcadacf276535f96ea9b153072fcf42 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 14 Sep 2016 23:14:57 +0200 Subject: [PATCH 3/4] tests: track Cuirass' git. * guix.scm: New file; specify Guix package. * guix/ci.scm: New file; expose to Guix. * 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.scm | 82 +++++++++++++++++ guix/ci.scm | 22 +++++ tests/guix-track-git.scm | 225 ++++++++++++++++++++++++++++++++++++++++++= ++++ tests/hello-git.scm | 53 +++++++++++ 6 files changed, 387 insertions(+), 1 deletion(-) create mode 100644 guix.scm 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:-@GUILE@} --no-auto-compile -e main -s "$0" = "$@" (parameterize ((%package-database database) (%use-substitutes? (assoc-ref spec #:use-substitut= es?))) ;; Call the entry point of FILE and print the resulting job sex= p. - (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=3D"$abs_top_builddir/bin:$PATH" export PATH =20 +GUIX_PACKAGE_PATH=3D"guix${GUIX_PACKAGE_PATH:+:}$GUIX_PACKAGE_PATH" +export GUIX_PACKAGE_PATH + exec "$@" diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..05ebcac --- /dev/null +++ b/guix.scm @@ -0,0 +1,82 @@ +;;; guix.scm -- Guix package definition +;;; Copyright =C2=A9 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +;;; Commentary: +;; +;; GNU Guix development package. To build and install, run: +;; +;; guix package -f guix.scm +;; +;; To build it, but not install it, run: +;; +;; guix build -f guix.scm +;; +;; To use as the basis for a development environment, run: +;; +;; guix environment -l guix.scm +;; +;;; Code: + +(use-modules (gnu packages) + (gnu packages autotools) + (gnu packages base) + (gnu packages databases) + (gnu packages guile) + (gnu packages package-management) + (gnu packages pkg-config) + (guix git-download) + (guix licenses) + (guix packages) + (guix build-system gnu)) + +(define-public cuirass + (package + (name "cuirass") + (version "0.0.ff7c3a1") + (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)=20=20=20=20=20=20=20 + ("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 gpl3+))) + +;; Return it here so 'guix build/environment/package' can consume it direc= tly. +cuirass diff --git a/guix/ci.scm b/guix/ci.scm new file mode 100644 index 0000000..997629d --- /dev/null +++ b/guix/ci.scm @@ -0,0 +1,22 @@ +;;; ci.scm -- Module for Guix package definition +;;; Copyright =C2=A9 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +;; Adding this directory to GUIX_PACKAGE_PATH exposes the Cuirass package = to +;; Guix +(define-module (ci)) +(include "../guix.scm") 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 =C2=A9 2012, 2013, 2014, 2015, 2016 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2016 Mathieu Lirzin +;;; Copyright =C2=A9 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +;;; +;;; 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/patch= es") %load-path)) + (set! %load-compiled-path (cons local-guix %load-compiled-path)) + (set! %load-compiled-path (cons local-cuirass %load-compiled-path)) +=20=20 + ;; Ignore any available .go, and force recompilation. This is because o= ur + ;; 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 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 . ("bug-guix@gnu.org")) + (#: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." + (=CE=BB () + `((#: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))))=20=20=20=20=20=20 + +(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 commi= t))) + (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..9995229 --- /dev/null +++ b/tests/hello-git.scm @@ -0,0 +1,53 @@ +;;; hello-singleton.scm -- job specification test for hello in master +;;; Copyright =C2=A9 2016 Mathieu Lirzin +;;; Copyright =C2=A9 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +(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") (url . ,cuirass-git)))) --=20 2.9.3 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0004-cuirass-handle-build-failure.patch Content-Transfer-Encoding: quoted-printable >From 217c97022dcaad6e22b75bba2592ee6a449d4f25 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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 3d542b1..005632f 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 (=CE=BB (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 + (=CE=BB (port) + (parameterize ((current-build-output-port port)) + (catch 'srfi-34 + (=CE=BB () + (build-derivations store (list drv))) + (=CE=BB (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 dr= v))) + (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)) =20 --=20 2.9.3 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20 --=-=-=--