diff options
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 14 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 44 | ||||
| -rw-r--r-- | guix-build-coordinator/hooks.scm | 42 |
3 files changed, 94 insertions, 6 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 23c119c..9aa7f55 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -71,10 +71,13 @@ if there was no request body." fixed/read-request-body) (define (http-agent-messaging-start-server port host secret-key-base - datastore) + datastore hooks) (define build-allocator-channel (make-build-allocator-channel datastore)) + (define hook-channel + (make-hook-channel datastore hooks)) + (define (trigger-build-allocation) (put-message build-allocator-channel #t)) @@ -94,7 +97,8 @@ if there was no request body." body secret-key-base datastore - trigger-build-allocation))) + trigger-build-allocation + hook-channel))) 'http (list #:host host #:port port))) @@ -131,7 +135,8 @@ port. Also, the port used can be changed by passing the --port option.\n" body secret-key-base datastore - trigger-build-allocation) + trigger-build-allocation + hook-channel) (define (authenticated? uuid request) (let* ((authorization-base64 (match (assq-ref (request-headers request) @@ -183,7 +188,8 @@ port. Also, the port used can be changed by passing the --port option.\n" (datastore-agent-for-build datastore uuid))) (if (authenticated? agent-id-for-build request) (begin - (handle-build-result datastore agent-id-for-build uuid + (handle-build-result datastore hook-channel + agent-id-for-build uuid (json-string->scm (utf8->string body))) ;; Trigger build allocation, as the result of this build could ;; change the allocation diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index ece04a3..c0e7cb1 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -35,6 +35,7 @@ fetch-builds agent-details make-build-allocator-channel + make-hook-channel build-output-file-location handle-build-result @@ -100,6 +101,37 @@ channel)) +(define (make-hook-channel datastore hooks) + (let ((channel (make-channel))) + (call-with-new-thread + (lambda () + (let loop ((message (get-message channel))) + (match message + (('build-success build-id) + (catch + #t + (lambda () + ((assq-ref hooks 'build-success) datastore build-id)) + (lambda (key . args) + (simple-format #t "error: running build-success hook: ~A ~A\n" + key args) + #f))) + (('build-failure build-id) + (catch + #t + (lambda () + ((assq-ref hooks 'build-failure) datastore build-id)) + (lambda (key . args) + (simple-format #t "error: running build-failure hook: ~A ~A\n" + key args) + #f))) + (unknown + (simple-format #t "error: hooks: unknown message: ~A\n" + unknown))) + (loop (get-message channel))))) + + channel)) + (define (fetch-builds datastore agent) (let ((builds (datastore-list-allocation-plan-builds datastore @@ -128,7 +160,8 @@ (basename output) ".nar.lz"))) -(define (handle-build-result datastore agent-id build-id result-json) +(define (handle-build-result datastore hook-channel + agent-id build-id result-json) (let ((result (assoc-ref result-json "result"))) (datastore-store-build-result datastore build-id @@ -136,7 +169,14 @@ (if (string=? result "success") "success" "failure") - #f))) ; TODO + #f) ;; TODO + + (put-message hook-channel + (list (if (string=? result "success") + 'build-success + 'build-failure) + build-id)))) + (define (handle-setup-failure-report datastore agent-id build-id report-json) (let ((failure-reason (assoc-ref report-json "failure_reason"))) diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm new file mode 100644 index 0000000..ed0b890 --- /dev/null +++ b/guix-build-coordinator/hooks.scm @@ -0,0 +1,42 @@ +;;; Guix Build Coordinator +;;; +;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> +;;; +;;; This file is part of the guix-build-coordinator. +;;; +;;; The Guix Build Coordinator is free software; you can redistribute +;;; it and/or modify it under the terms of the GNU General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; The Guix Build Coordinator is distributed in the hope that it will +;;; be useful, but WITHOUT ANY WARRANTY; without even the implied +;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +;;; See the GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with the guix-data-service. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (guix-build-coordinator hooks) + #:use-module (guix-build-coordinator datastore) + #:export (default-build-success-hook + default-build-failure-hook)) + +(define (default-build-success-hook datastore build-id) + (let ((agent-id + (datastore-agent-for-build datastore build-id))) + (display + (simple-format #f + "build ~A succeeded (on agent ~A)\n" + build-id agent-id) + (current-error-port)))) + +(define* (default-build-failure-hook datastore build-id) + (let ((agent-id + (datastore-agent-for-build datastore build-id))) + (display + (simple-format #f + "build ~A failed (on agent ~A)\n" + build-id agent-id) + (current-error-port)))) |