[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Ludovic Courtès |
Date: |
Fri, 26 Jan 2018 09:24:03 -0500 (EST) |
branch: master
commit 047e9271268f7f35df9741950fc2ae462d551ed2
Author: Ludovic Courtès <address@hidden>
Date: Fri Jan 26 14:04:41 2018 +0100
base: Do not pass bogus store file names to 'db-update-build-status!'.
* src/cuirass/base.scm (handle-build-event)[valid?]: New procedure.
Use it when handling 'build-started', 'build-succeeded', and
'build-failed' events.
---
src/cuirass/base.scm | 28 ++++++++++++++++++++++------
1 file changed, 22 insertions(+), 6 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 9e80766..574a42e 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -337,18 +337,34 @@ MAX-BATCH-SIZE items."
(define* (handle-build-event db event)
"Handle EVENT, a build event sexp as produced by 'build-event-output-port',
updating DB accordingly."
+ (define (valid? file)
+ ;; FIXME: Sometimes we might get bogus events due to the interleaving of
+ ;; build messages. This procedure prevents us from propagating the bogus
+ ;; file name to the database.
+ (and (store-path? file)
+ (string-suffix? ".drv" file)))
+
(match event
(('build-started drv _ ...)
- (log-message "build started: '~a'" drv)
- (db-update-build-status! db drv (build-status started)))
+ (if (valid? drv)
+ (begin
+ (log-message "build started: '~a'" drv)
+ (db-update-build-status! db drv (build-status started)))
+ (log-message "bogus build-started event for '~a'" drv)))
(('build-remote drv host _ ...)
(log-message "'~a' offloaded to '~a'" drv host))
(('build-succeeded drv _ ...)
- (log-message "build succeeded: '~a'" drv)
- (db-update-build-status! db drv (build-status succeeded)))
+ (if (valid? drv)
+ (begin
+ (log-message "build succeeded: '~a'" drv)
+ (db-update-build-status! db drv (build-status succeeded)))
+ (log-message "bogus build-succeeded event for '~a'" drv)))
(('build-failed drv _ ...)
- (log-message "build failed: '~a'" drv)
- (db-update-build-status! db drv (build-status failed)))
+ (if (valid? drv)
+ (begin
+ (log-message "build failed: '~a'" drv)
+ (db-update-build-status! db drv (build-status failed)))
+ (log-message "bogus build-failed event for '~a'" drv)))
(('substituter-started item _ ...)
(log-message "substituter started: '~a'" item))
(('substituter-succeeded item _ ...)
- master updated (77769c2 -> 39cf6e6), Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject],
Ludovic Courtès <=
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26
- [no subject], Ludovic Courtès, 2018/01/26