[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Mathieu Othacehe |
|
Date: |
Sat, 30 Jan 2021 08:25:38 -0500 (EST) |
branch: master
commit 1271b11725218812d485c450bc11bcfc5c18fa42
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sat Jan 30 14:18:59 2021 +0100
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.
---
Makefile.am | 3 ++-
src/cuirass/database.scm | 13 ++++++++-----
src/cuirass/remote-worker.scm | 6 ++++--
src/cuirass/remote.scm | 24 +++++++++++++++---------
src/schema.sql | 1 +
src/sql/upgrade-2.sql | 6 ++++++
tests/database.scm | 1 +
7 files changed, 37 insertions(+), 17 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 7679723..e5de6d3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 0cc90e6..075db1c 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -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)))))))
diff --git a/src/cuirass/remote-worker.scm b/src/cuirass/remote-worker.scm
index f5b1e49..97a9d7f 100644
--- a/src/cuirass/remote-worker.scm
+++ b/src/cuirass/remote-worker.scm
@@ -355,9 +355,10 @@ exiting."
(let ((publish-url (local-publish-url address)))
(add-to-worker-pids!
(start-worker (worker
+ (name (generate-worker-name))
(address address)
+ (machine (gethostname))
(publish-url publish-url)
- (name (generate-worker-name))
(systems systems))
server))))
(iota workers))
@@ -374,9 +375,10 @@ exiting."
(publish-url (local-publish-url address)))
(add-to-worker-pids!
(start-worker (worker
+ (name (generate-worker-name))
(address address)
+ (machine (gethostname))
(publish-url publish-url)
- (name (generate-worker-name))
(systems systems))
(avahi-service->server service)))))
(iota workers)))))
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 316d6b7..33442e6 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -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))
diff --git a/src/schema.sql b/src/schema.sql
index d7c85d9..70b945a 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -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
);
diff --git a/src/sql/upgrade-2.sql b/src/sql/upgrade-2.sql
new file mode 100644
index 0000000..79f0ce9
--- /dev/null
+++ b/src/sql/upgrade-2.sql
@@ -0,0 +1,6 @@
+BEGIN TRANSACTION;
+
+DELETE FROM Workers;
+ALTER TABLE Workers ADD COLUMN machine TEXT NOT NULL;
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index b640f83..85acbaf 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -79,6 +79,7 @@
(worker
(name "worker")
(address "address")
+ (machine "machine")
(systems '("a" "b"))
(last-seen "1")))