ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: package: lock profiles when processing them.

Browse source 
* guix/scripts/package.scm (process-actions): Get a per-profile lock to
prevent concurrent actions on profiles.
* tests/guix-package.sh: Add test.
This commit is contained in:
Julien Lepiller 2019-10-25 21:39:21 +02:00
parent f49e913188
commit b1fb663404
No known key found for this signature in database
GPG key ID: 43111F4520086A0C
2 changed files with 46 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
guix/scripts/package.scm
View file

@ -42,6 +42,8 @@ (define-module (guix scripts package)
#:autoload (guix store roots) (gc-roots)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p))
#:use-module ((guix build syscalls)
#:select (with-file-lock/no-wait))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@ -876,36 +878,44 @@ (define (transform-entry entry)
(package-version item)
(manifest-entry-version entry))))))
;; First, process roll-backs, generation removals, etc.
(for-each (match-lambda
((key . arg)
(and=> (assoc-ref %actions key)
(lambda (proc)
(proc store profile arg opts
#:dry-run? dry-run?)))))
opts)
;; Then, process normal package removal/installation/upgrade.
(let* ((manifest (profile-manifest profile))
(step1 (options->removable opts manifest
(manifest-transaction)))
(step2 (options->installable opts manifest step1))
(step3 (manifest-transaction
(inherit step2)
(install (map transform-entry
(manifest-transaction-install step2)))))
(new (manifest-perform-transaction manifest step3)))
;; First, acquire a lock on the profile, to ensure only one guix process
;; is modifying it at a time.
(with-file-lock/no-wait (string-append profile ".lock")
(lambda (key . args)
(leave (G_ "profile ~a is locked by another process~%")
profile))
(warn-about-old-distro)
;; Then, process roll-backs, generation removals, etc.
(for-each (match-lambda
((key . arg)
(and=> (assoc-ref %actions key)
(lambda (proc)
(proc store profile arg opts
#:dry-run? dry-run?)))))
opts)
(unless (manifest-transaction-null? step3)
(show-manifest-transaction store manifest step3
#:dry-run? dry-run?)
(build-and-use-profile store profile new
#:allow-collisions? allow-collisions?
#:bootstrap? bootstrap?
#:use-substitutes? substitutes?
#:dry-run? dry-run?))))
;; Then, process normal package removal/installation/upgrade.
(let* ((manifest (profile-manifest profile))
(step1 (options->removable opts manifest
(manifest-transaction)))
(step2 (options->installable opts manifest step1))
(step3 (manifest-transaction
(inherit step2)
(install (map transform-entry
(manifest-transaction-install step2)))))
(new (manifest-perform-transaction manifest step3)))
(warn-about-old-distro)
(unless (manifest-transaction-null? step3)
(show-manifest-transaction store manifest step3
#:dry-run? dry-run?)
(build-and-use-profile store profile new
#:allow-collisions? allow-collisions?
#:bootstrap? bootstrap?
#:use-substitutes? substitutes?
#:dry-run? dry-run?)))))
;;;

10
tests/guix-package.sh
View file

@ -33,7 +33,7 @@ profile="t-profile-$$"
tmpfile="t-guix-package-file-$$"
rm -f "$profile" "$tmpfile"
trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT
trap 'rm -f "$profile" "$profile.lock" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT
# Use `-e' with a non-package expression.
if guix package --bootstrap -e +;
@ -452,3 +452,11 @@ rm -rf "$module_dir"
# Make sure we can see user profiles.
guix package --list-profiles | grep "$profile"
guix package --list-profiles | grep '\.guix-profile'
# Make sure we can properly lock a profile.
mkdir "$module_dir"
echo '(sleep 60)' > "$module_dir/manifest.scm"
guix package -m "$module_dir/manifest.scm" -p "$module_dir/profile" &
pid=$!
if guix install emacs -p "$module_dir/profile"; then kill $pid; false; else true; fi
kill $pid