unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* using Cuirass to track a guix packages' git
@ 2016-09-15 22:10 Jan Nieuwenhuizen
  2016-09-20 19:49 ` Mathieu Lirzin
  2016-09-22 22:03 ` Mathieu Lirzin
  0 siblings, 2 replies; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-15 22:10 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 1020 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-cuirass-optionally-support-using-of-substitutes.patch --]
[-- Type: text/x-patch, Size: 4512 bytes --]

From a26857176da63b36ec446654c79528a02fa4a3d1 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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.10.0


[-- Attachment #3: 0002-cuirass-support-tracking-of-a-guix-package-s-git.patch --]
[-- Type: text/x-patch, Size: 1551 bytes --]

From c7af2c3459135577a5e1565ec780854959035f5f Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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


[-- Attachment #4: 0003-tests-track-cuirass-git.patch --]
[-- Type: text/x-patch, Size: 16067 bytes --]

From 5595b346fd82c619035d2ce202064f37bc47dbe6 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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:-@GUILE@} --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 <janneke@gnu.org>
+;;;
+;;; 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 <ludo@gnu.org>
+;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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 . ("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."
+  (λ ()
+    `((#: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
+
+\f
+;;;
+;;; 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))))))
+
+\f
+;;;
+;;; 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 <mthl@gnu.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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


[-- Attachment #5: 0004-cuirass-handle-build-failure.patch --]
[-- Type: text/x-patch, Size: 2815 bytes --]

From 67c3e529a811705c69047380414ba4687544b129 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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


[-- Attachment #6: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-15 22:10 using Cuirass to track a guix packages' git Jan Nieuwenhuizen
@ 2016-09-20 19:49 ` Mathieu Lirzin
  2016-09-22 22:03 ` Mathieu Lirzin
  1 sibling, 0 replies; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-20 19:49 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Hello Jan,

Jan Nieuwenhuizen <janneke@gnu.org> writes:

> I have been playing with Cuirass and I like it a lot!

Cool. :)

I want to let you know that I have just started looking at your patches.
I have been quite busy lately.  Sorry for the latency.

Next time I will let you know sooner if you should expect a delay.

> Next to replacing Hydra for GuixSD, there is another use case that I'd
> like Cuirass to support: tracking an (any) upstream packages' git.

This is highly desirable indeed.

> 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).

Agreed.

> 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).

yes :)

> 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?

No idea for now.  I will comment/review your code in details in a
following mail.  I should be able to do that in the next 48H.

Thank you for your patches, patience and courage!

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-15 22:10 using Cuirass to track a guix packages' git Jan Nieuwenhuizen
  2016-09-20 19:49 ` Mathieu Lirzin
@ 2016-09-22 22:03 ` Mathieu Lirzin
  2016-09-23 13:11   ` Jan Nieuwenhuizen
  1 sibling, 1 reply; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-22 22:03 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Hello Jan,

Jan Nieuwenhuizen <janneke@gnu.org> 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 <janneke@gnu.org>
> 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.10.0

OK.

> From c7af2c3459135577a5e1565ec780854959035f5f Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <janneke@gnu.org>
> 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 <janneke@gnu.org>
> 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:-@GUILE@} --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 <janneke@gnu.org>
> +;;;
> +;;; 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 <ludo@gnu.org>
> +;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
> +;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
> +;;;
> +;;; 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 . ("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."
> +  (λ ()
> +    `((#: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
> +
> +\f
> +;;;
> +;;; 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))))))
> +
> +\f
> +;;;
> +;;; 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 <mthl@gnu.org>
> +;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
> +;;;
> +;;; 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 <janneke@gnu.org>
> 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

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-22 22:03 ` Mathieu Lirzin
@ 2016-09-23 13:11   ` Jan Nieuwenhuizen
  2016-09-23 13:44     ` Jan Nieuwenhuizen
  2016-09-23 15:25     ` Mathieu Lirzin
  0 siblings, 2 replies; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-23 13:11 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 3558 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-cuirass-optionally-support-using-of-substitutes.patch --]
[-- Type: text/x-patch, Size: 4511 bytes --]

From a26857176da63b36ec446654c79528a02fa4a3d1 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-cuirass-support-tracking-of-a-Guix-package-s-git.patch --]
[-- Type: text/x-patch, Size: 3684 bytes --]

From baf3f8eca7272258d276c244218a7ab3be416462 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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


[-- Attachment #4: 0003-tests-track-Cuirass-git.patch --]
[-- Type: text/x-patch, Size: 17618 bytes --]

From 51a0675a3dcadacf276535f96ea9b153072fcf42 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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-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 <janneke@gnu.org>
+;;;
+;;; 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 <janneke@gnu.org>
+;;;
+;;; 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 <ludo@gnu.org>
+;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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 . ("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."
+  (λ ()
+    `((#: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
+
+\f
+;;;
+;;; 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))))))
+
+\f
+;;;
+;;; 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 <mthl@gnu.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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


