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
|
add-to-store
|
||||||
build-things
|
build-things
|
||||||
build
|
build
|
||||||
|
query-failed-paths
|
||||||
|
clear-failed-paths
|
||||||
add-temp-root
|
add-temp-root
|
||||||
add-indirect-root
|
add-indirect-root
|
||||||
add-permanent-root
|
add-permanent-root
|
||||||
|
@ -889,6 +891,19 @@ PATHS---i.e., PATHS and all their dependencies."
|
||||||
(and (export-path server head port #:sign? sign?)
|
(and (export-path server head port #:sign? sign?)
|
||||||
(loop tail))))))
|
(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
|
(define* (register-path path
|
||||||
#:key (references '()) deriver prefix
|
#:key (references '()) deriver prefix
|
||||||
state-directory)
|
state-directory)
|
||||||
|
|
|
@ -65,7 +65,7 @@ guile -c "
|
||||||
socket="$NIX_STATE_DIR/alternate-socket"
|
socket="$NIX_STATE_DIR/alternate-socket"
|
||||||
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
|
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
|
||||||
daemon_pid=$!
|
daemon_pid=$!
|
||||||
trap "kill $daemon_pid" EXIT
|
trap 'kill $daemon_pid' EXIT
|
||||||
|
|
||||||
# Make sure we DON'T see the substitute.
|
# Make sure we DON'T see the substitute.
|
||||||
guile -c "
|
guile -c "
|
||||||
|
@ -77,3 +77,40 @@ guile -c "
|
||||||
#:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
|
#:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
|
||||||
|
|
||||||
(exit (not (has-substitutes? store \"$out\")))"
|
(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