store: Add 'query-failed-paths' and 'clear-failed-paths' RPCs.
Suggested by Mark H Weaver <mhw@netris.org>. * guix/store.scm (query-failed-paths, clear-failed-paths): New procedures. * tests/guix-daemon.sh: Add test with daemon started with --cache-failures.
This commit is contained in:
parent
df0a3b7f9e
commit
16748d8015
|
@ -67,6 +67,8 @@
|
|||
add-to-store
|
||||
build-things
|
||||
build
|
||||
query-failed-paths
|
||||
clear-failed-paths
|
||||
add-temp-root
|
||||
add-indirect-root
|
||||
add-permanent-root
|
||||
|
@ -889,6 +891,19 @@ PATHS---i.e., PATHS and all their dependencies."
|
|||
(and (export-path server head port #:sign? sign?)
|
||||
(loop tail))))))
|
||||
|
||||
(define-operation (query-failed-paths)
|
||||
"Return the list of store items for which a build failure is cached.
|
||||
|
||||
The result is always the empty list unless the daemon was started with
|
||||
'--cache-failures'."
|
||||
store-path-list)
|
||||
|
||||
(define-operation (clear-failed-paths (store-path-list items))
|
||||
"Remove ITEMS from the list of cached build failures.
|
||||
|
||||
This makes sense only when the daemon was started with '--cache-failures'."
|
||||
boolean)
|
||||
|
||||
(define* (register-path path
|
||||
#:key (references '()) deriver prefix
|
||||
state-directory)
|
||||
|
|
|
@ -65,7 +65,7 @@ guile -c "
|
|||
socket="$NIX_STATE_DIR/alternate-socket"
|
||||
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
|
||||
daemon_pid=$!
|
||||
trap "kill $daemon_pid" EXIT
|
||||
trap 'kill $daemon_pid' EXIT
|
||||
|
||||
# Make sure we DON'T see the substitute.
|
||||
guile -c "
|
||||
|
@ -77,3 +77,40 @@ guile -c "
|
|||
#:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
|
||||
|
||||
(exit (not (has-substitutes? store \"$out\")))"
|
||||
|
||||
kill "$daemon_pid"
|
||||
|
||||
|
||||
# Check the failed build cache.
|
||||
|
||||
guix-daemon --no-substitutes --listen="$socket" --disable-chroot \
|
||||
--cache-failures &
|
||||
daemon_pid=$!
|
||||
|
||||
guile -c "
|
||||
(use-modules (guix) (guix tests) (srfi srfi-34))
|
||||
(define store (open-connection-for-tests \"$socket\"))
|
||||
|
||||
(define (build-without-failing drv)
|
||||
(lambda (store)
|
||||
(guard (c ((nix-protocol-error? c) (values #t store)))
|
||||
(build-derivations store (list drv))
|
||||
(values #f store))))
|
||||
|
||||
;; Make sure failed builds are cached and can be removed from
|
||||
;; the cache.
|
||||
(run-with-store store
|
||||
(mlet* %store-monad ((drv (gexp->derivation \"failure\"
|
||||
#~(begin
|
||||
(ungexp output)
|
||||
#f)))
|
||||
(out -> (derivation->output-path drv))
|
||||
(ok? (build-without-failing drv)))
|
||||
;; Note the mixture of monadic and direct style. Don't try
|
||||
;; this at home!
|
||||
(return (exit (and ok?
|
||||
(equal? (query-failed-paths store) (list out))
|
||||
(begin
|
||||
(clear-failed-paths store (list out))
|
||||
(null? (query-failed-paths store)))))))
|
||||
#:guile-for-build (%guile-for-build)) "
|
||||
|
|
Loading…
Reference in New Issue