[-- Attachment #5: 0004-cuirass-handle-build-failure.patch --]
[-- Type: text/x-patch, Size: 2814 bytes --]

From 217c97022dcaad6e22b75bba2592ee6a449d4f25 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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


[-- Attachment #6: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 13:11   ` Jan Nieuwenhuizen
@ 2016-09-23 13:44     ` Jan Nieuwenhuizen
  2016-09-23 15:25     ` Mathieu Lirzin
  1 sibling, 0 replies; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-23 13:44 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 675 bytes --]

Jan Nieuwenhuizen writes:

Oops, sent too soon, patch 2 needed this fix

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 0dcf544..5d3922b 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -141,7 +141,7 @@ INSERT INTO Specifications\
                      (#:branch . ,branch)
                      (#:tag . ,(if (string=? tag "NULL") #f tag))
                      (#:commit . ,(if (string=? rev "NULL") #f rev))
-                     (#:no-compile? . ,(zero? no-compile?)))
+                     (#:no-compile? . ,(not (zero? no-compile?))))
                    specs))))))
 
 (define (db-add-derivation db job)

Greetings,
Jan


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-cuirass-support-tracking-of-a-Guix-package-s-git.patch --]
[-- Type: text/x-patch, Size: 3690 bytes --]

From 2ddac2390c42836cb5073ce67466802e2306e1aa Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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..5d3922b 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? . ,(not (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


[-- Attachment #3: Type: text/plain, Size: 154 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply related	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 13:11   ` Jan Nieuwenhuizen
  2016-09-23 13:44     ` Jan Nieuwenhuizen
@ 2016-09-23 15:25     ` Mathieu Lirzin
  2016-09-23 15:39       ` Jan Nieuwenhuizen
  1 sibling, 1 reply; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-23 15:25 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Jan Nieuwenhuizen <janneke@gnu.org> writes:

> 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?

Intuitively I would prefer "#:compile?" but both are OK, so we can stick
with "#:no-compile?" if that's more convenient.

>>> 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.

OK.

>> Can you send the updated patches?
>
> Sure, find attached.

Pushed with minor cosmetic changes.  :)

>  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.

Given the current state of Cuirass, I think it is OK to not provide
documentation while experimenting.

>> 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.

Nice!

> 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.

There is a basic Guile Web server which is runnable via
'run-cuirass-server' procedure.  There is only one JSON ressource which
is accessible from "/specifications" and "/jobsets" routes.  To use the
server you have to parameterize the '%package-database' parameter to
point to an SQLite file with specifications in it.

What needs to be done is to provide more JSON ressources (inspired by
Hydra API) by translating request to SQL queries.  A command line
interface would be a nice addition too.

Thanks.

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 15:25     ` Mathieu Lirzin
@ 2016-09-23 15:39       ` Jan Nieuwenhuizen
  2016-09-23 17:59         ` Mathieu Lirzin
  0 siblings, 1 reply; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-23 15:39 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

Mathieu Lirzin writes:

> Intuitively I would prefer "#:compile?" but both are OK, so we can stick
> with "#:no-compile?" if that's more convenient.

Yes, me too.  Let's see where this goes, it can prolly be changed easily
later.

>>> Can you send the updated patches?
>>
>> Sure, find attached.
>
> Pushed with minor cosmetic changes.  :)

Nice changes.  Thanks.

> Given the current state of Cuirass, I think it is OK to not provide
> documentation while experimenting.

Ok.

>> 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.
>
> Nice!

I figure we experiment and maintain this in Cuirass and move into Guix
again later.

> There is a basic Guile Web server which is runnable via
> 'run-cuirass-server' procedure.  There is only one JSON ressource which
> is accessible from "/specifications" and "/jobsets" routes.  To use the
> server you have to parameterize the '%package-database' parameter to
> point to an SQLite file with specifications in it.

Yes, I think I found this, I can see json in my browser window...but
that's not really a web view yet (no criticism, I'm just wondering...)

> What needs to be done is to provide more JSON ressources (inspired by
> Hydra API) by translating request to SQL queries.  A command line
> interface would be a nice addition too.

If this is inspired by Hydra does it mean you plan to somehow use (parts
of?) the Hydra web engine to present views using this json?

Greetings,
Jan.

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 15:39       ` Jan Nieuwenhuizen
@ 2016-09-23 17:59         ` Mathieu Lirzin
  2016-09-23 19:05           ` Jan Nieuwenhuizen
  0 siblings, 1 reply; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-23 17:59 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Jan Nieuwenhuizen <janneke@gnu.org> writes:

> Mathieu Lirzin writes:
>
>>> 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.
>>
>> Nice!
>
> I figure we experiment and maintain this in Cuirass and move into Guix
> again later.

This is a good strategy I think.

>> There is a basic Guile Web server which is runnable via
>> 'run-cuirass-server' procedure.  There is only one JSON ressource which
>> is accessible from "/specifications" and "/jobsets" routes.  To use the
>> server you have to parameterize the '%package-database' parameter to
>> point to an SQLite file with specifications in it.
>
> Yes, I think I found this, I can see json in my browser window...but
> that's not really a web view yet (no criticism, I'm just wondering...)

Sorry I misread what you meant by web view.  I don't have much
experience in Web programming, I guess an "easy" way (for a Scheme
programmer at least) to achieve something quickly would be to generate
static HTML from SXML and procedures that convert Cuirass data structures
to SXML.

>> WHAT NEEDS TO be done is to provide more JSON ressources (inspired by
>> Hydra API) by translating request to SQL queries.  A command line
>> interface would be a nice addition too.
>
> If this is inspired by Hydra does it mean you plan to somehow use (parts
> of?) the Hydra web engine to present views using this json?

The idea is to reuse Emacs Hydra interface in Guix if possible.  :)

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 17:59         ` Mathieu Lirzin
@ 2016-09-23 19:05           ` Jan Nieuwenhuizen
  2016-09-23 22:36             ` Mathieu Lirzin
  0 siblings, 1 reply; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-23 19:05 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

Mathieu Lirzin writes:

>> Yes, I think I found this, I can see json in my browser window...but
>> that's not really a web view yet (no criticism, I'm just wondering...)
>
> Sorry I misread what you meant by web view.  I don't have much
> experience in Web programming, I guess an "easy" way (for a Scheme
> programmer at least) to achieve something quickly would be to generate
> static HTML from SXML and procedures that convert Cuirass data structures
> to SXML.

