futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

inferior: 'cached-channel-instance' takes an open store connection.

Browse Source 
* guix/inferior.scm (cached-channel-instance): Take an explicit 'store'
argument.
(inferior-for-channels): Wrap call to 'cached-channel-instance' in
'with-store'.
* guix/time-machine.scm (guix-time-machine): Wrap call to
'cached-channel-instance' in 'with-store'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Konrad Hinsen 2019-11-12 16:39:46 +01:00 committed by Ludovic Courtès
parent f675f8dec7
commit 1d5485690b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 45 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
guix/inferior.scm
View File

@ -636,58 +636,57 @@ failing when GUIX is too old and lacks the 'guix repl' command."
(make-parameter (string-append (cache-directory #:ensure? #f) (make-parameter (string-append (cache-directory #:ensure? #f)
"/inferiors"))) "/inferiors")))
(define* (cached-channel-instance channels (define* (cached-channel-instance store
channels
#:key #:key
(cache-directory (%inferior-cache-directory)) (cache-directory (%inferior-cache-directory))
(ttl (* 3600 24 30))) (ttl (* 3600 24 30)))
"Return a directory containing a guix filetree defined by CHANNELS, a list of channels. "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
This procedure opens a new connection to the build daemon." This procedure opens a new connection to the build daemon."
(with-store store (define instances
(let () (latest-channel-instances store channels))
(define instances
(latest-channel-instances store channels))
(define key (define key
(bytevector->base32-string (bytevector->base32-string
(sha256 (sha256
(string->utf8 (string->utf8
(string-concatenate (map channel-instance-commit instances)))))) (string-concatenate (map channel-instance-commit instances))))))
(define cached (define cached
(string-append cache-directory "/" key)) (string-append cache-directory "/" key))
(define (base32-encoded-sha256? str) (define (base32-encoded-sha256? str)
(= (string-length str) 52)) (= (string-length str) 52))
(define (cache-entries directory) (define (cache-entries directory)
(map (lambda (file) (map (lambda (file)
(string-append directory "/" file)) (string-append directory "/" file))
(scandir directory base32-encoded-sha256?))) (scandir directory base32-encoded-sha256?)))
(define symlink* (define symlink*
(lift2 symlink %store-monad)) (lift2 symlink %store-monad))
(define add-indirect-root* (define add-indirect-root*
(store-lift add-indirect-root)) (store-lift add-indirect-root))
(mkdir-p cache-directory) (mkdir-p cache-directory)
(maybe-remove-expired-cache-entries cache-directory (maybe-remove-expired-cache-entries cache-directory
cache-entries cache-entries
#:entry-expiration #:entry-expiration
(file-expiration-time ttl)) (file-expiration-time ttl))
(if (file-exists? cached) (if (file-exists? cached)
cached cached
(run-with-store store (run-with-store store
(mlet %store-monad ((profile (mlet %store-monad ((profile
(channel-instances->derivation instances))) (channel-instances->derivation instances)))
(mbegin %store-monad (mbegin %store-monad
(show-what-to-build* (list profile)) (show-what-to-build* (list profile))
(built-derivations (list profile)) (built-derivations (list profile))
(symlink* (derivation->output-path profile) cached) (symlink* (derivation->output-path profile) cached)
(add-indirect-root* cached) (add-indirect-root* cached)
(return cached)))))))) (return cached))))))
(define* (inferior-for-channels channels (define* (inferior-for-channels channels
#:key #:key
@ -700,7 +699,9 @@ procedure opens a new connection to the build daemon.
This is a convenience procedure that people may use in manifests passed to This is a convenience procedure that people may use in manifests passed to
'guix package -m', for instance." 'guix package -m', for instance."
(define cached (define cached
(cached-channel-instance channels (with-store store
#:cache-directory cache-directory (cached-channel-instance store
#:ttl ttl)) channels
#:cache-directory cache-directory
#:ttl ttl)))
(open-inferior cached)) (open-inferior cached))

4
guix/scripts/time-machine.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix inferior) #:use-module (guix inferior)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module (guix store)
#:use-module ((guix scripts pull) #:select (channel-list)) #:use-module ((guix scripts pull) #:select (channel-list))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -97,6 +98,7 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(channels (channel-list opts)) (channels (channel-list opts))
(command-line (assoc-ref opts 'exec))) (command-line (assoc-ref opts 'exec)))
(when command-line (when command-line
(let* ((directory (cached-channel-instance channels)) (let* ((directory (with-store store
(cached-channel-instance store channels)))
(executable (string-append directory "/bin/guix"))) (executable (string-append directory "/bin/guix")))
(apply execl (cons* executable executable command-line))))))) (apply execl (cons* executable executable command-line)))))))