aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bin/cuirass.in32
-rw-r--r--src/cuirass/database.scm25
-rw-r--r--src/schema.sql44
-rw-r--r--tests/database.scm21
4 files changed, 82 insertions, 40 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in
index 5aa53c4..d0cd84a 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -90,9 +90,10 @@ if required."
(string-append "'" (object->string spec))))
(jobs (read port)))
(close-pipe port)
- (map (λ (job)
- (acons #:id (db-add-evaluation db job) job))
- jobs)))
+ ;; Keep track of SPEC id in the returned jobs.
+ (let ((spec-id (assq-ref spec #:id)))
+ (map (λ (job) (acons #:spec-id spec-id job))
+ jobs))))
(define (build-packages store db jobs)
"Build JOBS which is a list of <job> objects."
@@ -104,23 +105,26 @@ if required."
(format #t "building ~A...~%" drv)
(parameterize ((current-build-output-port log-port))
(build-derivations store (list drv))
- (db-add-build-log db job log-port)
+ ;; XXX: 'Builds' database table is not implemented yet.
+ ;; (db-add-build-log db job log-port)
(close-port log-port))
(format #t "~A~%" (derivation-path->output-path drv))))
jobs))
-(define (process-spec db spec)
- "Evaluate and build SPEC"
- (fetch-repository spec)
- (compile (string-append (%package-cachedir) "/" (assq-ref spec #:name)))
- (with-store store
- (let ((jobs (evaluate store db spec)))
- (set-build-options store #:use-substitutes? #f)
- (build-packages store db jobs))))
-
(define (process-specs db jobspecs)
"Evaluate and build JOBSPECS and store results in DB."
- (for-each (λ (spec) (process-spec db spec)) jobspecs))
+ (for-each (λ (spec)
+ (fetch-repository spec)
+ (compile (string-append (%package-cachedir) "/"
+ (assq-ref spec #:name)))
+ (with-store store
+ (let* ((id (db-add-specification db spec))
+ (spec* (acons #:id id spec))
+ (jobs (evaluate store db spec*)))
+ (db-add-evaluation db jobs)
+ (set-build-options store #:use-substitutes? #f)
+ (build-packages store db jobs))))
+ jobspecs))
;;;
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index c9c106e..101a02d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -25,6 +25,7 @@
db-init
db-open
db-close
+ db-add-specification
db-add-evaluation
db-get-evaluation
db-delete-evaluation
@@ -33,6 +34,7 @@
sqlite-exec
;; Parameters.
%package-database
+ %package-schema-file
;; Macros.
with-database))
@@ -102,20 +104,33 @@ database object."
(vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
0))
+(define (db-add-specification db spec)
+ "Store specification SPEC in database DB and return its ID."
+ (apply sqlite-exec db "\
+INSERT INTO Specifications\
+ (repo_name, url, load_path, file, proc, arguments, branch, tag, revision)\
+ VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A');"
+ (append
+ (assq-refs spec '(#:name #:url #:load-path #:file #:proc #:arguments))
+ (assq-refs spec '(#:branch #:tag #:commit) "NULL")))
+ (last-insert-rowid db))
+
(define (db-add-evaluation db job)
"Store a derivation result in database DB and return its ID."
- (sqlite-exec db "insert into build (job_spec, drv) values ('~A', '~A');"
+ (sqlite-exec db "\
+INSERT INTO Evaluations (derivation, job_name, specification)\
+ VALUES ('~A', '~A', '~A');"
+ (assq-ref job #:derivation)
(assq-ref job #:job-name)
- (assq-ref job #:derivation))
- (last-insert-rowid db))
+ (assq-ref job #:spec-id)))
(define (db-get-evaluation db id)
"Retrieve a job in database DB which corresponds to ID."
- (car (sqlite-exec db "select * from build where id=~A;" id)))
+ (car (sqlite-exec db "select * from Evaluations where derivation='~A';" id)))
(define (db-delete-evaluation db id)
"Delete a job in database DB which corresponds to ID."
- (sqlite-exec db "delete from build where id=~A;" id))
+ (sqlite-exec db "delete from Evaluations where derivation='~A';" id))
(define-syntax-rule (with-database db body ...)
"Run BODY with a connection to the database which is bound to DB in BODY."
diff --git a/src/schema.sql b/src/schema.sql
index 9786064..9cc7167 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -1,18 +1,32 @@
-create table job_spec (
- name text not null,
- url text not null,
- branch text not null,
- file text not null,
- proc text not null,
- arguments text not null,
- primary key (name)
+BEGIN TRANSACTION;
+
+CREATE TABLE Specifications (
+ id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+ repo_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
+);
+
+CREATE TABLE Evaluations (
+ derivation TEXT NOT NULL PRIMARY KEY,
+ job_name TEXT NOT NULL,
+ specification INTEGER NOT NULL,
+ FOREIGN KEY (specification) REFERENCES Specifications (id)
);
-create table build (
- id integer primary key autoincrement not null,
- job_spec text not null,
- drv text not null,
- log text,
- output text
- -- foreign key (job_spec) references job_spec(name)
+CREATE TABLE Builds (
+ id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+ derivation TEXT NOT NULL,
+ log TEXT NOT NULL,
+ output TEXT, -- NULL if build failed
+ FOREIGN KEY (derivation) REFERENCES Evaluations (derivation)
);
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index 75431e9..964cd00 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -22,7 +22,8 @@
(define* (make-dummy-job #:optional (name "foo"))
`((#:name . ,name)
- (#:derivation . ,(string-append name ".drv"))))
+ (#:derivation . ,(string-append name ".drv"))
+ (#:specification 0)))
(define %db
;; Global Slot for a database object.
@@ -45,19 +46,27 @@
(test-assert "sqlite-exec"
(begin
(sqlite-exec (%db) "\
-INSERT INTO build (job_spec, drv) VALUES ('job1', 'drv1');")
+INSERT INTO Evaluations (derivation, job_name, specification)\
+ VALUES ('drv1', 'job1', 1);")
(sqlite-exec (%db) "\
-INSERT INTO build (job_spec, drv) VALUES ('job2', 'drv2');")
+INSERT INTO Evaluations (derivation, job_name, specification)\
+ VALUES ('drv2', 'job2', 2);")
(sqlite-exec (%db) "\
-INSERT INTO build (job_spec, drv) VALUES ('job3', 'drv3');")
- (sqlite-exec (%db) "SELECT * FROM build;")))
+INSERT INTO Evaluations (derivation, job_name, specification)\
+ VALUES ('drv3', 'job3', 3);")
+ (sqlite-exec (%db) "SELECT * FROM Evaluations;")))
(test-assert "db-add-evaluation"
- (%id (db-add-evaluation (%db) (make-dummy-job))))
+ (let* ((job (make-dummy-job))
+ (key (assq-ref job #:derivation)))
+ (db-add-evaluation (%db) job)
+ (%id key)))
(test-assert "db-get-evaluation"
(db-get-evaluation (%db) (%id)))
+ (test-expect-fail "db-add-build-log")
+ ;; XXX: 'Builds' database table is not implemented yet.
(test-equal "db-add-build-log"
"foo log"
(let ((job (acons #:id (%id) (make-dummy-job)))
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-22 06:23:49 +0000