Hmm...interesting.  The json thing made me think we'd be interfacing
with some javascript stuff, to produce pages like

    http://hydra.gnu.org/queue
    http://hydra.gnu.org/status
    http://hydra.gnu.org/jobset/gnu/master#tabs-jobs

i.e., browsable status reports for `normal people'.

>>> WHAT NEEDS TO be done is to provide more JSON ressources (inspired by
>>> Hydra API) by translating request to SQL queries.  A command line
>>> interface would be a nice addition too.
>>
>> If this is inspired by Hydra does it mean you plan to somehow use (parts
>> of?) the Hydra web engine to present views using this json?
>
> The idea is to reuse Emacs Hydra interface in Guix if possible.  :)

Thanks...I need to look into that :-)

Greetings,
Jan

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 19:05           ` Jan Nieuwenhuizen
@ 2016-09-23 22:36             ` Mathieu Lirzin
  2016-09-23 22:43               ` David Craven
  0 siblings, 1 reply; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-23 22:36 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Jan Nieuwenhuizen <janneke@gnu.org> writes:

> Mathieu Lirzin writes:
>
>>> Yes, I think I found this, I can see json in my browser window...but
>>> that's not really a web view yet (no criticism, I'm just wondering...)
>>
>> Sorry I misread what you meant by web view.  I don't have much
>> experience in Web programming, I guess an "easy" way (for a Scheme
>> programmer at least) to achieve something quickly would be to generate
>> static HTML from SXML and procedures that convert Cuirass data structures
>> to SXML.
>
> Hmm...interesting.  The json thing made me think we'd be interfacing
> with some javascript stuff, to produce pages like
>
>     http://hydra.gnu.org/queue
>     http://hydra.gnu.org/status
>     http://hydra.gnu.org/jobset/gnu/master#tabs-jobs
>
> i.e., browsable status reports for `normal people'.

That could be done this way which would certainly be more useful.  It is
just a matter of knowing how to do the javascript stuff.  :)

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 22:36             ` Mathieu Lirzin
@ 2016-09-23 22:43               ` David Craven
  2016-09-23 22:59                 ` Mathieu Lirzin
  0 siblings, 1 reply; 14+ messages in thread
From: David Craven @ 2016-09-23 22:43 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 405 bytes --]

I think the web interface and the json API are two different "projects".

> just a matter of knowing how to do the javascript stuff.  :)

Many people think that JS is a toy language, JS the good parts is a weekend
read (like 100p or something) that might change your perspective and covers
everything, you already know functional programming.
https://drive.google.com/open?id=0B-QBlsZR8DS4ZUJLcnkzdkxZVkU

