[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Mathieu Othacehe |
|
Date: |
Mon, 21 Dec 2020 05:30:41 -0500 (EST) |
branch: wip-offload
commit a23d628f20a65b0b1aaeb9f2adcf3ea24f45f59f
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Dec 20 19:27:04 2020 +0100
tmp
---
src/cuirass/base.scm | 28 +++++-----------------------
src/cuirass/database.scm | 3 +++
src/cuirass/remote-server.scm | 36 +++++++++++++++++++++---------------
src/cuirass/remote.scm | 39 ---------------------------------------
src/schema.sql | 1 +
src/sql/upgrade-19.sql | 2 ++
6 files changed, 32 insertions(+), 77 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 4c06e70..47cdb8b 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -64,6 +64,7 @@
fetch-inputs
compile
evaluate
+ set-build-successful!
clear-build-queue
cancel-old-builds
restart-builds
@@ -473,8 +474,6 @@ in the database."
(match (get-message-with-timeout channel
#:seconds 0.1
#:retry? #f)
- (('builds builds)
- (remote-build socket builds))
('workers
(remote-send-workers socket))
('timeout #f))
@@ -486,9 +485,6 @@ in the database."
(make-build-offload-thread)))
body ...))
-(define (build-derivations/offload builds)
- (put-message (%build-offload-channel) `(builds ,builds)))
-
(define (request-workers)
(put-message (%build-offload-channel) 'workers))
@@ -657,22 +653,12 @@ updating the database accordingly."
#:entry-expiration
gc-root-expiration-time))
(log-message "bogus build-succeeded event for '~a'" drv)))
- (('build-succeeded/log drv log)
- (log-message "build succeeded: '~a'" drv)
- (set-build-successful! drv log))
(('build-failed drv _ ...)
(if (valid? drv)
(begin
(log-message "build failed: '~a'" drv)
(db-update-build-status! drv (build-status failed)))
(log-message "bogus build-failed event for '~a'" drv)))
- (('build-failed/log drv log)
- (log-message "build failed: '~a'" drv)
- (db-update-build-status! drv
- (if log
- (build-status failed)
- (build-status failed-dependency))
- #:log-file log))
(('workers workers)
(db-clear-workers)
(for-each (lambda (worker)
@@ -714,10 +700,8 @@ started)."
;; Those in VALID can be restarted. If some of them were built in the
;; meantime behind our back, that's fine: 'spawn-builds' will DTRT.
(log-message "restarting ~a pending builds" (length valid))
- (if (%build-remote?)
- (let ((builds (map db-get-build valid)))
- (build-derivations/offload builds))
- (spawn-builds store valid))
+ (unless (%build-remote?)
+ (spawn-builds store valid))
(log-message "done with restarted builds"))))
(define (create-build-outputs build product-specs)
@@ -768,10 +752,8 @@ by PRODUCT-SPECS."
(db-set-evaluation-status eval-id
(evaluation-status succeeded))
- (if (%build-remote?)
- (let ((builds (map db-get-build derivations)))
- (build-derivations/offload builds))
- (spawn-builds store derivations))
+ (unless (%build-remote?)
+ (spawn-builds store derivations))
(let* ((results (filter-map (cut db-get-build <>) derivations))
(status (map (cut assq-ref <> #:status) results))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index b2eb3f1..c9e3f64 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -977,6 +977,8 @@ CASE WHEN :borderlowid IS NULL THEN
;; before those in 'scheduled' state (-2).
(('order . 'status+submission-time)
"Builds.status DESC, Builds.timestamp DESC, Builds.rowid ASC")
+ (('order . 'priority+timestamp)
+ "Builds.priority DESC, Builds.timestamp ASC")
(_ "Builds.rowid DESC"))))
;; XXX: Make sure that all filters are covered by an index.
@@ -992,6 +994,7 @@ CASE WHEN :borderlowid IS NULL THEN
(status . ,(match (assq-ref filters 'status)
(#f #f)
('done "Builds.status >= 0")
+ ('scheduled "Builds.status = -2")
('started "Builds.status = -1")
('pending "Builds.status < 0")
('succeeded "Builds.status = 0")
diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 988b592..3ad722b 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -18,6 +18,7 @@
(define-module (cuirass remote-server)
#:use-module (cuirass base)
+ #:use-module (cuirass database)
#:use-module (cuirass remote)
#:use-module (gcrypt pk-crypto)
#:use-module (guix avahi)
@@ -85,6 +86,8 @@ Start a remote build server.\n"))
(display (G_ "
-p, --publish-port=PORT publish substitutes on PORT"))
(display (G_ "
+ -D, --database=DB Use DB to read and store build results"))
+ (display (G_ "
-c, --cache=DIRECTORY cache built items to DIRECTORY"))
(display (G_ "
-l, --log-directory=DIRECTORY cache log files to DIRECTORY"))
@@ -119,6 +122,9 @@ Start a remote build server.\n"))
(option '(#\p "publish-port") #t #f
(lambda (opt name arg result)
(alist-cons 'publish-port (string->number* arg) result)))
+ (option '(#\D "database") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'database arg result)))
(option '(#\c "cache") #t #f
(lambda (opt name arg result)
(alist-cons 'cache arg result)))
@@ -433,7 +439,7 @@ required and #f otherwise."
#t)
(else #f)))
-(define* (run-fetch message #:key reply)
+(define* (run-fetch message)
"Read MESSAGE and download the corresponding build outputs. If
%CACHE-DIRECTORY is set, download the matching NAR and NARINFO files in this
directory. If %ADD-TO-STORE? is set, add the build outputs to the store.
@@ -462,25 +468,22 @@ outputs are downloaded."
(add-to-store outputs url))
(when (%cache-directory)
(download-nar (%cache-directory) outputs url))
- (reply
- (zmq-build-succeeded-message drv url log-file))))
+ (set-build-successful! drv log-file)))
(('build-failed ('drv drv) ('url url) _ ...)
(let ((log-file
(and log-directory
(download-log-file log-directory drv url))))
- (reply
- (zmq-build-failed-message drv url log-file)))))))
+ (log-message "build failed: '~a'" drv)
+ (db-update-build-status! drv
+ (if log-file
+ (build-status failed)
+ (build-status failed-dependency))
+ #:log-file log-file))))))
(define (start-fetch-worker name)
"Start a fetch worker thread with the given NAME. This worker takes care of
downloading build outputs. It communicates with the remote server using a ZMQ
socket."
- (define (reply socket client)
- (lambda (message)
- (zmq-send-msg-parts-bytevector
- socket
- (list client (zmq-empty-delimiter) (string->bv message)))))
-
(call-with-new-thread
(lambda ()
(set-thread-name name)
@@ -488,8 +491,7 @@ socket."
(let loop ()
(match (zmq-get-msg-parts-bytevector socket)
((client empty rest)
- (run-fetch (bv->string rest)
- #:reply (reply socket client))))
+ (run-fetch (bv->string rest))))
(loop))))))
@@ -627,6 +629,7 @@ exiting."
(backend-port (assoc-ref opts 'backend-port))
(publish-port (assoc-ref opts 'publish-port))
(cache (assoc-ref opts 'cache))
+ (database (assoc-ref opts 'database))
(log-directory (assoc-ref opts 'log-directory))
(user (assoc-ref opts 'user))
(public-key
@@ -639,6 +642,7 @@ exiting."
(parameterize ((%add-to-store? add-to-store?)
(%cache-directory cache)
(%log-directory log-directory)
+ (%package-database database)
(%public-key public-key)
(%private-key private-key))
(when user
@@ -666,5 +670,7 @@ exiting."
(string-append "fetch-worker-" (number->string number))))
(iota 4))
- (zmq-init!)
- (zmq-start-proxy backend-port)))))
+ (with-database
+ (with-queue-writer-worker
+ (zmq-init!)
+ (zmq-start-proxy backend-port)))))))
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 8f1ffae..768fce8 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -89,7 +89,6 @@
remote-build-init!
remote-build-socket
remote-send-workers
- remote-build
remote-build-poll))
@@ -402,37 +401,6 @@ retries a call to PROC."
(list (make-bytevector 0)
(string->bv (zmq-request-workers)))))
-(define* (remote-build socket builds)
- "Builds DRVS using the remote build mechanism. A build command is sent on
-SOCKET to the build server for each derivation.
-
-SYSTEMS is a list describing the systems of each derivations in the DRVS list.
-It is used for performance reasons, so that the remote server doesn't need to
-call 'read-derivation-from-file' for each derivation, which can be an
-expensive operation."
- (for-each
- (lambda (build)
- (let ((drv (assq-ref build #:derivation))
- (system (assq-ref build #:system))
- (timestamp (assq-ref build #:timestamp))
- (priority (assq-ref build #:priority))
- (max-silent (assq-ref build #:max-silent))
- (timeout (assq-ref build #:timeout)))
- ;; We need to prefix the command with an empty delimiter because the
- ;; DEALER socket is connected to a ROUTER socket. See "zmq-start-proxy"
- ;; procedure.
- (zmq-send-msg-parts-bytevector
- socket
- (list (make-bytevector 0)
- (string->bv
- (zmq-build-request-message drv
- #:priority priority
- #:timeout timeout
- #:max-silent max-silent
- #:timestamp timestamp
- #:system system))))))
- builds))
-
(define* (remote-build-poll socket event-proc
#:key
(timeout 1000))
@@ -440,13 +408,6 @@ expensive operation."
received, return if no event occured for TIMEOUT milliseconds."
(define (parse-result result)
(match (zmq-read-message result)
- (('build-started ('drv drv) ('worker worker))
- (event-proc (list 'build-started drv))
- (event-proc (list 'build-remote drv worker)))
- (('build-succeeded ('drv drv) ('url url) ('log log))
- (event-proc (list 'build-succeeded/log drv log)))
- (('build-failed ('drv drv) ('url url) ('log log))
- (event-proc (list 'build-failed/log drv log)))
(('workers workers)
(event-proc (list 'workers workers)))))
diff --git a/src/schema.sql b/src/schema.sql
index c0521cb..761b48f 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -117,6 +117,7 @@ CREATE INDEX Builds_timestamp_stoptime on Builds(timestamp,
stoptime);
CREATE INDEX Builds_stoptime on Builds(stoptime DESC);
CREATE INDEX Builds_stoptime_id on Builds(stoptime DESC, id DESC);
CREATE INDEX Builds_status_ts_id on Builds(status DESC, timestamp DESC, id
ASC);
+CREATE INDEX Builds_priority_timestamp on Builds(priority DESC, timestamp ASC);
CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id
DESC);
diff --git a/src/sql/upgrade-19.sql b/src/sql/upgrade-19.sql
index fc41d0c..4213e11 100644
--- a/src/sql/upgrade-19.sql
+++ b/src/sql/upgrade-19.sql
@@ -6,4 +6,6 @@ ALTER TABLE Builds ADD priority INTEGER NOT NULL DEFAULT 0;
ALTER TABLE Builds ADD max_silent INTEGER NOT NULL DEFAULT 0;
ALTER TABLE Builds ADD timeout INTEGER NOT NULL DEFAULT 0;
+CREATE INDEX Builds_priority_timestamp on Builds(priority DESC, timestamp ASC);
+
COMMIT;