guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add machine field to Worker table. 

* src/sql/upgrade-2.sql: New file.
* Makefile.am (dist_sql_DATA): Add it.
* src/schema.sql (Workers): Add "machine field".
* src/cuirass/database.scm (db-get-builds): Return "worker" field.
(db-add-worker): Honor new "machine" field.
(db-get-workers): Ditto.
* src/cuirass/remote-worker.scm (remote-worker): Adapt it.
* src/cuirass/remote.scm (<worker>)[machine]: New field.
(worker-machine): New procedure.
(worker->sexp, sexp->worker): Adapt accordingly.
(generate-worker-name): Ditto.
* tests/database.scm (%dummy-worker): Add "machine" field.
This commit is contained in:
Mathieu Othacehe 2021-01-30 14:18:59 +01:00
parent 68532aee90
commit 1271b11725
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
7 changed files with 39 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

@ -79,7 +79,8 @@ nodist_webobject_DATA = \
dist_pkgdata_DATA = src/schema.sql
dist_sql_DATA = \
src/sql/upgrade-1.sql
src/sql/upgrade-1.sql \
src/sql/upgrade-2.sql
dist_css_DATA = \
src/static/css/cuirass.css \

13
src/cuirass/database.scm
View File

@ -992,7 +992,7 @@ OR :borderhightime IS NULL OR :borderhighid IS NULL)")))
(format #f " SELECT Builds.derivation, Builds.id, Builds.timestamp,
Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.priority,
Builds.max_silent, Builds.timeout, Builds.job_name, Builds.system,
Builds.nix_name, Builds.evaluation, agg.name, agg.outputs_name,
Builds.worker, Builds.nix_name, Builds.evaluation, agg.name, agg.outputs_name,
agg.outputs_path,agg.bp_build, agg.bp_type, agg.bp_file_size,
agg.bp_checksum, agg.bp_path
FROM
@ -1040,7 +1040,7 @@ ORDER BY ~a;"
(() (reverse result))
(((derivation id timestamp starttime stoptime log status
priority max-silent timeout job-name
system nix-name eval-id specification
system worker nix-name eval-id specification
outputs-name outputs-path
products-id products-type products-file-size
products-checksum products-path)
@ -1058,6 +1058,7 @@ ORDER BY ~a;"
(#:timeout . ,(string->number timeout))
(#:job-name . ,job-name)
(#:system . ,system)
(#:worker . ,worker)
(#:nix-name . ,nix-name)
(#:eval-id . ,(string->number eval-id))
(#:specification . ,specification)
@ -1352,10 +1353,11 @@ WHERE id = " id))
"Insert WORKER into Worker table."
(with-db-worker-thread db
(exec-query/bind db "\
INSERT INTO Workers (name, address, systems, last_seen)
INSERT INTO Workers (name, address, machine, systems, last_seen)
VALUES ("
(worker-name worker) ", "
(worker-address worker) ", "
(worker-machine worker) ", "
(string-join (worker-systems worker) ",") ", "
(worker-last-seen worker) ");")))
@ -1363,16 +1365,17 @@ VALUES ("
"Return the workers in Workers table."
(with-db-worker-thread db
(let loop ((rows (exec-query db "
SELECT name, address, systems, last_seen from Workers"))
SELECT name, address, machine, systems, last_seen from Workers"))
(workers '()))
(match rows
(() (reverse workers))
(((name address systems last-seen)
(((name address machine systems last-seen)
. rest)
(loop rest
(cons (worker
(name name)
(address address)
(machine machine)
(systems (string-split systems #\,))
(last-seen last-seen))
workers)))))))

10
src/cuirass/remote-worker.scm
View File

@ -355,9 +355,10 @@ exiting."
(let ((publish-url (local-publish-url address)))
(add-to-worker-pids!
(start-worker (worker
(address address)
(publish-url publish-url)
(name (generate-worker-name))
(address address)
(machine (gethostname))
(publish-url publish-url)
(systems systems))
server))))
(iota workers))
@ -374,9 +375,10 @@ exiting."
(publish-url (local-publish-url address)))
(add-to-worker-pids!
(start-worker (worker
(address address)
(publish-url publish-url)
(name (generate-worker-name))
(address address)
(machine (gethostname))
(publish-url publish-url)
(systems systems))
(avahi-service->server service)))))
(iota workers)))))

24
src/cuirass/remote.scm
View File

@ -40,8 +40,9 @@
#:use-module (ice-9 threads)
#:export (worker
worker?
worker-address
worker-name
worker-address
worker-machine
worker-publish-url
worker-systems
worker-last-seen
@ -91,8 +92,9 @@
(define-record-type* <worker>
worker make-worker
worker?
(address worker-address)
(name worker-name)
(address worker-address)
(machine worker-machine)
(publish-url worker-publish-url
(default #f))
(systems worker-systems)
@ -101,26 +103,30 @@
(define (worker->sexp worker)
"Return an sexp describing WORKER."
(let ((address (worker-address worker))
(name (worker-name worker))
(let ((name (worker-name worker))
(address (worker-address worker))
(machine (worker-machine worker))
(systems (worker-systems worker))
(last-seen (worker-last-seen worker)))
`(worker
(address ,address)
(name ,name)
(address ,address)
(machine ,machine)
(systems ,systems)
(last-seen ,last-seen))))
(define (sexp->worker sexp)
"Turn SEXP, an sexp as returned by 'worker->sexp', into a <worker> record."
(match sexp
(('worker ('address address)
('name name)
(('worker ('name name)
('address address)
('machine machine)
('systems systems)
('last-seen last-seen))
(worker
(address address)
(name name)
(address address)
(machine machine)
(systems systems)
(last-seen last-seen)))))
@ -151,7 +157,7 @@
(define (generate-worker-name)
"Return the service name of the server."
(string-append (gethostname) "-" (random-string 4)))
(random-string 8))
(define %worker-timeout
(make-parameter 120))

1
src/schema.sql
View File

@ -109,6 +109,7 @@ CREATE TABLE Events (
CREATE TABLE Workers (
name TEXT NOT NULL PRIMARY KEY,
address TEXT NOT NULL,
machine TEXT NOT NULL,
systems TEXT NOT NULL,
last_seen INTEGER NOT NULL
);

6
src/sql/upgrade-2.sql Normal file
View File

@ -0,0 +1,6 @@
BEGIN TRANSACTION;
DELETE FROM Workers;
ALTER TABLE Workers ADD COLUMN machine TEXT NOT NULL;
COMMIT;

1
tests/database.scm
View File

@ -79,6 +79,7 @@
(worker
(name "worker")
(address "address")
(machine "machine")
(systems '("a" "b"))
(last-seen "1")))