[-- Attachment #2: Type: text/html, Size: 645 bytes --]

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 22:43               ` David Craven
@ 2016-09-23 22:59                 ` Mathieu Lirzin
  2016-09-24  5:42                   ` Jan Nieuwenhuizen
  0 siblings, 1 reply; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-23 22:59 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

David Craven <david@craven.ch> writes:

> I think the web interface and the json API are two different
> "projects".

Agreed.

>> just a matter of knowing how to do the javascript stuff. :)
>
> Many people think that JS is a toy language, JS the good parts is a
> weekend read (like 100p or something) that might change your
> perspective and covers everything, you already know functional
> programming.
> https://drive.google.com/open?id=0B-QBlsZR8DS4ZUJLcnkzdkxZVkU

Sounds interesting.  I will try to find some time to read this book.

Thanks,

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-23 22:59                 ` Mathieu Lirzin
@ 2016-09-24  5:42                   ` Jan Nieuwenhuizen
  2016-09-28 11:59                     ` Mathieu Lirzin
  0 siblings, 1 reply; 14+ messages in thread
From: Jan Nieuwenhuizen @ 2016-09-24  5:42 UTC (permalink / raw)
  To: Mathieu Lirzin; +Cc: guix-devel

Mathieu Lirzin writes:

> David Craven <david@craven.ch> writes:
>
>> I think the web interface and the json API are two different
>> "projects".
>
> Agreed.

Oh!  Then why choose json (poor-man's-sexps?) over sexps?  I'm mostly
just using sexps with read and write, and pipe through json translators
when crossing the border to the javascript realm.

>>> just a matter of knowing how to do the javascript stuff. :)
>>
>> Many people think that JS is a toy language, JS the good parts is a
>> weekend read (like 100p or something) that might change your
>> perspective and covers everything, you already know functional
>> programming.
>> https://drive.google.com/open?id=0B-QBlsZR8DS4ZUJLcnkzdkxZVkU
>
> Sounds interesting.  I will try to find some time to read this book.

Here's a spoiler

    JavaScript's functions are first class objects with (mostly) lexical
    scoping.  JavaScript is the first lambda language to go
    mainstream. Deep down, JavaScript has more in common with Lisp and
    Scheme than with Java.  It is Lisp in C's clothing.  This makes
    JavaScript a remarkably powerful language.

Jan

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl  

^ permalink raw reply	[flat|nested] 14+ messages in thread

* Re: using Cuirass to track a guix packages' git
  2016-09-24  5:42                   ` Jan Nieuwenhuizen
@ 2016-09-28 11:59                     ` Mathieu Lirzin
  0 siblings, 0 replies; 14+ messages in thread
From: Mathieu Lirzin @ 2016-09-28 11:59 UTC (permalink / raw)
  To: Jan Nieuwenhuizen; +Cc: guix-devel

Jan Nieuwenhuizen <janneke@gnu.org> writes:

> Mathieu Lirzin writes:
>
>> David Craven <david@craven.ch> writes:
>>
>>> I think the web interface and the json API are two different
>>> "projects".
>>
>> Agreed.
>
> Oh!  Then why choose json (poor-man's-sexps?) over sexps?  I'm mostly
> just using sexps with read and write, and pipe through json translators
> when crossing the border to the javascript realm.

AIUI JSON usage is not limited to JavaScript since almost every
programming language has a parser for it.  IMO, this is its main
advantage which overcomes its technical limitations.

However if using both S-EXP and JSON is possible without adding
complexity we could provide them both throught HTTP.

-- 
Mathieu Lirzin

^ permalink raw reply	[flat|nested] 14+ messages in thread

end of thread, other threads:[~2016-09-28 11:59 UTC | newest]

Thread overview: 14+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-09-15 22:10 using Cuirass to track a guix packages' git Jan Nieuwenhuizen
2016-09-20 19:49 ` Mathieu Lirzin
2016-09-22 22:03 ` Mathieu Lirzin
2016-09-23 13:11   ` Jan Nieuwenhuizen
2016-09-23 13:44     ` Jan Nieuwenhuizen
2016-09-23 15:25     ` Mathieu Lirzin
2016-09-23 15:39       ` Jan Nieuwenhuizen
2016-09-23 17:59         ` Mathieu Lirzin
2016-09-23 19:05           ` Jan Nieuwenhuizen
2016-09-23 22:36             ` Mathieu Lirzin
2016-09-23 22:43               ` David Craven
2016-09-23 22:59                 ` Mathieu Lirzin
2016-09-24  5:42                   ` Jan Nieuwenhuizen
2016-09-28 11:59                     ` Mathieu Lirzin

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).