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:
Ludovic Courtès 2015-09-28 21:32:17 +02:00
parent df0a3b7f9e
commit 16748d8015
2 changed files with 53 additions and 1 deletions

View File

@ -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)

View File

@ -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)) "