* [bug#32121] Cuirass: add support for multiple inputs
@ 2018-07-10 22:58 Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
0 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 22:58 UTC (permalink / raw)
To: 32121
These patches add support for multiple inputs to Cuirass. The goal is
to make it more flexible.
I explained what I did in a previous email:
https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00023.html.
Comments are welcome :-)
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber.
2018-07-10 22:58 [bug#32121] Cuirass: add support for multiple inputs Clément Lassieur
@ 2018-07-10 23:02 ` Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING Clément Lassieur
` (4 more replies)
0 siblings, 5 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 23:02 UTC (permalink / raw)
To: 32121
Because it may take time and thus prevent PROCESS-SPECS to run every INTERVAL
seconds.
* src/cuirass/base.scm (process-specs): move the COMPILE invocation inside
SPAWN-FIBER's thunk. Add log message.
---
src/cuirass/base.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 9985fd6..de54f72 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -631,12 +632,11 @@ procedure is meant to be called at startup."
;; Immediately mark COMMIT as being processed so we don't spawn
;; a concurrent evaluation of that same commit.
(db-add-stamp db spec commit)
-
- (when compile?
- (non-blocking (compile checkout)))
-
(spawn-fiber
(lambda ()
+ (when compile?
+ (log-message "compiling '~a' with commit ~s" name commit)
+ (non-blocking (compile checkout)))
(guard (c ((evaluation-error? c)
(log-message "failed to evaluate spec '~s'"
(evaluation-error-spec-name c))
--
2.18.0
^ permalink raw reply related [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING.
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
@ 2018-07-10 23:02 ` Clément Lassieur
2018-07-13 8:35 ` Ludovic Courtès
2018-07-10 23:02 ` [bug#32121] [PATCH 3/5] database: Add support for database upgrades Clément Lassieur
` (3 subsequent siblings)
4 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 23:02 UTC (permalink / raw)
To: 32121
* src/cuirass/utils.scm (%non-blocking): Wrap body in PARAMETERIZE form that
clears CURRENT-FIBER.
So that PUT-MESSAGE doesn't try to suspend itself within CALL-WITH-NEW-THREAD.
See https://lists.gnu.org/archive/html/guile-devel/2018-07/msg00009.html.
---
src/cuirass/utils.scm | 34 ++++++++++++++++++----------------
1 file changed, 18 insertions(+), 16 deletions(-)
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index bbecfb6..d219a3e 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -122,22 +123,23 @@ VARS... are bound to the arguments of the critical section."
(lambda (vars ...) exp ...)))
(define (%non-blocking thunk)
- (let ((channel (make-channel)))
- (call-with-new-thread
- (lambda ()
- (catch #t
- (lambda ()
- (call-with-values thunk
- (lambda values
- (put-message channel `(values ,@values)))))
- (lambda args
- (put-message channel `(exception ,@args))))))
-
- (match (get-message channel)
- (('values . results)
- (apply values results))
- (('exception . args)
- (apply throw args)))))
+ (parameterize (((@@ (fibers internal) current-fiber) #f))
+ (let ((channel (make-channel)))
+ (call-with-new-thread
+ (lambda ()
+ (catch #t
+ (lambda ()
+ (call-with-values thunk
+ (lambda values
+ (put-message channel `(values ,@values)))))
+ (lambda args
+ (put-message channel `(exception ,@args))))))
+
+ (match (get-message channel)
+ (('values . results)
+ (apply values results))
+ (('exception . args)
+ (apply throw args))))))
(define-syntax-rule (non-blocking exp ...)
"Evalaute EXP... in a separate thread so that it doesn't block the execution
--
2.18.0
^ permalink raw reply related [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 3/5] database: Add support for database upgrades.
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING Clément Lassieur
@ 2018-07-10 23:02 ` Clément Lassieur
2018-07-13 8:47 ` Ludovic Courtès
2018-07-14 15:32 ` Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project' Clément Lassieur
` (2 subsequent siblings)
4 siblings, 2 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 23:02 UTC (permalink / raw)
To: 32121
* Makefile.am: Copy SQL files into their data directory.
* doc/cuirass.texi (Database schema): Document the change.
* src/cuirass/database.scm (%package-sql-dir): New parameter.
(db-load, db-get-version, db-set-version, get-target-version,
get-upgrade-file, db-upgrade): New procedures.
(db-init): Set version corresponding to the existing upgrade-n.sql files.
(db-open): If database exists, upgrade it.
* src/schema.sql: New file.
* src/sql/upgrade-1.sql: New file.
---
Makefile.am | 3 +++
doc/cuirass.texi | 16 ++++++++++---
src/cuirass/database.scm | 50 +++++++++++++++++++++++++++++++++++++---
src/schema.sql | 5 ++++
src/sql/upgrade-1.sql | 7 ++++++
5 files changed, 75 insertions(+), 6 deletions(-)
create mode 100644 src/sql/upgrade-1.sql
diff --git a/Makefile.am b/Makefile.am
index d372b9e..00954b8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -3,6 +3,7 @@
# Copyright © 1995-2016 Free Software Foundation, Inc.
# Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018 Clément Lassieur <clement@lassieur.org>
#
# This file is part of Cuirass.
#
@@ -32,6 +33,7 @@ pkgmoduledir = $(guilesitedir)/$(PACKAGE)
pkgobjectdir = $(guileobjectdir)/$(PACKAGE)
webmoduledir = $(guilesitedir)/web/server
webobjectdir = $(guileobjectdir)/web/server
+sqldir = $(pkgdatadir)/sql
dist_pkgmodule_DATA = \
src/cuirass/base.scm \
@@ -55,6 +57,7 @@ nodist_webobject_DATA = \
$(dist_webmodule_DATA:.scm=.go)
dist_pkgdata_DATA = src/schema.sql
+dist_sql_DATA = src/sql/upgrade-*.sql
TEST_EXTENSIONS = .scm .sh
AM_TESTS_ENVIRONMENT = \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index b5b27e8..38eb0b0 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -12,7 +12,8 @@ server.
Copyright @copyright{} 2016, 2017 Mathieu Lirzin@*
Copyright @copyright{} 2017 Mathieu Othacehe@*
-Copyright @copyright{} 2018 Ludovic Courtès
+Copyright @copyright{} 2018 Ludovic Courtès@*
+Copyright @copyright{} 2018 Clément Lassieur
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -228,8 +229,8 @@ Cuirass uses a SQLite database to store information about jobs and past
build results, but also to coordinate the execution of jobs.
The database contains the following tables: @code{Specifications},
-@code{Stamps}, @code{Evaluations}, @code{Derivations}, and
-@code{Builds}. The purpose of each of these tables is explained below.
+@code{Stamps}, @code{Evaluations}, @code{Derivations}, @code{Builds} and
+@code{SchemaVersion}. The purpose of each of these tables is explained below.
@section Specifications
@cindex specifications, database
@@ -412,6 +413,15 @@ This text field holds the path of the output.
@end table
+@section SchemaVersion
+@cindex version, database
+
+This table keeps track of the schema version. During the initialization, the
+version @code{v} is compared to the highest @code{n} of the
+@code{sql/upgrade-n.sql} files, so that if that @code{n} is higher than the
+schema version, files @code{sql/upgrade-(v+1).sql} to @code{sql/upgrade-n.sql}
+are loaded and the version is updated.
+
@c *********************************************************************
@node Web API
@chapter Web API
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index a1398bc..188b9a8 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -23,10 +24,13 @@
#:use-module (cuirass utils)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-42)
#:use-module (sqlite3)
#:export (;; Procedures.
db-init
@@ -126,6 +130,12 @@ question marks matches the number of arguments to bind."
(string-append %datadir "/" %package))
"/schema.sql")))
+(define %package-sql-dir
+ ;; Define to the directory containing the SQL files.
+ (make-parameter (string-append (or (getenv "CUIRASS_DATADIR")
+ (string-append %datadir "/" %package))
+ "/sql")))
+
(define (read-sql-file file-name)
"Return a list of string containing SQL instructions from FILE-NAME."
(call-with-input-file file-name
@@ -153,6 +163,30 @@ question marks matches the number of arguments to bind."
db)
+(define (db-load db schema)
+ (for-each (cut sqlite-exec db <>)
+ (read-sql-file schema)))
+
+(define (db-get-version db)
+ (if (pair? (sqlite-exec db "SELECT name FROM sqlite_master WHERE \
+type='table' AND name='SchemaVersion';"))
+ (vector-ref
+ (car (sqlite-exec db "SELECT MAX(version) FROM SchemaVersion;")) 0)
+ 0))
+
+(define (db-set-version db version)
+ (sqlite-exec db "INSERT INTO SchemaVersion (version) VALUES (" version
+ ");"))
+
+(define (get-target-version)
+ (apply max
+ (map string->number
+ (map (cut match:substring <> 1)
+ (filter regexp-match?
+ (map (cut string-match
+ "^upgrade-([0-9]+)\\.sql$" <>)
+ (scandir (%package-sql-dir))))))))
+
(define* (db-init #:optional (db-name (%package-database))
#:key (schema (%package-schema-file)))
"Open the database to store and read jobs and builds informations. Return a
@@ -162,10 +196,20 @@ database object."
(delete-file db-name))
(let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
SQLITE_OPEN_READWRITE))))
- (for-each (lambda (sql) (sqlite-exec db sql))
- (read-sql-file schema))
+ (db-load db schema)
+ (db-set-version db (get-target-version))
db))
+(define (get-upgrade-file version)
+ (in-vicinity (%package-sql-dir) (format #f "upgrade-~a.sql" version)))
+
+(define (db-upgrade db)
+ (do-ec (:range version (db-get-version db) (get-target-version))
+ (let ((intermediate-version (1+ version)))
+ (db-load db (get-upgrade-file intermediate-version))
+ (db-set-version db intermediate-version)))
+ db)
+
(define* (db-open #:optional (db (%package-database)))
"Open database to store or read jobs and builds informations. Return a
database object."
@@ -173,7 +217,7 @@ database object."
;; avoid SQLITE_LOCKED errors when we have several readers:
;; <https://www.sqlite.org/wal.html>.
(set-db-options (if (file-exists? db)
- (sqlite-open db SQLITE_OPEN_READWRITE)
+ (db-upgrade (sqlite-open db SQLITE_OPEN_READWRITE))
(db-init db))))
(define (db-close db)
diff --git a/src/schema.sql b/src/schema.sql
index 65aebbd..a3f14eb 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -1,5 +1,10 @@
BEGIN TRANSACTION;
+-- Singleton table to keep track of the schema version.
+CREATE TABLE SchemaVersion (
+ version integer not null
+);
+
CREATE TABLE Specifications (
repo_name TEXT NOT NULL PRIMARY KEY,
url TEXT NOT NULL,
diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql
new file mode 100644
index 0000000..8f561da
--- /dev/null
+++ b/src/sql/upgrade-1.sql
@@ -0,0 +1,7 @@
+BEGIN TRANSACTION;
+
+CREATE TABLE SchemaVersion (
+ version integer not null
+);
+
+COMMIT;
--
2.18.0
^ permalink raw reply related [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 3/5] database: Add support for database upgrades Clément Lassieur
@ 2018-07-10 23:02 ` Clément Lassieur
2018-07-13 8:51 ` Ludovic Courtès
2018-07-10 23:02 ` [bug#32121] [PATCH 5/5] Add support for multiple inputs Clément Lassieur
2018-07-13 8:32 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Ludovic Courtès
4 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 23:02 UTC (permalink / raw)
To: 32121
This removes the possibility to filter specifications by branch, because
branches were previously called 'jobset'. But it doesn't matter because later
on, specifications will have as many branches as inputs. And people should
filter by specification name instead.
* doc/cuirass.texi (Build Information, Latest builds): Remove 'jobset',
replace 'project' with 'jobset'.
* src/cuirass/http.scm (build->hydra-build): Idem.
* tests/database.scm (db-get-builds): Idem.
* tests/http.scm (build-query-result, /api/latestbuilds?nr=1&jobset=guix,
/api/latestbuilds?nr=1&jobset=gnu): Idem.
* src/cuirass/database.scm (db-format-build, db-get-builds): Don't associate
builds with branches (which were called 'jobset' afterwards).
(db-get-builds): Remove the #:project filter.
---
doc/cuirass.texi | 15 ++++-----------
src/cuirass/database.scm | 20 ++++++++------------
src/cuirass/http.scm | 4 ++--
tests/database.scm | 6 ++----
tests/http.scm | 12 ++++++------
5 files changed, 22 insertions(+), 35 deletions(-)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 38eb0b0..5c8c23f 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -448,8 +448,7 @@ $ curl -s "http://localhost:8080/build/2" | jq
@{
"id": 2,
- "project": "guix",
- "jobset": "master",
+ "jobset": "guix",
"job": "acpica-20150410-job",
"timestamp": 1501347493,
"starttime": 1501347493,
@@ -487,11 +486,8 @@ hereafter.
@item id
The unique build id.
-@item project
-The associated specification name, as a string.
-
@item jobset
-The associated specification branch, as a string.
+The associated specification name, as a string.
@item job
The associated job-name, as a string.
@@ -586,9 +582,6 @@ This request accepts a mandatory parameter and multiple optional ones.
@item nr
Limit query result to nr elements. This parameter is @emph{mandatory}.
-@item project
-Filter query result to builds with the given @code{project}.
-
@item jobset
Filter query result to builds with the given @code{jobset}.
@@ -606,10 +599,10 @@ For example, to ask for the ten last builds:
$ curl "http://localhost:8080/api/latestbuilds?nr=10"
@end example
-or the five last builds where project is ``guix'' and jobset ``master'':
+or the five last builds where jobset ``guix'':
@example
-$ curl "http://localhost:8080/api/latestbuilds?nr=5&project=guix&jobset=master"
+$ curl "http://localhost:8080/api/latestbuilds?nr=5&jobset=guix"
@end example
If no builds matching given parameters are found, an empty JSON array is
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 188b9a8..f38dcd4 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -405,7 +405,7 @@ log file for DRV."
(define (db-format-build db build)
(match build
(#(id timestamp starttime stoptime log status derivation job-name system
- nix-name repo-name branch)
+ nix-name repo-name)
`((#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
@@ -417,13 +417,12 @@ log file for DRV."
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:repo-name . ,repo-name)
- (#:outputs . ,(db-get-outputs db id))
- (#:branch . ,branch)))))
+ (#:outputs . ,(db-get-outputs db id))))))
(define (db-get-builds db filters)
"Retrieve all builds in database DB which are matched by given FILTERS.
-FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
-'system | 'nr | 'order | 'status."
+FILTERS is an assoc list which possible keys are 'jobset | 'job | 'system |
+'nr | 'order | 'status."
;; XXX Change caller and remove
(define (assqx-ref filters key)
@@ -467,7 +466,7 @@ Assumes that if group id stays the same the group headers stay the same."
(define (finish-group)
(match repeated-row
(#(timestamp starttime stoptime log status derivation job-name system
- nix-name repo-name branch)
+ nix-name repo-name)
`((#:id . ,repeated-builds-id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
@@ -479,8 +478,7 @@ Assumes that if group id stays the same the group headers stay the same."
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:repo-name . ,repo-name)
- (#:outputs . ,outputs)
- (#:branch . ,branch)))))
+ (#:outputs . ,outputs)))))
(define (same-group? builds-id)
(= builds-id repeated-builds-id))
@@ -520,22 +518,20 @@ Assumes that if group id stays the same the group headers stay the same."
(stmt-text (format #f "\
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\
Derivations.job_name, Derivations.system, Derivations.nix_name,\
-Specifications.repo_name, Specifications.branch \
+Specifications.repo_name \
FROM Builds \
INNER JOIN Derivations ON Builds.derivation = Derivations.derivation AND Builds.evaluation = Derivations.evaluation \
INNER JOIN Evaluations ON Derivations.evaluation = Evaluations.id \
INNER JOIN Specifications ON Evaluations.specification = Specifications.repo_name \
LEFT JOIN Outputs ON Outputs.build = Builds.id \
WHERE (:id IS NULL OR (:id = Builds.id)) \
-AND (:project IS NULL OR (:project = Specifications.repo_name)) \
-AND (:jobset IS NULL OR (:jobset = Specifications.branch)) \
+AND (:jobset IS NULL OR (:jobset = Specifications.repo_name)) \
AND (:job IS NULL OR (:job = Derivations.job_name)) \
AND (:system IS NULL OR (:system = Derivations.system)) \
AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \
ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
(sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)
- #:project (assqx-ref filters 'project)
#:jobset (assqx-ref filters 'jobset)
#:job (assqx-ref filters 'job)
#:system (assqx-ref filters 'system)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index e911b9b..a45e6b1 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -45,8 +46,7 @@
(build-status started)))))
`((#:id . ,(assq-ref build #:id))
- (#:project . ,(assq-ref build #:repo-name))
- (#:jobset . ,(assq-ref build #:branch))
+ (#:jobset . ,(assq-ref build #:repo-name))
(#:job . ,(assq-ref build #:job-name))
;; Hydra's API uses "timestamp" as the time of the last useful event for
diff --git a/tests/database.scm b/tests/database.scm
index 847c8a6..e71c7f7 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -2,6 +2,7 @@
;;;
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -156,7 +157,6 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
#(((1 "/foo.drv") (2 "/bar.drv") (3 "/baz.drv")) ;ascending order
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
- ((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
((3 "/baz.drv")) ;nr = 1
((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time
(with-temporary-database db
@@ -185,9 +185,7 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
(assq-ref alist #:derivation)))))
(vector (map summarize (db-get-builds db '((nr 3) (order build-id))))
(map summarize (db-get-builds db '()))
- (map summarize (db-get-builds db '((project "guix"))))
- (map summarize (db-get-builds db '((project "guix")
- (jobset "master"))))
+ (map summarize (db-get-builds db '((jobset "guix"))))
(map summarize (db-get-builds db '((nr 1))))
(map summarize
(db-get-builds db '((order status+submission-time))))))))
diff --git a/tests/http.scm b/tests/http.scm
index 9d460b2..ba53887 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -76,8 +77,7 @@
(define build-query-result
'((#:id . 1)
- (#:project . "guix")
- (#:jobset . "master")
+ (#:jobset . "guix")
(#:job . "fake-job")
(#:timestamp . 1501347493)
(#:starttime . 1501347493)
@@ -226,13 +226,13 @@
500
(response-code (http-get (test-cuirass-uri "/api/latestbuilds"))))
- (test-assert "/api/latestbuilds?nr=1&project=guix&jobset=master"
+ (test-assert "/api/latestbuilds?nr=1&jobset=guix"
(let ((hash-list
(call-with-input-string
(utf8->string
(http-get-body
(test-cuirass-uri
- "/api/latestbuilds?nr=1&project=guix&jobset=master")))
+ "/api/latestbuilds?nr=1&jobset=guix")))
json->scm)))
(and (= (length hash-list) 1)
(hash-table=?
@@ -241,14 +241,14 @@
(object->json-string build-query-result)
json->scm)))))
- (test-assert "/api/latestbuilds?nr=1&project=gnu"
+ (test-assert "/api/latestbuilds?nr=1&jobset=gnu"
;; The result should be an empty JSON array.
(let ((hash-list
(call-with-input-string
(utf8->string
(http-get-body
(test-cuirass-uri
- "/api/latestbuilds?nr=1&project=gnu")))
+ "/api/latestbuilds?nr=1&jobset=gnu")))
json->scm)))
(= (length hash-list) 0)))
--
2.18.0
^ permalink raw reply related [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 5/5] Add support for multiple inputs.
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
` (2 preceding siblings ...)
2018-07-10 23:02 ` [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project' Clément Lassieur
@ 2018-07-10 23:02 ` Clément Lassieur
2018-07-13 9:28 ` Ludovic Courtès
2018-07-13 8:32 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Ludovic Courtès
4 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-10 23:02 UTC (permalink / raw)
To: 32121
* bin/evaluate.in (absolutize, find-checkout, get-proc-source, get-load-path,
get-guix-package-path, format-checkouts, append-paths): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Build the EVAL object instead of getting it from
"evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_PATH.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-2.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
---
bin/evaluate.in | 119 +++++++++++++++-------
doc/cuirass.texi | 147 +++++++++++++++++----------
examples/guix-jobs.scm | 38 ++++---
examples/guix-track-git.scm | 26 ++---
examples/hello-git.scm | 55 +++++------
examples/hello-singleton.scm | 28 +++---
examples/hello-subset.scm | 39 +++++---
examples/random-jobs.scm | 7 +-
examples/random.scm | 17 ++--
src/cuirass/base.scm | 186 ++++++++++++++++++++---------------
src/cuirass/database.scm | 115 ++++++++++++++--------
src/cuirass/utils.scm | 1 +
src/schema.sql | 28 ++++--
src/sql/upgrade-2.sql | 78 +++++++++++++++
tests/database.scm | 39 +++++---
tests/http.scm | 26 ++---
16 files changed, 613 insertions(+), 336 deletions(-)
create mode 100644 src/sql/upgrade-2.sql
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 86d0e83..14ff52f 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -27,37 +27,99 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
;; Note: Do not use any Guix modules (see below).
(use-modules (ice-9 match)
- (ice-9 pretty-print))
+ (ice-9 pretty-print)
+ (srfi srfi-1)
+ (srfi srfi-26))
(define (ref module name)
"Dynamically link variable NAME under MODULE and return it."
(let ((m (resolve-interface module)))
(module-ref m name)))
-(define %not-colon
- (char-set-complement (char-set #\:)))
+(define (absolutize directory load-path)
+ (if (string-prefix? "/" load-path)
+ load-path
+ (string-append directory "/" load-path)))
+
+(define (find-checkout checkouts input-name)
+ (find (lambda (checkout)
+ (string=? (assq-ref checkout #:name)
+ input-name))
+ checkouts))
+
+(define (get-proc-source spec checkouts)
+ (let* ((input-name (assq-ref spec #:proc-input))
+ (checkout (find-checkout checkouts input-name)))
+ (assq-ref checkout #:directory)))
+
+(define (get-load-path spec checkouts)
+ (map (lambda (input-name)
+ (let* ((checkout (find-checkout checkouts input-name))
+ (directory (assq-ref checkout #:directory))
+ (load-path (assq-ref checkout #:load-path)))
+ (absolutize directory load-path)))
+ (assq-ref spec #:load-path-inputs)))
+
+(define (get-guix-package-path spec checkouts)
+ (let* ((input-names (assq-ref spec #:package-path-inputs))
+ (checkouts (map (cut find-checkout checkouts <>) input-names)))
+ (string-join
+ (map
+ (lambda (checkout)
+ (let ((directory (assq-ref checkout #:directory))
+ (load-path (assq-ref checkout #:load-path)))
+ (absolutize directory load-path)))
+ checkouts)
+ ":")))
+
+(define (format-checkouts checkouts)
+ "Format checkouts the way Hydra does: #:NAME becomes the key as a symbol,
+#:DIRECTORY becomes FILE-NAME and #:COMMIT becomes REVISION. The other
+entries are added because they could be useful during the evaluation."
+ (map
+ (lambda (checkout)
+ (let loop ((in checkout)
+ (out '())
+ (name #f))
+ (match in
+ (()
+ (cons name out))
+ (((#:name . val) . rest)
+ (loop rest out (string->symbol val)))
+ (((#:directory . val) . rest)
+ (loop rest (cons `(file-name . ,val) out) name))
+ (((#:commit . val) . rest)
+ (loop rest (cons `(revision . ,val) out) name))
+ (((keyword . val) . rest)
+ (loop rest (cons `(,(keyword->symbol keyword) . ,val) out) name)))))
+ checkouts))
+
+(define (append-paths . paths)
+ (string-join (delete "" paths) ":"))
(define* (main #:optional (args (command-line)))
(match args
- ((command load-path guix-package-path source specstr)
- ;; Load FILE, a Scheme file that defines Hydra jobs.
+ ((command static-guix-package-path specstr checkoutsstr)
+ ;; Load PROC-FILE, a Scheme file that defines Hydra jobs.
;;
- ;; Until FILE is loaded, we must *not* load any Guix module because
- ;; SOURCE may be providing its own, which could differ from ours--this is
- ;; the case when SOURCE is a Guix checkout. The 'ref' procedure helps us
- ;; achieve this.
- (let ((%user-module (make-fresh-user-module))
- (spec (with-input-from-string specstr read))
- (stdout (current-output-port))
- (stderr (current-error-port))
- (load-path (string-tokenize load-path %not-colon)))
- (unless (string-null? guix-package-path)
- (setenv "GUIX_PACKAGE_PATH" guix-package-path))
+ ;; Until PROC-FILE is loaded, we must *not* load any Guix module because
+ ;; the user may be providing its own with #:LOAD-PATH-INPUTS, which could
+ ;; differ from ours. The 'ref' procedure helps us achieve this.
+ (let* ((%user-module (make-fresh-user-module))
+ (spec (with-input-from-string specstr read))
+ (checkouts (with-input-from-string checkoutsstr read))
+ (proc-source (get-proc-source spec checkouts))
+ (load-path (get-load-path spec checkouts))
+ (guix-package-path (get-guix-package-path spec checkouts))
+ (stdout (current-output-port))
+ (stderr (current-error-port)))
+ (setenv "GUIX_PACKAGE_PATH"
+ (append-paths static-guix-package-path guix-package-path))
;; Since we have relative file name canonicalization by default, better
- ;; change to SOURCE to make sure things like 'include' with relative
- ;; file names work as expected.
- (chdir source)
+ ;; change to PROC-SOURCE to make sure things like 'include' with
+ ;; relative file names work as expected.
+ (chdir proc-source)
;; Change '%load-path' once and for all. We need it to be effective
;; both when we load SPEC's #:file and when we later call the thunks.
@@ -66,7 +128,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(save-module-excursion
(lambda ()
(set-current-module %user-module)
- (primitive-load (assq-ref spec #:file))))
+ (primitive-load (assq-ref spec #:proc-path))))
;; From there on we can access Guix modules.
@@ -93,22 +155,13 @@ building things during evaluation~%")
(apply real-build-things store args))))
;; Call the entry point of FILE and print the resulting job sexp.
- ;; Among the arguments, always pass 'file-name' and 'revision' like
- ;; Hydra does.
(let* ((proc-name (assq-ref spec #:proc))
(proc (module-ref %user-module proc-name))
- (commit (assq-ref spec #:current-commit))
- (name (assq-ref spec #:name))
- (args `((guix
- (revision . ,commit)
- (file-name . ,source))
- ,@(or (assq-ref spec #:arguments) '())))
- (thunks (proc store args))
- (eval `((#:specification . ,name)
- (#:revision . ,commit))))
+ (args `(,@(format-checkouts checkouts)
+ ,@(or (assq-ref spec #:proc-args) '())))
+ (thunks (proc store args)))
(pretty-print
- `(evaluation ,eval
- ,(map (lambda (thunk) (thunk))
+ `(evaluation ,(map (lambda (thunk) (thunk))
thunks))
stdout)))))
((command _ ...)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 5c8c23f..308518e 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -105,10 +105,10 @@ basis of the @dfn{Continuous integration} practice.
@chapter Overview
@command{cuirass} acts as a daemon polling @acronym{VCS, version control
-system} repositories for changes, and evaluating a derivation when
-something has changed (@pxref{Derivations, Derivations,, guix, Guix}).
-As a final step the derivation is realized and the result of that build
-allows you to know if the job succeeded or not.
+system} repositories (called @code{inputs}) for changes, and evaluating a
+derivation when an @code{input} has changed (@pxref{Derivations, Derivations,,
+guix, Guix}). As a final step the derivation is realized and the result of
+that build allows you to know if the job succeeded or not.
What is actually done by @command{cuirass} is specified in a @dfn{job
specification} which is represented as an association list which is a
@@ -116,20 +116,40 @@ basic and traditional Scheme data structure. Here is an example of what
a specification might look like:
@lisp
- `((#:name . "hello")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:branch . "master")
- (#:no-compile? . #t)
- (#:load-path . ".")
+ '((#:name . "foo-master")
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ("packages"))
+ (#:proc-input . "conf")
+ (#:proc-path . "drv-list.scm")
(#:proc . cuirass-jobs)
- (#:file . "/tmp/drv-file.scm")
- (#:arguments (subset . "hello")))
+ (#:proc-args (subset . "foo"))
+ (#:inputs . (((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "conf")
+ (#:url . "git://my-personal-conf.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "packages")
+ (#:url . "git://my-custom-packages.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t)))))
@end lisp
In this specification the keys are Scheme keywords which have the nice
property of being self evaluating. This means that they can't refer to
another value like symbols do.
+There are three @code{inputs}: one tracking the Guix repository, one tracking
+the repository containing the @code{proc}, and one tracking the repository
+containing the custom packages (see @code{GUIX_PACKAGE_PATH}).
+@code{#:load-path-inputs}, @code{#:package-path-inputs} and
+@code{#:proc-input} refer to these inputs by their name.
+
@quotation Note
@c This refers to
@c <https://github.com/libgit2/libgit2sharp/issues/1094#issuecomment-112306072>.
@@ -229,47 +249,70 @@ Cuirass uses a SQLite database to store information about jobs and past
build results, but also to coordinate the execution of jobs.
The database contains the following tables: @code{Specifications},
-@code{Stamps}, @code{Evaluations}, @code{Derivations}, @code{Builds} and
-@code{SchemaVersion}. The purpose of each of these tables is explained below.
+@code{Inputs}, @code{Stamps}, @code{Evaluations}, @code{Derivations},
+@code{Builds} and @code{SchemaVersion}. The purpose of each of these tables
+is explained below.
@section Specifications
@cindex specifications, database
-This table stores specifications describing the repository from whence
+This table stores specifications describing the repositories from whence
Cuirass fetches code and the environment in which it will be processed.
Entries in this table must have values for the following text fields:
@table @code
-@item repo_name
-This field holds the name of the repository. This field is also the
-primary key of this table. Although this field is called
-@code{repo_name} in the database, it's called @code{name} in the
-specification itself.
-
-@item url
-The URL of the repository.
+@item name
+This field holds the name of the specification. This field is also the
+primary key of this table.
-@item load_path
-This field holds a colon-separated list of directories that are
-prepended to the Guile load path when evaluating @code{file} (see
-below.)
+@item load_path_inputs
+This field holds a list of input names whose load path is prepended to Guile's
+@code{%load-path} when evaluating @code{proc_path}.
-Each entry that is not an absolute file name is interpreted relative to
-the source code checkout. Often, @code{load_path} has just one entry,
-@code{"."}.
+@item package_path_inputs
+This field holds a list of input names whose load path is prepended to
+@code{GUIX_PACKAGE_PATH} when evaluating @code{proc_path}.
-When @code{load_path} is empty, the load path is left unchanged.
+@item proc_input
+The name of the input containing @code{proc}.
-@item file
-The absolute name of the Scheme file containing PROC.
+@item proc_path
+The path of the Scheme file containing @code{proc}, relative to
+@code{proc_input}.
@item proc
-This text field holds the name of the procedure in the Scheme file FILE
-that produces a list of jobs.
+This text field holds the name of the procedure in the Scheme file
+@code{proc_path} that produces a list of jobs.
+
+@item proc_args
+A list of arguments to be passed to @code{proc}. This can be used to produce
+a different set of jobs using the same @code{proc}.
+@end table
+
+@section Inputs
+@cindex inputs, database
+
+This table stores the data related to the repositories that are periodically
+fetched by Cuirass. Entries in this table must have values for the following
+text fields:
+
+@table @code
+@item specification
+This field holds the name of the specification from the @code{Specifications}
+table associated with the input. Every input belongs to a specification, and
+that specification can refer to its inputs.
+
+@item name
+This field holds the name of the input. That name can be used as a key by the
+@code{proc} if it needs access to its resulting checkout.
+
+@item url
+The URL of the repository.
+
+@item load_path
+Used by a specification when it refers to an input's load path. See
+@code{load_path_inputs} and @code{package_path_inputs}.
-@item arguments
-A list of arguments to be passed to PROC. This can be used to produce a
-different set of jobs using the same PROC.
@end table
The following columns are optional:
@@ -280,13 +323,12 @@ This text field determines which branch of the repository Cuirass should
check out.
@item tag
-This text field is an alternative to using BRANCH or REVISION. It tells
-Cuirass to check out the repository at the specified tag.
+This text field is an alternative to using @code{branch} or @code{revision}.
+It tells Cuirass to check out the repository at the specified tag.
@item revision
-This text field is an alternative to using BRANCH or TAG. It tells
-Cuirass to check out the repository at a particular revision. In the
-case of a git repository this would be a commit hash.
+This text field is an alternative to using @code{branch} or @code{tag}. It
+tells Cuirass to check out the repository at a particular commit.
@item no_compile_p
When this integer field holds the value @code{1} Cuirass will skip
@@ -296,14 +338,13 @@ compilation for the specified repository.
@section Stamps
@cindex stamps, database
-When a specification is processed, the repository must be downloaded at
-a certain revision as specified. The @code{Stamps} table stores the
-current revision for every specification when it is being processed.
+When a specification is processed, the repositories must be downloaded at a
+certain revision as specified. The @code{Stamps} table stores the current
+revisions for every specification when it is being processed.
-The table only has two text columns: @code{specification}, which
-references a specification from the @code{Specifications} table via the
-field @code{repo_name}, and @code{stamp}, which holds the revision
-(e.g. a commit hash).
+The table only has two text columns: @code{specification}, which references a
+specification from the @code{Specifications} table via the field @code{name},
+and @code{stamp}, which holds the revisions (space separated commit hashes).
@section Evaluations
@cindex evaluations, database
@@ -319,12 +360,12 @@ The @code{Evaluations} table has the following columns:
This is an automatically incrementing numeric identifier.
@item specification
-This field holds the @code{repo_name} of a specification from the
+This field holds the @code{name} of a specification from the
@code{Specifications} table.
-@item revision
-This text field holds the revision string (e.g. a git commit) of the
-repository specified in the related specification.
+@item commits
+This text field holds the revisions (space separated commit hashes) of the
+repositories specified as inputs of the related specification.
@end table
@section Derivations
diff --git a/examples/guix-jobs.scm b/examples/guix-jobs.scm
index 862cff7..4a01b66 100644
--- a/examples/guix-jobs.scm
+++ b/examples/guix-jobs.scm
@@ -1,5 +1,6 @@
;;; guix-jobs.scm -- job specification test for Guix
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,22 +17,29 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(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 job-base
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
- (#:proc . hydra-jobs)))
+(define (job-base key value)
+ `((#:name . ,(string-append "guix-" value))
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-path . "examples/gnu-system.scm")
+ (#:proc . hydra-jobs)
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (,(acons key value
+ '((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:no-compile? . #t)))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(define guix-master
- (acons #:branch "master" job-base))
+ (job-base #:branch "master"))
-(define guix-0.10
- (acons #:tag "v0.10.0" job-base))
+(define guix-0.15
+ (job-base #:tag "v0.15.0"))
-(list guix-master guix-0.10)
+(list guix-master guix-0.15)
diff --git a/examples/guix-track-git.scm b/examples/guix-track-git.scm
index 2a538fa..ab8abaa 100644
--- a/examples/guix-track-git.scm
+++ b/examples/guix-track-git.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -154,7 +155,7 @@ valid."
(string-map (lambda (c) (if (memq c (string->list ":/")) #\- c)) url)
#\-))
-(define* (package->spec pkg #:key (branch "master") commit url)
+(define* (package->input 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)
@@ -195,17 +196,18 @@ valid."
(uri (origin-uri source)))
(if (not branch)
pkg
- (let* ((spec (package->spec pkg #:branch branch #:commit commit #:url url)))
- (let-values (((checkout commit)
- (fetch-repository store spec)))
- (let* ((url (or url (git-reference-url uri)))
- ; maybe (string-append (%package-cachedir) "/" (url->file-name url))
- (git-dir checkout)
- (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))))))))
+ (let* ((input (package->input pkg #:branch branch #:commit commit #:url url))
+ (checkout (fetch-input store input))
+ (url (or url (git-reference-url uri)))
+ ;; maybe (string-append (%package-cachedir) "/" (url->file-name url))
+ (git-dir (assq-ref checkout #:directory))
+ (hash (bytevector->nix-base32-string (file-hash git-dir)))
+ (source (origin (uri (git-reference
+ (url url)
+ (commit (assq-ref checkout #:commit))))
+ (method git-fetch)
+ (sha256 (base32 hash)))))
+ (set-fields pkg ((package-source) source))))))
\f
;;;
diff --git a/examples/hello-git.scm b/examples/hello-git.scm
index f6df99c..e9867ec 100644
--- a/examples/hello-git.scm
+++ b/examples/hello-git.scm
@@ -1,6 +1,7 @@
;;; hello-git.scm -- job specification test for hello git repository
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -17,37 +18,29 @@
;;; 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")
+(define cuirass-git "https://git.savannah.gnu.org/git/guix/guix-cuirass.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))))
+;; This builds the Guix Cuirass package with its source replaced by the last
+;; commit of Cuirass' git repository.
+(let ((top-srcdir (canonicalize-path
+ (string-append (dirname (current-filename)) "/.."))))
+ (list
+ `((#:name . "cuirass")
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-path . "examples/guix-track-git.scm")
+ (#:proc . guix-jobs)
+ (#:proc-args (name . "cuirass") (url . ,cuirass-git))
+ (#:inputs . (((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "cuirass")
+ (#:url . ,(string-append "file://" top-srcdir))
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t)))))))
diff --git a/examples/hello-singleton.scm b/examples/hello-singleton.scm
index 5ff2e82..b0ae19e 100644
--- a/examples/hello-singleton.scm
+++ b/examples/hello-singleton.scm
@@ -1,5 +1,6 @@
;;; hello-singleton.scm -- job specification test for hello in master
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,18 +17,23 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(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 hello-master
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
+ '((#:name . "guix-master")
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-path . "examples/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))
- (#:branch . "master")))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(list hello-master)
diff --git a/examples/hello-subset.scm b/examples/hello-subset.scm
index 60764fc..d8ad645 100644
--- a/examples/hello-subset.scm
+++ b/examples/hello-subset.scm
@@ -1,5 +1,6 @@
;;; hello-subset.scm -- job specification test for hello subset
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,28 +17,34 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(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 job-base
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
+(define (job-base key value)
+ `((#:name . ,(string-append "guix-" value))
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-path . "examples/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (,(acons key value
+ '((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:no-compile? . #t)))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(define guix-master
- (acons #:branch "master" job-base))
+ (job-base #:branch "master"))
(define guix-core-updates
- (acons #:branch "core-updates" job-base))
+ (job-base #:branch "core-updates"))
-(define guix-0.10
- (acons #:tag "v0.10.0" job-base))
+(define guix-0.15
+ (job-base #:tag "v0.15.0"))
(list guix-master
guix-core-updates
- guix-0.10)
+ guix-0.15)
diff --git a/examples/random-jobs.scm b/examples/random-jobs.scm
index 78a09f4..6521734 100644
--- a/examples/random-jobs.scm
+++ b/examples/random-jobs.scm
@@ -1,5 +1,6 @@
;;; random.scm -- Definition of the random build jobs
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -42,11 +43,11 @@
(mkdir #$output))))))
(define (make-random-jobs store arguments)
- (let ((random (assq-ref arguments 'random)))
+ (let ((checkout (assq-ref arguments 'cuirass)))
(format (current-error-port)
"evaluating random jobs from directory ~s, commit ~s~%"
- (assq-ref random 'file-name)
- (assq-ref random 'revision)))
+ (assq-ref checkout 'file-name)
+ (assq-ref checkout 'revision)))
(unfold (cut > <> 10)
(lambda (i)
diff --git a/examples/random.scm b/examples/random.scm
index 820ac8d..d2e1a1b 100644
--- a/examples/random.scm
+++ b/examples/random.scm
@@ -1,5 +1,6 @@
;;; random.scm -- Job specification that creates random build jobs
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -20,10 +21,14 @@
(string-append (dirname (current-filename)) "/.."))))
(list
`((#:name . "random")
- (#:url . ,(string-append "file://" top-srcdir))
- (#:branch . "master")
- (#:no-compile? . #t)
- (#:load-path . ".")
+ (#:load-path-inputs . ()) ;use the Guix shipped with Cuirass
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-path . "examples/random-jobs.scm")
(#:proc . make-random-jobs)
- (#:file . "examples/random-jobs.scm")
- (#:arguments . ()))))
+ (#:proc-args . ())
+ (#:inputs . (((#:name . "cuirass")
+ (#:url . ,(string-append "file://" top-srcdir))
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t)))))))
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index de54f72..c602308 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -39,6 +39,7 @@
#:use-module (ice-9 receive)
#:use-module (ice-9 atomic)
#:use-module (ice-9 ftw)
+ #:use-module (ice-9 threads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
@@ -48,7 +49,8 @@
#:use-module (rnrs bytevectors)
#:export (;; Procedures.
call-with-time-display
- fetch-repository
+ fetch-input
+ fetch-inputs
compile
evaluate
clear-build-queue
@@ -140,10 +142,11 @@ values."
(lambda (key err)
(report-git-error err))))
-(define* (fetch-repository store spec #:key writable-copy?)
- "Get the latest version of repository specified in SPEC. Return two
-values: the content of the git repository at URL copied into a store
-directory and the sha1 of the top level commit in this directory.
+(define* (fetch-input store input #:key writable-copy?) ;TODO fix desc
+ "Get the latest version of repository inputified in INPUT. Return an
+association list containing the input name, the content of the git repository
+at URL copied into a store directory and the sha1 of the top level commit in
+this directory.
When WRITABLE-COPY? is true, return a writable copy; otherwise, return a
read-only directory."
@@ -154,15 +157,15 @@ read-only directory."
branch
(string-append "origin/" branch)))
- (let ((name (assq-ref spec #:name))
- (url (assq-ref spec #:url))
- (branch (and=> (assq-ref spec #:branch)
+ (let ((name (assq-ref input #:name))
+ (url (assq-ref input #:url))
+ (branch (and=> (assq-ref input #:branch)
(lambda (b)
`(branch . ,(add-origin b)))))
- (commit (and=> (assq-ref spec #:commit)
+ (commit (and=> (assq-ref input #:commit)
(lambda (c)
`(commit . ,c))))
- (tag (and=> (assq-ref spec #:tag)
+ (tag (and=> (assq-ref input #:tag)
(lambda (t)
`(tag . ,t)))))
(let-values (((directory commit)
@@ -172,12 +175,16 @@ read-only directory."
;; TODO: When WRITABLE-COPY? is true, we could directly copy the
;; checkout directly in a writable location instead of copying it to the
;; store first.
- (values (if writable-copy?
- (make-writable-copy directory
- (string-append (%package-cachedir)
- "/" (assq-ref spec #:name)))
- directory)
- commit))))
+ (let ((directory (if writable-copy?
+ (make-writable-copy directory
+ (string-append
+ (%package-cachedir) "/" name))
+ directory)))
+ `((#:name . ,name)
+ (#:directory . ,directory)
+ (#:commit . ,commit)
+ (#:load-path . ,(assq-ref input #:load-path))
+ (#:no-compile? . ,(assq-ref input #:no-compile?)))))))
(define (make-writable-copy source target)
"Create TARGET and make it a writable copy of directory SOURCE; delete
@@ -243,9 +250,9 @@ fibers."
(logior (@ (fibers epoll) EPOLLERR)
(@ (fibers epoll) EPOLLHUP)))))
-(define (evaluate store db spec source)
- "Evaluate and build package derivations defined in SPEC, using the checkout
-in SOURCE directory. Return a list of jobs."
+(define (evaluate store db spec checkouts commits)
+ "Evaluate and build package derivations defined in SPEC, using CHECKOUTS.
+Return a list of jobs."
(define (augment-job job eval-id)
(let ((drv (read-derivation-from-file
(assq-ref job #:derivation))))
@@ -254,26 +261,11 @@ in SOURCE directory. Return a list of jobs."
(#:system . ,(derivation-system drv))
,@job)))
- (define (tokenize str)
- (string-tokenize str (char-set-complement (char-set #\:))))
-
- (define load-path
- (match (assq-ref spec #:load-path)
- (#f
- "")
- ((= tokenize path)
- (string-join (map (lambda (entry)
- (if (string-prefix? "/" entry)
- entry
- (string-append source "/" entry)))
- path)
- ":"))))
-
(let* ((port (non-blocking-port
(open-pipe* OPEN_READ "evaluate"
- load-path
(%guix-package-path)
- source (object->string spec))))
+ (object->string spec)
+ (object->string checkouts))))
(result (match (read/non-blocking port)
;; If an error occured during evaluation report it,
;; otherwise, suppose that data read from port are
@@ -285,11 +277,12 @@ in SOURCE directory. Return a list of jobs."
(data data))))
(close-pipe port)
(match result
- (('evaluation eval jobs)
- (let ((eval-id (db-add-evaluation db eval)))
- (log-message "created evaluation ~a for ~a, commit ~a" eval-id
- (assq-ref eval #:specification)
- (assq-ref eval #:revision))
+ (('evaluation jobs)
+ (let* ((spec-name (assq-ref spec #:name))
+ (eval-id (db-add-evaluation
+ db `((#:specification . ,spec-name)
+ (#:commits . ,commits)))))
+ (log-message "created evaluation ~a for '~a'" eval-id spec-name)
(let ((jobs (map (lambda (job)
(augment-job job eval-id))
jobs)))
@@ -611,48 +604,83 @@ procedure is meant to be called at startup."
(when (or directory file)
(set-tls-certificate-locations! directory file)))))
+(define (compile? checkout)
+ (not (assq-ref checkout #:no-compile?)))
+
+(define (fetch-inputs spec)
+ (let* ((inputs (assq-ref spec #:inputs))
+ (thunks
+ (map
+ (lambda (input)
+ (lambda ()
+ (with-store store
+ (log-message "fetching input '~a' of spec '~a'"
+ (assq-ref input #:name)
+ (assq-ref spec #:name))
+ (fetch-input store input
+ #:writable-copy? (compile? input)))))
+ inputs))
+ (results (par-map %non-blocking thunks)))
+ (map (lambda (checkout)
+ (log-message "fetched input '~a' of spec '~a' (commit ~s)"
+ (assq-ref checkout #:name)
+ (assq-ref spec #:name)
+ (assq-ref checkout #:commit))
+ checkout)
+ results)))
+
+(define (compile-checkouts spec all-checkouts)
+ (let* ((checkouts (filter compile? all-checkouts))
+ (thunks
+ (map
+ (lambda (checkout)
+ (lambda ()
+ (log-message "compiling input '~a' of spec '~a' (commit ~s)"
+ (assq-ref checkout #:name)
+ (assq-ref spec #:name)
+ (assq-ref checkout #:commit))
+ (compile checkout)))
+ checkouts))
+ (results (par-map %non-blocking thunks)))
+ (map (lambda (checkout)
+ (log-message "compiled input '~a' of spec '~a' (commit ~s)"
+ (assq-ref checkout #:name)
+ (assq-ref spec #:name)
+ (assq-ref checkout #:commit))
+ checkout)
+ results)))
+
(define (process-specs db jobspecs)
"Evaluate and build JOBSPECS and store results in DB."
(define (process spec)
- (define compile?
- (not (assq-ref spec #:no-compile?)))
-
(with-store store
- (let ((stamp (db-get-stamp db spec))
- (name (assoc-ref spec #:name)))
- (log-message "considering spec '~a', URL '~a'"
- name (assoc-ref spec #:url))
- (receive (checkout commit)
- (non-blocking (fetch-repository store spec
- #:writable-copy? compile?))
- (log-message "spec '~a': fetched commit ~s (stamp was ~s)"
- name commit stamp)
- (when commit
- (unless (string=? commit stamp)
- ;; Immediately mark COMMIT as being processed so we don't spawn
- ;; a concurrent evaluation of that same commit.
- (db-add-stamp db spec commit)
- (spawn-fiber
- (lambda ()
- (when compile?
- (log-message "compiling '~a' with commit ~s" name commit)
- (non-blocking (compile checkout)))
- (guard (c ((evaluation-error? c)
- (log-message "failed to evaluate spec '~s'"
- (evaluation-error-spec-name c))
- #f))
- (log-message "evaluating '~a' with commit ~s"
- name commit)
- (with-store store
- (with-database db
- (let* ((spec* (acons #:current-commit commit spec))
- (jobs (evaluate store db spec* checkout)))
- (log-message "building ~a jobs for '~a'"
- (length jobs) name)
- (build-packages store db jobs)))))))
-
- ;; 'spawn-fiber' returns zero values but we need one.
- *unspecified*))))))
+ (let* ((stamp (db-get-stamp db spec))
+ (name (assoc-ref spec #:name))
+ (checkouts (fetch-inputs spec))
+ (commits (map (cut assq-ref <> #:commit) checkouts))
+ (commits-str (string-join commits)))
+ (unless (equal? commits-str stamp)
+ ;; Immediately mark SPEC's INPUTS as being processed so we don't
+ ;; spawn a concurrent evaluation of that same commit.
+ (db-add-stamp db spec commits-str)
+ (spawn-fiber
+ (lambda ()
+ (compile-checkouts spec checkouts)
+ (guard (c ((evaluation-error? c)
+ (log-message "failed to evaluate spec '~a'"
+ (evaluation-error-spec-name c))
+ #f))
+ (log-message "evaluating spec '~a': stamp ~s different from ~s"
+ name commits-str stamp)
+ (with-store store
+ (with-database db
+ (let ((jobs (evaluate store db spec checkouts commits)))
+ (log-message "building ~a jobs for '~a'"
+ (length jobs) name)
+ (build-packages store db jobs)))))))
+
+ ;; 'spawn-fiber' returns zero values but we need one.
+ *unspecified*))))
(for-each process jobspecs))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index f38dcd4..b241838 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -228,47 +228,76 @@ database object."
(vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
0))
+(define (db-add-input db spec-name input)
+ (sqlite-exec db "\
+INSERT OR IGNORE INTO Inputs (specification, name, url, load_path, branch, \
+tag, revision, no_compile_p) VALUES ("
+ spec-name ", "
+ (assq-ref input #:name) ", "
+ (assq-ref input #:url) ", "
+ (assq-ref input #:load-path) ", "
+ (assq-ref input #:branch) ", "
+ (assq-ref input #:tag) ", "
+ (assq-ref input #:commit) ", "
+ (if (assq-ref input #:no-compile?) 1 0) ");")
+ (last-insert-rowid db))
+
(define (db-add-specification db spec)
- "Store specification SPEC in database DB and return its ID."
+ "Store SPEC in database DB. SPEC inputs are stored in the INPUTS table."
(sqlite-exec db "\
-INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \
- proc, arguments, branch, tag, revision, no_compile_p) \
+INSERT OR IGNORE INTO Specifications (name, load_path_inputs, \
+package_path_inputs, proc_input, proc_path, proc, proc_args) \
VALUES ("
(assq-ref spec #:name) ", "
- (assq-ref spec #:url) ", "
- (assq-ref spec #:load-path) ", "
- (assq-ref spec #:file) ", "
+ (assq-ref spec #:load-path-inputs) ", "
+ (assq-ref spec #:package-path-inputs)", "
+ (assq-ref spec #:proc-input) ", "
+ (assq-ref spec #:proc-path) ", "
(symbol->string (assq-ref spec #:proc)) ", "
- (assq-ref spec #:arguments) ", "
- (assq-ref spec #:branch) ", "
- (assq-ref spec #:tag) ", "
- (assq-ref spec #:commit) ", "
- (if (assq-ref spec #:no-compile?) 1 0)
- ");")
- (last-insert-rowid db))
+ (assq-ref spec #:proc-args) ");")
+ (let ((spec-id (last-insert-rowid db)))
+ (for-each (lambda (input)
+ (db-add-input db (assq-ref spec #:name) input))
+ (assq-ref spec #:inputs))
+ spec-id))
+
+(define (db-get-inputs db spec-name)
+ (let loop ((rows (sqlite-exec db "SELECT * FROM Inputs WHERE specification="
+ spec-name ";"))
+ (inputs '()))
+ (match rows
+ (() inputs)
+ ((#(specification name url load-path branch tag revision no-compile-p)
+ . rest)
+ (loop rest
+ (cons `((#:name . ,name)
+ (#:url . ,url)
+ (#:load-path . ,load-path)
+ (#:branch . ,branch)
+ (#:tag . ,tag)
+ (#:commit . ,revision)
+ (#:no-compile? . ,(positive? no-compile-p)))
+ inputs))))))
(define (db-get-specifications db)
(let loop ((rows (sqlite-exec db "SELECT * FROM Specifications;"))
(specs '()))
(match rows
(() specs)
- ((#(name url load-path file proc args branch tag rev no-compile?)
+ ((#(name load-path-inputs package-path-inputs proc-input proc-path proc
+ proc-args)
. rest)
(loop rest
(cons `((#:name . ,name)
- (#:url . ,url)
- (#:load-path . ,load-path)
- (#:file . ,file)
+ (#:load-path-inputs .
+ ,(with-input-from-string load-path-inputs read))
+ (#:package-path-inputs .
+ ,(with-input-from-string package-path-inputs read))
+ (#:proc-input . ,proc-input)
+ (#:proc-path . ,proc-path)
(#:proc . ,(with-input-from-string proc read))
- (#:arguments . ,(with-input-from-string args read))
- (#:branch . ,branch)
- (#:tag . ,(match tag
- ("NULL" #f)
- (_ tag)))
- (#:commit . ,(match rev
- ("NULL" #f)
- (_ rev)))
- (#:no-compile? . ,(positive? no-compile?)))
+ (#:proc-args . ,(with-input-from-string proc-args read))
+ (#:inputs . ,(db-get-inputs db name)))
specs))))))
(define (db-add-derivation db job)
@@ -299,9 +328,9 @@ INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\
(define (db-add-evaluation db eval)
(sqlite-exec db "\
-INSERT INTO Evaluations (specification, revision) VALUES ("
+INSERT INTO Evaluations (specification, commits) VALUES ("
(assq-ref eval #:specification) ", "
- (assq-ref eval #:revision) ");")
+ (string-join (assq-ref eval #:commits)) ");")
(last-insert-rowid db))
(define-syntax-rule (with-database db body ...)
@@ -518,14 +547,14 @@ Assumes that if group id stays the same the group headers stay the same."
(stmt-text (format #f "\
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\
Derivations.job_name, Derivations.system, Derivations.nix_name,\
-Specifications.repo_name \
+Specifications.name \
FROM Builds \
INNER JOIN Derivations ON Builds.derivation = Derivations.derivation AND Builds.evaluation = Derivations.evaluation \
INNER JOIN Evaluations ON Derivations.evaluation = Evaluations.id \
-INNER JOIN Specifications ON Evaluations.specification = Specifications.repo_name \
+INNER JOIN Specifications ON Evaluations.specification = Specifications.name \
LEFT JOIN Outputs ON Outputs.build = Builds.id \
WHERE (:id IS NULL OR (:id = Builds.id)) \
-AND (:jobset IS NULL OR (:jobset = Specifications.repo_name)) \
+AND (:jobset IS NULL OR (:jobset = Specifications.name)) \
AND (:job IS NULL OR (:job = Derivations.job_name)) \
AND (:system IS NULL OR (:system = Derivations.system)) \
AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \
@@ -571,28 +600,28 @@ SELECT DISTINCT derivation FROM (
(let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification="
(assq-ref spec #:name) ";")))
(match res
- (() "")
- ((#(spec commit)) commit))))
-
-(define (db-add-stamp db spec commit)
- "Associate stamp COMMIT to specification SPEC in database DB."
- (if (string-null? (db-get-stamp db spec))
+ (() #f)
+ ((#(spec stamp)) stamp))))
+
+(define (db-add-stamp db spec stamp)
+ "Associate STAMP to specification SPEC in database DB."
+ (if (db-get-stamp db spec)
+ (sqlite-exec db "UPDATE Stamps SET stamp=" stamp
+ "WHERE specification=" (assq-ref spec #:name) ";")
(sqlite-exec db "\
INSERT INTO Stamps (specification, stamp) VALUES ("
- (assq-ref spec #:name) ", " commit ");")
- (sqlite-exec db "UPDATE Stamps SET stamp=" commit
- "WHERE specification=" (assq-ref spec #:name) ";")))
+ (assq-ref spec #:name) ", " stamp ");")))
(define (db-get-evaluations db limit)
- (let loop ((rows (sqlite-exec db "SELECT id, specification, revision
+ (let loop ((rows (sqlite-exec db "SELECT id, specification, commits
FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
(evaluations '()))
(match rows
(() (reverse evaluations))
- ((#(id specification revision)
+ ((#(id specification commits)
. rest)
(loop rest
(cons `((#:id . ,id)
(#:specification . ,specification)
- (#:revision . ,revision))
+ (#:commits . ,(string-tokenize commits)))
evaluations))))))
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index d219a3e..6629bc1 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -39,6 +39,7 @@
call-with-critical-section
with-critical-section
+ %non-blocking
non-blocking
essential-task
bytevector-range))
diff --git a/src/schema.sql b/src/schema.sql
index a3f14eb..f61bd57 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -6,30 +6,40 @@ CREATE TABLE SchemaVersion (
);
CREATE TABLE Specifications (
- repo_name TEXT NOT NULL PRIMARY KEY,
+ name TEXT NOT NULL PRIMARY KEY,
+ load_path_inputs TEXT NOT NULL, -- list of input names whose load path will be in Guile's %load-path
+ package_path_inputs TEXT NOT NULL, -- list of input names whose load paths will be in GUIX_PACKAGE_PATH
+ proc_input TEXT NOT NULL, -- name of the input containing the proc that does the evaluation
+ proc_path TEXT NOT NULL, -- procedure that does the evaluation, relative to proc_input
+ proc TEXT NOT NULL, -- defined in proc_path
+ proc_args TEXT NOT NULL -- passed to proc
+);
+
+CREATE TABLE Inputs (
+ specification TEXT NOT NULL,
+ name TEXT NOT NULL,
url TEXT NOT NULL,
load_path TEXT NOT NULL,
- file TEXT NOT NULL,
- proc TEXT NOT NULL,
- arguments TEXT NOT NULL,
-- The following columns are optional.
branch TEXT,
tag TEXT,
revision TEXT,
- no_compile_p INTEGER
+ no_compile_p INTEGER,
+ PRIMARY KEY (specification, name),
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
);
CREATE TABLE Stamps (
specification TEXT NOT NULL PRIMARY KEY,
stamp TEXT NOT NULL,
- FOREIGN KEY (specification) REFERENCES Specifications (repo_name)
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
);
CREATE TABLE Evaluations (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification TEXT NOT NULL,
- revision TEXT NOT NULL,
- FOREIGN KEY (specification) REFERENCES Specifications (repo_name)
+ commits TEXT NOT NULL,
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
);
CREATE TABLE Derivations (
@@ -68,7 +78,7 @@ CREATE TABLE Builds (
-- Create indexes to speed up common queries, in particular those
-- corresponding to /api/latestbuilds and /api/queue HTTP requests.
CREATE INDEX Builds_Derivations_index ON Builds(status ASC, timestamp ASC, id, derivation, evaluation, stoptime DESC);
-CREATE INDEX Specifications_index ON Specifications(repo_name, branch);
+CREATE INDEX Inputs_index ON Inputs(specification, name, branch);
CREATE INDEX Derivations_index ON Derivations(derivation, evaluation, job_name, system);
COMMIT;
diff --git a/src/sql/upgrade-2.sql b/src/sql/upgrade-2.sql
new file mode 100644
index 0000000..35cff95
--- /dev/null
+++ b/src/sql/upgrade-2.sql
@@ -0,0 +1,78 @@
+BEGIN TRANSACTION;
+
+DROP INDEX Specifications_index;
+
+ALTER TABLE Specifications RENAME TO tmp_Specifications;
+ALTER TABLE Stamps RENAME TO tmp_Stamps;
+ALTER TABLE Evaluations RENAME TO tmp_Evaluations;
+
+CREATE TABLE Specifications (
+ name TEXT NOT NULL PRIMARY KEY,
+ load_path_inputs TEXT NOT NULL, -- list of input names whose load path will be in Guile's %load-path
+ package_path_inputs TEXT NOT NULL, -- list of input names whose load paths will be in GUIX_PACKAGE_PATH
+ proc_input TEXT NOT NULL, -- name of the input containing the proc that does the evaluation
+ proc_path TEXT NOT NULL, -- procedure that does the evaluation, relative to proc_input
+ proc TEXT NOT NULL, -- defined in proc_path
+ proc_args TEXT NOT NULL -- passed to proc
+);
+
+CREATE TABLE Inputs (
+ specification TEXT NOT NULL,
+ name TEXT NOT NULL,
+ url TEXT NOT NULL,
+ load_path TEXT NOT NULL,
+ -- The following columns are optional.
+ branch TEXT,
+ tag TEXT,
+ revision TEXT,
+ no_compile_p INTEGER,
+ PRIMARY KEY (specification, name),
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
+);
+
+CREATE TABLE Stamps (
+ specification TEXT NOT NULL PRIMARY KEY,
+ stamp TEXT NOT NULL,
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
+);
+
+CREATE TABLE Evaluations (
+ id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+ specification TEXT NOT NULL,
+ commits TEXT NOT NULL,
+ FOREIGN KEY (specification) REFERENCES Specifications (name)
+);
+
+INSERT INTO Specifications (name, load_path_inputs, package_path_inputs, proc_input, proc_path, proc, proc_args)
+SELECT printf('%s-%s', repo_name, branch) AS name,
+ printf('("%s")', repo_name) AS load_path_inputs,
+ '()' AS package_path_inputs,
+ repo_name AS proc_input,
+ file AS proc_path,
+ proc,
+ arguments AS proc_args
+FROM tmp_Specifications;
+
+INSERT INTO Inputs (specification, name, url, load_path, branch, tag, revision, no_compile_p)
+SELECT printf('%s-%s', repo_name, branch) AS specification,
+ repo_name AS name,
+ url, load_path, branch, tag, revision, no_compile_p
+FROM tmp_Specifications;
+
+INSERT INTO Stamps (specification, stamp)
+SELECT Specifications.name AS specification, stamp
+FROM tmp_Stamps
+LEFT JOIN Specifications ON Specifications.proc_input = tmp_Stamps.specification;
+
+INSERT INTO Evaluations (id, specification, commits)
+SELECT id, Specifications.name AS specification, revision
+FROM tmp_Evaluations
+LEFT JOIN Specifications ON Specifications.proc_input = tmp_Evaluations.specification;
+
+CREATE INDEX Inputs_index ON Inputs(specification, name, branch);
+
+DROP TABLE tmp_Specifications;
+DROP TABLE tmp_Stamps;
+DROP TABLE tmp_Evaluations;
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index e71c7f7..674ed9a 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -25,19 +25,30 @@
(define example-spec
'((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . "/tmp/gnu-system.scm")
+ (#:load-path-inputs . ("savannah"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "savannah")
+ (#:proc-path . "/tmp/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))
- (#:branch . "master")
- (#:tag . #f)
- (#:commit . #f)
- (#:no-compile? . #f)))
-
-(define* (make-dummy-eval #:optional (revision "cabba3e"))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (((#:name . "savannah")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:tag . #f)
+ (#:commit . #f)
+ (#:no-compile? . #f))
+ ((#:name . "maintenance")
+ (#:url . "git://git.savannah.gnu.org/guix/maintenance.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:tag . #f)
+ (#:commit . #f)
+ (#:no-compile? . #f))))))
+
+(define* (make-dummy-eval #:optional (commits '("cabba3e 61730ea")))
`((#:specification . "guix")
- (#:revision . ,revision)))
+ (#:commits . ,commits)))
(define* (make-dummy-job #:optional (name "foo"))
`((#:name . ,name)
@@ -90,11 +101,11 @@
(test-assert "sqlite-exec"
(begin
(sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, revision) VALUES (1, 1);")
+INSERT INTO Evaluations (specification, commits) VALUES (1, 1);")
(sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, revision) VALUES (2, 2);")
+INSERT INTO Evaluations (specification, commits) VALUES (2, 2);")
(sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
+INSERT INTO Evaluations (specification, commits) VALUES (3, 3);")
(sqlite-exec (%db) "SELECT * FROM Evaluations;")))
(test-equal "db-add-specification"
diff --git a/tests/http.scm b/tests/http.scm
index ba53887..b5af782 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -97,7 +97,7 @@
(define evaluations-query-result
'((#:id . 2)
(#:specification . "guix")
- (#:revision . "fakesha2")))
+ (#:commits . ("fakesha2" "fakesha3"))))
(test-group-with-cleanup "http"
(test-assert "object->json-string"
@@ -171,21 +171,25 @@
(#:eval-id . 1)))
(specification
'((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . "/tmp/gnu-system.scm")
+ (#:load-path-inputs . ("savannah"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "savannah")
+ (#:proc-path . "/tmp/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))
- (#:branch . "master")
- (#:tag . #f)
- (#:commit . #f)
- (#:no-compile? . #f)))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (((#:name . "savannah")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:tag . #f)
+ (#:commit . #f)
+ (#:no-compile? . #f))))))
(evaluation1
'((#:specification . "guix")
- (#:revision . "fakesha1")))
+ (#:commits . ("fakesha1" "fakesha3"))))
(evaluation2
'((#:specification . "guix")
- (#:revision . "fakesha2"))))
+ (#:commits . ("fakesha2" "fakesha3")))))
(db-add-build (%db) build1)
(db-add-build (%db) build2)
(db-add-derivation (%db) derivation1)
--
2.18.0
^ permalink raw reply related [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber.
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
` (3 preceding siblings ...)
2018-07-10 23:02 ` [bug#32121] [PATCH 5/5] Add support for multiple inputs Clément Lassieur
@ 2018-07-13 8:32 ` Ludovic Courtès
2018-07-13 8:55 ` Clément Lassieur
4 siblings, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 8:32 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Morning!
Clément Lassieur <clement@lassieur.org> skribis:
> Because it may take time and thus prevent PROCESS-SPECS to run every INTERVAL
> seconds.
>
> * src/cuirass/base.scm (process-specs): move the COMPILE invocation inside
> SPAWN-FIBER's thunk. Add log message.
[...]
> - (when compile?
> - (non-blocking (compile checkout)))
> -
> (spawn-fiber
> (lambda ()
> + (when compile?
> + (log-message "compiling '~a' with commit ~s" name commit)
> + (non-blocking (compile checkout)))
I think this doesn’t bring anything compared to the existing
‘non-blocking’ call.
The ‘non-blocking’ procedure evaluates its argument in a separate
thread; the calling fiber then “waits” for a message from that thread,
which it gets when the computation is over. The ‘get-message’ is
non-blocking though: the calling fiber is simply unscheduled until the
message has arrived.
Does that make sense?
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING.
2018-07-10 23:02 ` [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING Clément Lassieur
@ 2018-07-13 8:35 ` Ludovic Courtès
2018-07-14 12:13 ` Clément Lassieur
0 siblings, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 8:35 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> * src/cuirass/utils.scm (%non-blocking): Wrap body in PARAMETERIZE form that
> clears CURRENT-FIBER.
>
> So that PUT-MESSAGE doesn't try to suspend itself within CALL-WITH-NEW-THREAD.
> See https://lists.gnu.org/archive/html/guile-devel/2018-07/msg00009.html.
Good catch!
> + (parameterize (((@@ (fibers internal) current-fiber) #f))
> + (let ((channel (make-channel)))
Instead of using @@, I think you can add an explicit:
#:use-module ((fibers internal) #:select (current-fiber))
at the top.
OK with this change!
Could you also report the issue to Andy (there’s a GitHub thing or you
can email guile-user I guess)?
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 3/5] database: Add support for database upgrades.
2018-07-10 23:02 ` [bug#32121] [PATCH 3/5] database: Add support for database upgrades Clément Lassieur
@ 2018-07-13 8:47 ` Ludovic Courtès
2018-07-14 15:00 ` Clément Lassieur
2018-07-14 15:32 ` Clément Lassieur
1 sibling, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 8:47 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> * Makefile.am: Copy SQL files into their data directory.
> * doc/cuirass.texi (Database schema): Document the change.
> * src/cuirass/database.scm (%package-sql-dir): New parameter.
> (db-load, db-get-version, db-set-version, get-target-version,
> get-upgrade-file, db-upgrade): New procedures.
> (db-init): Set version corresponding to the existing upgrade-n.sql files.
> (db-open): If database exists, upgrade it.
> * src/schema.sql: New file.
> * src/sql/upgrade-1.sql: New file.
Awesome!
What follows is nitpicking, but the patch otherwise LGTM!
For Makefile.am, please specify the new variables explicitly in the
commit log.
> dist_pkgdata_DATA = src/schema.sql
> +dist_sql_DATA = src/sql/upgrade-*.sql
This won’t really work; you have to explicitly list the files (or use
$(wildcard …), but I have a slight preference for an explicit list.)
> +@section SchemaVersion
^
Please add a space here…
> +This table keeps track of the schema version. During the initialization, the
… and here s/This table/The @code{SchemaVersion} table/
> +(define (db-get-version db)
Rather ‘db-schema-version’? Also, please consider adding docstrings to
top-level procedures.
> +(define (db-set-version db version)
Likewise: ‘db-set-schema-version’.
> +(define (get-target-version)
‘latest-db-schema-version’ maybe? :-)
> + (apply max
> + (map string->number
> + (map (cut match:substring <> 1)
> + (filter regexp-match?
> + (map (cut string-match
> + "^upgrade-([0-9]+)\\.sql$" <>)
> + (scandir (%package-sql-dir))))))))
I think you can write it along these lines:
(reduce max 0
(map (compose string->number (cut match:substring <> 1))
(filter-map (cut string-match …) (scandir …))))
> +(define (get-upgrade-file version)
‘schema-upgrade-file’?
> +(define (db-upgrade db)
> + (do-ec (:range version (db-get-version db) (get-target-version))
I would rather avoid SRFI-42, not just because I can’t parse it ;-), but
also to maintain consistency and make the code possibly more accessible.
In this case I think we could use a simple loop or (for-each … (iota n))
and that wouldn’t be bad.
WDYT?
Thank you!
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-10 23:02 ` [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project' Clément Lassieur
@ 2018-07-13 8:51 ` Ludovic Courtès
2018-07-13 9:35 ` Clément Lassieur
0 siblings, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 8:51 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> This removes the possibility to filter specifications by branch, because
> branches were previously called 'jobset'. But it doesn't matter because later
> on, specifications will have as many branches as inputs. And people should
> filter by specification name instead.
>
> * doc/cuirass.texi (Build Information, Latest builds): Remove 'jobset',
> replace 'project' with 'jobset'.
> * src/cuirass/http.scm (build->hydra-build): Idem.
> * tests/database.scm (db-get-builds): Idem.
> * tests/http.scm (build-query-result, /api/latestbuilds?nr=1&jobset=guix,
> /api/latestbuilds?nr=1&jobset=gnu): Idem.
> * src/cuirass/database.scm (db-format-build, db-get-builds): Don't associate
> builds with branches (which were called 'jobset' afterwards).
> (db-get-builds): Remove the #:project filter.
To make sure I understand correctly: it’ll still be possible to have,
say, a “guix” job or a “modular” job built with several different
branches, right?
I think we should try to keep the HTTP API compatible with Hydra so we
don’t break guix-hydra.el and possibly Tatiana’s work.
WDYT?
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber.
2018-07-13 8:32 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Ludovic Courtès
@ 2018-07-13 8:55 ` Clément Lassieur
2018-07-13 11:50 ` Ludovic Courtès
0 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-13 8:55 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Morning :-)
Ludovic Courtès <ludo@gnu.org> writes:
> Morning!
>
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> Because it may take time and thus prevent PROCESS-SPECS to run every INTERVAL
>> seconds.
>>
>> * src/cuirass/base.scm (process-specs): move the COMPILE invocation inside
>> SPAWN-FIBER's thunk. Add log message.
>
> [...]
>
>> - (when compile?
>> - (non-blocking (compile checkout)))
>> -
>> (spawn-fiber
>> (lambda ()
>> + (when compile?
>> + (log-message "compiling '~a' with commit ~s" name commit)
>> + (non-blocking (compile checkout)))
>
> I think this doesn’t bring anything compared to the existing
> ‘non-blocking’ call.
> The ‘non-blocking’ procedure evaluates its argument in a separate
> thread; the calling fiber then “waits” for a message from that thread,
> which it gets when the computation is over. The ‘get-message’ is
> non-blocking though: the calling fiber is simply unscheduled until the
> message has arrived.
>
> Does that make sense?
Well, no :-)
My understanding is that non-blocking is, actually... blocking, because
get-message is blocking. (It doesn't block the scheduler because it's
in another thread, but that's not the problem here.)
What I wanted to fix here is the fact that if the build takes one hour,
we will block for one hour in the COMPILE call, and process-spec won't
return for one hour. If it doesn't return for one hour, that means we
can't evaluate anything else for all that time.
With my change, the one-hour call will be in the fiber, which means that
process-spec can return, and other evaluations can be processed.
But this is untested (because compilation doesn't work IIRC), so I can't
be sure.
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 5/5] Add support for multiple inputs.
2018-07-10 23:02 ` [bug#32121] [PATCH 5/5] Add support for multiple inputs Clément Lassieur
@ 2018-07-13 9:28 ` Ludovic Courtès
2018-07-15 8:25 ` Clément Lassieur
2018-07-16 20:13 ` bug#32121: " Clément Lassieur
0 siblings, 2 replies; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 9:28 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> * bin/evaluate.in (absolutize, find-checkout, get-proc-source, get-load-path,
> get-guix-package-path, format-checkouts, append-paths): New procedures.
> (%not-colon): Remove variable.
> (main): Take the load path, package path and PROC from the checkouts that
> result from the inputs. Format the checkouts before sending them to the
> procedure.
> * doc/cuirass.texi (Overview, Database schema): Document the changes.
> * examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
> hello-subset.scm, random.scm}: Adapt to the new specification format.
> * examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
> (package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
> the new format of its return value.
> * examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
> Rename the checkout from 'random (which is a specification) to 'cuirass (which
> is a checkout resulting from an input).
> * src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
> to INPUT. Return a checkout object instead of returning two values.
> (evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
> SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
> SOURCE to "evaluate". Build the EVAL object instead of getting it from
> "evaluate".
> (compile?, fetch-inputs, compile-checkouts): New procedures.
> (process-specs): Fetch all inputs instead of only fetching one repository.
> The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
> used as a STAMP.
> * src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
> (db-add-specification, db-get-specifications): Adapt to the new specification
> format. Add/get all inputs as well.
> (db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
> separated commit hashes.
> (db-get-builds): Rename REPO_NAME to NAME.
> (db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
> (db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
> value.
> (db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
> * src/cuirass/utils.scm (%non-blocking): Export it.
> * src/schema.sql (Inputs): New table that refers to the Specifications table.
> (Specifications): Move input related fields to the Inputs table. Rename
> REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_PATH.
> Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
> the Inputs table.
> (Stamps): Rename REPO_NAME to NAME.
> (Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
> (Specifications_index): Replace with Inputs_index.
> * src/sql/upgrade-2.sql: New file.
> * tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
> the new specifications format. Rename REVISION to COMMITS.
> * tests/http.scm (evaluations-query-result, fill-db): Idem.
Wow, that’s intimidating. :-)
> (define* (main #:optional (args (command-line)))
> (match args
> - ((command load-path guix-package-path source specstr)
> - ;; Load FILE, a Scheme file that defines Hydra jobs.
> + ((command static-guix-package-path specstr checkoutsstr)
> + ;; Load PROC-FILE, a Scheme file that defines Hydra jobs.
There’s no “proc-file”; should it be “proc-source”?
> - ;; Until FILE is loaded, we must *not* load any Guix module because
> - ;; SOURCE may be providing its own, which could differ from ours--this is
> - ;; the case when SOURCE is a Guix checkout. The 'ref' procedure helps us
> - ;; achieve this.
> - (let ((%user-module (make-fresh-user-module))
> - (spec (with-input-from-string specstr read))
> - (stdout (current-output-port))
> - (stderr (current-error-port))
> - (load-path (string-tokenize load-path %not-colon)))
> - (unless (string-null? guix-package-path)
> - (setenv "GUIX_PACKAGE_PATH" guix-package-path))
> + ;; Until PROC-FILE is loaded, we must *not* load any Guix module because
> + ;; the user may be providing its own with #:LOAD-PATH-INPUTS, which could
> + ;; differ from ours. The 'ref' procedure helps us achieve this.
> + (let* ((%user-module (make-fresh-user-module))
> + (spec (with-input-from-string specstr read))
> + (checkouts (with-input-from-string checkoutsstr read))
> + (proc-source (get-proc-source spec checkouts))
> + (load-path (get-load-path spec checkouts))
> + (guix-package-path (get-guix-package-path spec checkouts))
> + (stdout (current-output-port))
> + (stderr (current-error-port)))
> + (setenv "GUIX_PACKAGE_PATH"
> + (append-paths static-guix-package-path guix-package-path))
Do I get it write that inputs do not necessarily contribute to
GUIX_PACKAGE_PATH?
Some inputs may provide code (to be in %load-path) while not provide any
package definition (so nothing to add to GUIX_PACKAGE_PATH.)
> ;; Since we have relative file name canonicalization by default, better
> - ;; change to SOURCE to make sure things like 'include' with relative
> - ;; file names work as expected.
> - (chdir source)
> + ;; change to PROC-SOURCE to make sure things like 'include' with
> + ;; relative file names work as expected.
> + (chdir proc-source)
As a rule of thumb, identifiers for local variables should, IMO, almost
always be a single word or at most two words. Long names like
‘static-guix-package-path’ in local scope tend to make code harder to
read; ‘proc-source’ here should probably be ‘source’ because we know
what it is we’re talking about.
> (save-module-excursion
> (lambda ()
> (set-current-module %user-module)
> - (primitive-load (assq-ref spec #:file))))
> + (primitive-load (assq-ref spec #:proc-path))))
Nitpick: in GNU “path” means “search path” (a list of directories), so
here I think it should be “file” or “file name”, not “path”.
> @command{cuirass} acts as a daemon polling @acronym{VCS, version control
> -system} repositories for changes, and evaluating a derivation when
> -something has changed (@pxref{Derivations, Derivations,, guix, Guix}).
> -As a final step the derivation is realized and the result of that build
> -allows you to know if the job succeeded or not.
> +system} repositories (called @code{inputs}) for changes, and evaluating a
s/@code/@dfn/
> +derivation when an @code{input} has changed (@pxref{Derivations, Derivations,,
s/@code//
@code is to refer to identifiers in the code, things like that.
> +There are three @code{inputs}: one tracking the Guix repository, one tracking
s/@code//
> +(define (compile-checkouts spec all-checkouts)
> + (let* ((checkouts (filter compile? all-checkouts))
> + (thunks
> + (map
> + (lambda (checkout)
> + (lambda ()
> + (log-message "compiling input '~a' of spec '~a' (commit ~s)"
> + (assq-ref checkout #:name)
> + (assq-ref spec #:name)
> + (assq-ref checkout #:commit))
> + (compile checkout)))
> + checkouts))
> + (results (par-map %non-blocking thunks)))
> + (map (lambda (checkout)
> + (log-message "compiled input '~a' of spec '~a' (commit ~s)"
> + (assq-ref checkout #:name)
> + (assq-ref spec #:name)
> + (assq-ref checkout #:commit))
> + checkout)
> + results)))
Since the return value is unused, we could perhaps make it:
(define (compile-checkouts spec checkouts)
(for-each (lambda (checkout)
(log-message …)
(non-blocking (compile checkout)))
checkouts))
and move the ‘filter’ call to the call site (the job of
‘compile-checkouts’, one might think, is to compile what it’s given, not
to filter things.)
I think that’s about it.
The size of reviews is often inversely proportional to the size of the
change, and I think this one is no exception. :-)
I’m not fully up-to-speed on all the changes but I’ll guess we’ll see it
live when we upgrade Cuirass on berlin.
Thank you!
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-13 8:51 ` Ludovic Courtès
@ 2018-07-13 9:35 ` Clément Lassieur
2018-07-13 9:43 ` Clément Lassieur
2018-07-13 11:56 ` Ludovic Courtès
0 siblings, 2 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-13 9:35 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> This removes the possibility to filter specifications by branch, because
>> branches were previously called 'jobset'. But it doesn't matter because later
>> on, specifications will have as many branches as inputs. And people should
>> filter by specification name instead.
>>
>> * doc/cuirass.texi (Build Information, Latest builds): Remove 'jobset',
>> replace 'project' with 'jobset'.
>> * src/cuirass/http.scm (build->hydra-build): Idem.
>> * tests/database.scm (db-get-builds): Idem.
>> * tests/http.scm (build-query-result, /api/latestbuilds?nr=1&jobset=guix,
>> /api/latestbuilds?nr=1&jobset=gnu): Idem.
>> * src/cuirass/database.scm (db-format-build, db-get-builds): Don't associate
>> builds with branches (which were called 'jobset' afterwards).
>> (db-get-builds): Remove the #:project filter.
>
> To make sure I understand correctly: it’ll still be possible to have,
> say, a “guix” job or a “modular” job built with several different
> branches, right?
Yes, you can have a specification "guix-modular-master" whose Guix
input's branch will be "master", and a specification
"guix-modular-core-updates" whose Guix input's branch will be
"core-updates".
> I think we should try to keep the HTTP API compatible with Hydra so we
> don’t break guix-hydra.el and possibly Tatiana’s work.
This will somehow break a minor part of Tatiana's work because the main
page will look like
--8<---------------cut here---------------start------------->8---
Projects/Specifications
| Name | Branch |
|--------------+--------------|
| guix-modular | master |
| guix-modular | core-updates |
--8<---------------cut here---------------end--------------->8---
instead of
--8<---------------cut here---------------start------------->8---
Projects/Specifications
| Name |
|---------------------------|
| guix-modular-master |
| guix-modular-core-updates |
--8<---------------cut here---------------end--------------->8---
But to me it's not a problem. The branch is an implementation detail
and it's hidden. Instead the information is in the name of the
specification.
Note that we will have control over the specification name, which wasn't
possible before because it was used by the evaluator. Now the evaluator
uses the input's name.
It's not possible to keep the exact same API as hydra because we don't
have projects. We could put everything under the same static project,
but it wouldn't really make sense.
However, we could still be able to bind a specification to a branch, but
that would require adding a 'guix-input' specification field, so that
the specification knows which input is the one whose branch should be
displayed. I doubt it's worth it though. Or we could replace the
'load-path-inputs' field with a 'guix-input' field. That was kind of
the point of the 3rd part of my initial message[1]. Or, we could
automate things: find out from which input the Guix modules come. That
would be a bit tricky.
WDYT?
Clément
[1]: https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00023.html
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-13 9:35 ` Clément Lassieur
@ 2018-07-13 9:43 ` Clément Lassieur
2018-07-13 11:56 ` Ludovic Courtès
1 sibling, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-13 9:43 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Clément Lassieur <clement@lassieur.org> writes:
> This will somehow break a minor part of Tatiana's work because the main
> page will look like
Correction:
It used to look like:
> --8<---------------cut here---------------start------------->8---
> Projects/Specifications
>
> | Name | Branch |
> |--------------+--------------|
> | guix-modular | master |
> | guix-modular | core-updates |
> --8<---------------cut here---------------end--------------->8---
>
> instead of
And it would look like:.
> --8<---------------cut here---------------start------------->8---
> Projects/Specifications
>
> | Name |
> |---------------------------|
> | guix-modular-master |
> | guix-modular-core-updates |
> --8<---------------cut here---------------end--------------->8---
instead.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber.
2018-07-13 8:55 ` Clément Lassieur
@ 2018-07-13 11:50 ` Ludovic Courtès
2018-07-13 11:57 ` Clément Lassieur
0 siblings, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 11:50 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Morning!
>>
>> Clément Lassieur <clement@lassieur.org> skribis:
>>
>>> Because it may take time and thus prevent PROCESS-SPECS to run every INTERVAL
>>> seconds.
>>>
>>> * src/cuirass/base.scm (process-specs): move the COMPILE invocation inside
>>> SPAWN-FIBER's thunk. Add log message.
>>
>> [...]
>>
>>> - (when compile?
>>> - (non-blocking (compile checkout)))
>>> -
>>> (spawn-fiber
>>> (lambda ()
>>> + (when compile?
>>> + (log-message "compiling '~a' with commit ~s" name commit)
>>> + (non-blocking (compile checkout)))
>>
>> I think this doesn’t bring anything compared to the existing
>> ‘non-blocking’ call.
>> The ‘non-blocking’ procedure evaluates its argument in a separate
>> thread; the calling fiber then “waits” for a message from that thread,
>> which it gets when the computation is over. The ‘get-message’ is
>> non-blocking though: the calling fiber is simply unscheduled until the
>> message has arrived.
>>
>> Does that make sense?
>
> Well, no :-)
>
> My understanding is that non-blocking is, actually... blocking, because
> get-message is blocking. (It doesn't block the scheduler because it's
> in another thread, but that's not the problem here.)
>
> What I wanted to fix here is the fact that if the build takes one hour,
> we will block for one hour in the COMPILE call, and process-spec won't
> return for one hour. If it doesn't return for one hour, that means we
> can't evaluate anything else for all that time.
Oh, I see. However we have to wait for compilation to complete before
continuing anyway, no?
> With my change, the one-hour call will be in the fiber, which means that
> process-spec can return, and other evaluations can be processed.
>
> But this is untested (because compilation doesn't work IIRC), so I can't
> be sure.
Yeah, what about this plan: let’s forget about this patch, and let’s
remove support for compilation altogether in a future patch.
WDYT?
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-13 9:35 ` Clément Lassieur
2018-07-13 9:43 ` Clément Lassieur
@ 2018-07-13 11:56 ` Ludovic Courtès
2018-07-14 19:57 ` Clément Lassieur
1 sibling, 1 reply; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-13 11:56 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> This will somehow break a minor part of Tatiana's work because the main
> page will look like
>
> Projects/Specifications
>
> | Name | Branch |
> |--------------+--------------|
> | guix-modular | master |
> | guix-modular | core-updates |
>
>
> instead of
>
> Projects/Specifications
>
> | Name |
> |---------------------------|
> | guix-modular-master |
> | guix-modular-core-updates |
So we’d be moving the project/branch structure to naming conventions.
In a way, that’s not great, because as users we like to think in terms
of branches to answer questions like “how many packages failed in branch
X of the Savannah repo?”.
However, this can probably be addressed at the UI level: the web UI and
guix-hydra.el could list (shortened) repo URLs and branch names instead
of this ‘name’ field. Eventually, we could remove this ‘name’ field
altogether and instead have an automatically-assigned numerical ID.
WDYT?
(This does not affect this patch series, I’m thinking about what we can
do eventually.)
> However, we could still be able to bind a specification to a branch, but
> that would require adding a 'guix-input' specification field, so that
> the specification knows which input is the one whose branch should be
> displayed. I doubt it's worth it though. Or we could replace the
> 'load-path-inputs' field with a 'guix-input' field. That was kind of
> the point of the 3rd part of my initial message[1]. Or, we could
> automate things: find out from which input the Guix modules come. That
> would be a bit tricky.
Oh right, since we now have multiple inputs, what I wrote above is not
quite true; there can be several repo URLs/branches that would need to
be shown on the UI. Hmm, maybe we need to keep the ‘name’, but only as
a hint and not as a key.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber.
2018-07-13 11:50 ` Ludovic Courtès
@ 2018-07-13 11:57 ` Clément Lassieur
0 siblings, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-13 11:57 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> Morning!
>>>
>>> Clément Lassieur <clement@lassieur.org> skribis:
>>>
>>>> Because it may take time and thus prevent PROCESS-SPECS to run every INTERVAL
>>>> seconds.
>>>>
>>>> * src/cuirass/base.scm (process-specs): move the COMPILE invocation inside
>>>> SPAWN-FIBER's thunk. Add log message.
>>>
>>> [...]
>>>
>>>> - (when compile?
>>>> - (non-blocking (compile checkout)))
>>>> -
>>>> (spawn-fiber
>>>> (lambda ()
>>>> + (when compile?
>>>> + (log-message "compiling '~a' with commit ~s" name commit)
>>>> + (non-blocking (compile checkout)))
>>>
>>> I think this doesn’t bring anything compared to the existing
>>> ‘non-blocking’ call.
>>> The ‘non-blocking’ procedure evaluates its argument in a separate
>>> thread; the calling fiber then “waits” for a message from that thread,
>>> which it gets when the computation is over. The ‘get-message’ is
>>> non-blocking though: the calling fiber is simply unscheduled until the
>>> message has arrived.
>>>
>>> Does that make sense?
>>
>> Well, no :-)
>>
>> My understanding is that non-blocking is, actually... blocking, because
>> get-message is blocking. (It doesn't block the scheduler because it's
>> in another thread, but that's not the problem here.)
>>
>> What I wanted to fix here is the fact that if the build takes one hour,
>> we will block for one hour in the COMPILE call, and process-spec won't
>> return for one hour. If it doesn't return for one hour, that means we
>> can't evaluate anything else for all that time.
>
> Oh, I see. However we have to wait for compilation to complete before
> continuing anyway, no?
Yes, for continuing that specific evaluation. But other evaluations
would happen in the meantime.
>> With my change, the one-hour call will be in the fiber, which means that
>> process-spec can return, and other evaluations can be processed.
>>
>> But this is untested (because compilation doesn't work IIRC), so I can't
>> be sure.
>
> Yeah, what about this plan: let’s forget about this patch, and let’s
> remove support for compilation altogether in a future patch.
>
> WDYT?
Agreed!
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING.
2018-07-13 8:35 ` Ludovic Courtès
@ 2018-07-14 12:13 ` Clément Lassieur
2018-07-14 13:45 ` Ludovic Courtès
0 siblings, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-14 12:13 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> * src/cuirass/utils.scm (%non-blocking): Wrap body in PARAMETERIZE form that
>> clears CURRENT-FIBER.
>>
>> So that PUT-MESSAGE doesn't try to suspend itself within CALL-WITH-NEW-THREAD.
>> See https://lists.gnu.org/archive/html/guile-devel/2018-07/msg00009.html.
>
> Good catch!
>
>> + (parameterize (((@@ (fibers internal) current-fiber) #f))
>> + (let ((channel (make-channel)))
>
> Instead of using @@, I think you can add an explicit:
>
> #:use-module ((fibers internal) #:select (current-fiber))
That doesn't work because it would select the exported variable (as '@'
would have done), that is: the value of the parameter. What I need is
the parameter itself, which is hidden.
See (fibers internal):
--8<---------------cut here---------------start------------->8---
#:export ;; Low-level interface: schedulers and threads.
[...]
(current-fiber/public . current-fiber)
[...]
(define current-fiber (make-parameter #f))
(define (current-fiber/public)
"Return the current fiber, or @code{#f} if no fiber is current."
(current-fiber))
--8<---------------cut here---------------end--------------->8---
> at the top.
>
> OK with this change!
>
> Could you also report the issue to Andy (there’s a GitHub thing or you
> can email guile-user I guess)?
Sure!
Thank you,
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING.
2018-07-14 12:13 ` Clément Lassieur
@ 2018-07-14 13:45 ` Ludovic Courtès
0 siblings, 0 replies; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-14 13:45 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Clément Lassieur <clement@lassieur.org> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Clément Lassieur <clement@lassieur.org> skribis:
>>
>>> * src/cuirass/utils.scm (%non-blocking): Wrap body in PARAMETERIZE form that
>>> clears CURRENT-FIBER.
>>>
>>> So that PUT-MESSAGE doesn't try to suspend itself within CALL-WITH-NEW-THREAD.
>>> See https://lists.gnu.org/archive/html/guile-devel/2018-07/msg00009.html.
>>
>> Good catch!
>>
>>> + (parameterize (((@@ (fibers internal) current-fiber) #f))
>>> + (let ((channel (make-channel)))
>>
>> Instead of using @@, I think you can add an explicit:
>>
>> #:use-module ((fibers internal) #:select (current-fiber))
>
> That doesn't work because it would select the exported variable (as '@'
> would have done), that is: the value of the parameter. What I need is
> the parameter itself, which is hidden.
>
> See (fibers internal):
>
> #:export ;; Low-level interface: schedulers and threads.
>
> [...]
>
> (current-fiber/public . current-fiber)
> [...]
>
> (define current-fiber (make-parameter #f))
> (define (current-fiber/public)
> "Return the current fiber, or @code{#f} if no fiber is current."
> (current-fiber))
Oh I see. Thanks for explaining!
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 3/5] database: Add support for database upgrades.
2018-07-13 8:47 ` Ludovic Courtès
@ 2018-07-14 15:00 ` Clément Lassieur
0 siblings, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-14 15:00 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
>> + (apply max
>> + (map string->number
>> + (map (cut match:substring <> 1)
>> + (filter regexp-match?
>> + (map (cut string-match
>> + "^upgrade-([0-9]+)\\.sql$" <>)
>> + (scandir (%package-sql-dir))))))))
>
> I think you can write it along these lines:
>
> (reduce max 0
> (map (compose string->number (cut match:substring <> 1))
> (filter-map (cut string-match …) (scandir …))))
Very nice! Now it returns 0 if the list is empty (which shouldn't
happen) but it makes more sense.
> I would rather avoid SRFI-42, not just because I can’t parse it ;-), but
> also to maintain consistency and make the code possibly more accessible.
>
> In this case I think we could use a simple loop or (for-each … (iota n))
> and that wouldn’t be bad.
iota... Exactly what I was looking for! But for some reason I thought
it would be named something like "range" :-)
Thank you so much!
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 3/5] database: Add support for database upgrades.
2018-07-10 23:02 ` [bug#32121] [PATCH 3/5] database: Add support for database upgrades Clément Lassieur
2018-07-13 8:47 ` Ludovic Courtès
@ 2018-07-14 15:32 ` Clément Lassieur
2018-07-16 13:17 ` Ludovic Courtès
1 sibling, 1 reply; 25+ messages in thread
From: Clément Lassieur @ 2018-07-14 15:32 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Clément Lassieur <clement@lassieur.org> writes:
> +(define (db-get-version db)
> + (if (pair? (sqlite-exec db "SELECT name FROM sqlite_master WHERE \
> +type='table' AND name='SchemaVersion';"))
> + (vector-ref
> + (car (sqlite-exec db "SELECT MAX(version) FROM SchemaVersion;")) 0)
> + 0))
> +
> +(define (db-set-version db version)
> + (sqlite-exec db "INSERT INTO SchemaVersion (version) VALUES (" version
> + ");"))
Actually, there is:
--8<---------------cut here---------------start------------->8---
PRAGMA schema.user_version;
PRAGMA schema.user_version = integer ;
The user_version pragma will to get or set the value of the user-version
integer at offset 60 in the database header. The user-version is an
integer that is available to applications to use however they
want. SQLite makes no use of the user-version itself.
--8<---------------cut here---------------end--------------->8---
Better use them than creating an ad-hoc table I guess, WDYT?
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project'.
2018-07-13 11:56 ` Ludovic Courtès
@ 2018-07-14 19:57 ` Clément Lassieur
0 siblings, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-14 19:57 UTC (permalink / raw)
To: Ludovic Courtès, Tatiana Sholokhova; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
> So we’d be moving the project/branch structure to naming conventions.
Yes.
> In a way, that’s not great, because as users we like to think in terms
> of branches to answer questions like “how many packages failed in branch
> X of the Savannah repo?”.
>
> However, this can probably be addressed at the UI level: the web UI and
> guix-hydra.el could list (shortened) repo URLs and branch names instead
> of this ‘name’ field. Eventually, we could remove this ‘name’ field
> altogether and instead have an automatically-assigned numerical ID.
>
> WDYT?
>
> (This does not affect this patch series, I’m thinking about what we can
> do eventually.)
>
>> However, we could still be able to bind a specification to a branch, but
>> that would require adding a 'guix-input' specification field, so that
>> the specification knows which input is the one whose branch should be
>> displayed. I doubt it's worth it though. Or we could replace the
>> 'load-path-inputs' field with a 'guix-input' field. That was kind of
>> the point of the 3rd part of my initial message[1]. Or, we could
>> automate things: find out from which input the Guix modules come. That
>> would be a bit tricky.
>
> Oh right, since we now have multiple inputs, what I wrote above is not
> quite true; there can be several repo URLs/branches that would need to
> be shown on the UI. Hmm, maybe we need to keep the ‘name’, but only as
> a hint and not as a key.
Yes. As you said above, we could display a preview of all the inputs
(name, URL, branch) in that 'name' field. And call it 'inputs', maybe.
:-)
Cc'ing Tatiana, as this is a UI thing. Tatiana, you can follow the
whole conversation at:
https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00023.html
and
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32121.
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 5/5] Add support for multiple inputs.
2018-07-13 9:28 ` Ludovic Courtès
@ 2018-07-15 8:25 ` Clément Lassieur
2018-07-16 20:13 ` bug#32121: " Clément Lassieur
1 sibling, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-15 8:25 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121
Ludovic Courtès <ludo@gnu.org> writes:
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> (define* (main #:optional (args (command-line)))
>> (match args
>> - ((command load-path guix-package-path source specstr)
>> - ;; Load FILE, a Scheme file that defines Hydra jobs.
>> + ((command static-guix-package-path specstr checkoutsstr)
>> + ;; Load PROC-FILE, a Scheme file that defines Hydra jobs.
>
> There’s no “proc-file”; should it be “proc-source”?
It was #:PROC-PATH, but I'll bind it to FILE and use FILE in the
comment, as it was initially.
> Do I get it write that inputs do not necessarily contribute to
> GUIX_PACKAGE_PATH?
Yes! Only inputs in package-path-inputs contribute to
GUIX_PACKAGE_PATH.
> Some inputs may provide code (to be in %load-path) while not provide any
> package definition (so nothing to add to GUIX_PACKAGE_PATH.)
Indeed. And some inputs can contribute to both %load-path and
GUIX_PACKAGE_PATH. It's flexible.
>> ;; Since we have relative file name canonicalization by default, better
>> - ;; change to SOURCE to make sure things like 'include' with relative
>> - ;; file names work as expected.
>> - (chdir source)
>> + ;; change to PROC-SOURCE to make sure things like 'include' with
>> + ;; relative file names work as expected.
>> + (chdir proc-source)
>
> As a rule of thumb, identifiers for local variables should, IMO, almost
> always be a single word or at most two words. Long names like
> ‘static-guix-package-path’ in local scope tend to make code harder to
> read; ‘proc-source’ here should probably be ‘source’ because we know
> what it is we’re talking about.
Okay! Well I'll just remove static-guix-package-path (you know, the
--load-path argument to the cuirass command), because it's better to use
inputs instead. And it'll simplify the code.
I'll also rename my GET-something procedures.
>> (save-module-excursion
>> (lambda ()
>> (set-current-module %user-module)
>> - (primitive-load (assq-ref spec #:file))))
>> + (primitive-load (assq-ref spec #:proc-path))))
>
> Nitpick: in GNU “path” means “search path” (a list of directories), so
> here I think it should be “file” or “file name”, not “path”.
Ok I'll change it everywhere else too.
>> @command{cuirass} acts as a daemon polling @acronym{VCS, version control
>> -system} repositories for changes, and evaluating a derivation when
>> -something has changed (@pxref{Derivations, Derivations,, guix, Guix}).
>> -As a final step the derivation is realized and the result of that build
>> -allows you to know if the job succeeded or not.
>> +system} repositories (called @code{inputs}) for changes, and evaluating a
>
> s/@code/@dfn/
>
>> +derivation when an @code{input} has changed (@pxref{Derivations, Derivations,,
>
> s/@code//
>
> @code is to refer to identifiers in the code, things like that.
Got it :-)
>> +There are three @code{inputs}: one tracking the Guix repository, one tracking
>
> s/@code//
>
>> +(define (compile-checkouts spec all-checkouts)
>> + (let* ((checkouts (filter compile? all-checkouts))
>> + (thunks
>> + (map
>> + (lambda (checkout)
>> + (lambda ()
>> + (log-message "compiling input '~a' of spec '~a' (commit ~s)"
>> + (assq-ref checkout #:name)
>> + (assq-ref spec #:name)
>> + (assq-ref checkout #:commit))
>> + (compile checkout)))
>> + checkouts))
>> + (results (par-map %non-blocking thunks)))
>> + (map (lambda (checkout)
>> + (log-message "compiled input '~a' of spec '~a' (commit ~s)"
>> + (assq-ref checkout #:name)
>> + (assq-ref spec #:name)
>> + (assq-ref checkout #:commit))
>> + checkout)
>> + results)))
>
> Since the return value is unused, we could perhaps make it:
>
> (define (compile-checkouts spec checkouts)
> (for-each (lambda (checkout)
> (log-message …)
> (non-blocking (compile checkout)))
> checkouts))
I use par-map because it's better to build them in parallel. Also, the
return value is used to display a log message.
> and move the ‘filter’ call to the call site (the job of
> ‘compile-checkouts’, one might think, is to compile what it’s given, not
> to filter things.)
Right!
Thank you for the review, I'm learning a lot ;-).
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
* [bug#32121] [PATCH 3/5] database: Add support for database upgrades.
2018-07-14 15:32 ` Clément Lassieur
@ 2018-07-16 13:17 ` Ludovic Courtès
0 siblings, 0 replies; 25+ messages in thread
From: Ludovic Courtès @ 2018-07-16 13:17 UTC (permalink / raw)
To: Clément Lassieur; +Cc: 32121
Hello,
Clément Lassieur <clement@lassieur.org> skribis:
> Clément Lassieur <clement@lassieur.org> writes:
>
>> +(define (db-get-version db)
>> + (if (pair? (sqlite-exec db "SELECT name FROM sqlite_master WHERE \
>> +type='table' AND name='SchemaVersion';"))
>> + (vector-ref
>> + (car (sqlite-exec db "SELECT MAX(version) FROM SchemaVersion;")) 0)
>> + 0))
>> +
>> +(define (db-set-version db version)
>> + (sqlite-exec db "INSERT INTO SchemaVersion (version) VALUES (" version
>> + ");"))
>
> Actually, there is:
>
> PRAGMA schema.user_version;
> PRAGMA schema.user_version = integer ;
>
> The user_version pragma will to get or set the value of the user-version
> integer at offset 60 in the database header. The user-version is an
> integer that is available to applications to use however they
> want. SQLite makes no use of the user-version itself.
>
> Better use them than creating an ad-hoc table I guess, WDYT?
Sounds good, yes.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 25+ messages in thread
* bug#32121: [PATCH 5/5] Add support for multiple inputs.
2018-07-13 9:28 ` Ludovic Courtès
2018-07-15 8:25 ` Clément Lassieur
@ 2018-07-16 20:13 ` Clément Lassieur
1 sibling, 0 replies; 25+ messages in thread
From: Clément Lassieur @ 2018-07-16 20:13 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 32121-done, Ricardo Wurmus
Hi Ludo,
Ludovic Courtès <ludo@gnu.org> writes:
> I think that’s about it.
>
> The size of reviews is often inversely proportional to the size of the
> change, and I think this one is no exception. :-)
>
> I’m not fully up-to-speed on all the changes but I’ll guess we’ll see it
> live when we upgrade Cuirass on berlin.
I pushed everything. If you need my help for the Berlin migration,
don't hesitate to ask. The database migration should go smoothly of
course, but... you never know :-)
Clément
^ permalink raw reply [flat|nested] 25+ messages in thread
end of thread, other threads:[~2018-07-16 20:14 UTC | newest]
Thread overview: 25+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-07-10 22:58 [bug#32121] Cuirass: add support for multiple inputs Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 2/5] utils: Reset the Fiber dynamic environment in %NON-BLOCKING Clément Lassieur
2018-07-13 8:35 ` Ludovic Courtès
2018-07-14 12:13 ` Clément Lassieur
2018-07-14 13:45 ` Ludovic Courtès
2018-07-10 23:02 ` [bug#32121] [PATCH 3/5] database: Add support for database upgrades Clément Lassieur
2018-07-13 8:47 ` Ludovic Courtès
2018-07-14 15:00 ` Clément Lassieur
2018-07-14 15:32 ` Clément Lassieur
2018-07-16 13:17 ` Ludovic Courtès
2018-07-10 23:02 ` [bug#32121] [PATCH 4/5] database: Call a specification 'jobset' instead of 'project' Clément Lassieur
2018-07-13 8:51 ` Ludovic Courtès
2018-07-13 9:35 ` Clément Lassieur
2018-07-13 9:43 ` Clément Lassieur
2018-07-13 11:56 ` Ludovic Courtès
2018-07-14 19:57 ` Clément Lassieur
2018-07-10 23:02 ` [bug#32121] [PATCH 5/5] Add support for multiple inputs Clément Lassieur
2018-07-13 9:28 ` Ludovic Courtès
2018-07-15 8:25 ` Clément Lassieur
2018-07-16 20:13 ` bug#32121: " Clément Lassieur
2018-07-13 8:32 ` [bug#32121] [PATCH 1/5] base: Compile CHECKOUT in the fiber Ludovic Courtès
2018-07-13 8:55 ` Clément Lassieur
2018-07-13 11:50 ` Ludovic Courtès
2018-07-13 11:57 ` Clément Lassieur
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.