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

Revert "inferior: Break cached-channel-instance into two procedures."

Browse Source 
This reverts commit 7d63b77551 because it raises
some concerns, see:
https://lists.gnu.org/archive/html/guix-devel/2021-03/msg00124.html.
This commit is contained in:
Mathieu Othacehe 2021-03-10 11:28:35 +01:00
parent e5f89570c1
commit 8898eaec57
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 29 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
guix/inferior.scm
View File

@ -98,8 +98,7 @@
gexp->derivation-in-inferior gexp->derivation-in-inferior
%inferior-cache-directory %inferior-cache-directory
channels->cached-profile cached-channel-instance
instances->cached-profile
inferior-for-channels)) inferior-for-channels))
;;; Commentary: ;;; Commentary:
@ -709,14 +708,22 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
#:check-out? #f))) #:check-out? #f)))
commit)))) commit))))
(define* (cached-profile store instances (define* (cached-channel-instance store
#:key channels
cache-directory #:key
commits ttl) (authenticate? #t)
"Return a directory containing a guix filetree defined by INSTANCES, a (cache-directory (%inferior-cache-directory))
procedure returning a list of channel instances. The directory is a (ttl (* 3600 24 30)))
subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
seconds. This procedure opens a new connection to the build daemon." 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. AUTHENTICATE?
determines whether CHANNELS are authenticated."
(define commits
;; Since computing the instances of CHANNELS is I/O-intensive, use a
;; cheaper way to get the commit list of CHANNELS. This limits overhead
;; to the minimum in case of a cache hit.
(map channel-full-commit channels))
(define key (define key
(bytevector->base32-string (bytevector->base32-string
(sha256 (sha256
@ -748,8 +755,12 @@ seconds. This procedure opens a new connection to the build daemon."
(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 ((instances
(channel-instances->derivation (instances)))) -> (latest-channel-instances store channels
#:authenticate?
authenticate?))
(profile
(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))
@ -760,45 +771,6 @@ seconds. This procedure opens a new connection to the build daemon."
(add-indirect-root* cached)) (add-indirect-root* cached))
(return cached)))))) (return cached))))))
(define* (channels->cached-profile store channels
#:key
(authenticate? #t)
(cache-directory
(%inferior-cache-directory))
(ttl (* 3600 24 30)))
"Return a cached profile from CHANNELS using the CACHED-PROFILE procedure.
AUTHENTICATE? determines whether CHANNELS are authenticated."
(define commits
;; Since computing the instances of CHANNELS is I/O-intensive, use a
;; cheaper way to get the commit list of CHANNELS. This limits overhead
;; to the minimum in case of a cache hit.
(map channel-full-commit channels))
(define instances
(lambda ()
(latest-channel-instances store channels
#:authenticate? authenticate?)))
(cached-profile store instances
#:cache-directory cache-directory
#:commits commits
#:ttl ttl))
(define* (instances->cached-profile store instances
#:key
(cache-directory
(%inferior-cache-directory))
(ttl (* 3600 24 30)))
"Return a cached profile from INSTANCES a list of channel instances using
the CACHED-PROFILE procedure."
(define commits
(map channel-instance-commit instances))
(cached-profile store (lambda () instances)
#:cache-directory cache-directory
#:commits commits
#:ttl ttl))
(define* (inferior-for-channels channels (define* (inferior-for-channels channels
#:key #:key
(cache-directory (%inferior-cache-directory)) (cache-directory (%inferior-cache-directory))
@ -811,10 +783,10 @@ 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
(with-store store (with-store store
(channels->cached-profile store (cached-channel-instance store
channels channels
#:cache-directory cache-directory #:cache-directory cache-directory
#:ttl ttl))) #:ttl ttl)))
(open-inferior cached)) (open-inferior cached))
;;; Local Variables: ;;; Local Variables:

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

@ -142,8 +142,7 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(with-store store (with-store store
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(channels->cached-profile (cached-channel-instance store channels
store channels #:authenticate? authenticate?))))
#:authenticate? authenticate?))))
(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))))))))