[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: using Cuirass to track a guix packages' git
|
From: |
Jan Nieuwenhuizen |
|
Subject: |
Re: using Cuirass to track a guix packages' git |
|
Date: |
Fri, 23 Sep 2016 15:11:36 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
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
>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.9.3
>From baf3f8eca7272258d276c244218a7ab3be416462 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/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
>From 51a0675a3dcadacf276535f96ea9b153072fcf42 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.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: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.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 © 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/>.
+
+;;; 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)
+ ("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 directly.
+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 © 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/>.
+
+;; 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 © 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..9995229
--- /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") (url . ,cuirass-git))))
--
2.9.3
>From 217c97022dcaad6e22b75bba2592ee6a449d4f25 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 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 (λ (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.9.3
--
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, 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, 2016/09/22
- Re: using Cuirass to track a guix packages' git,
Jan Nieuwenhuizen <=
- 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
- Re: using Cuirass to track a guix packages' git, Mathieu Lirzin, 2016/09/28