Hello,
"pelzflorian (Florian Pelz)" <pelzflor...@pelzflorian.de> skribis:
> Please add more logging and/or locking. Note that the elogind has the
> following comment in its locking implementation in
> /gnu/store/dm2ri0qvjirl0iq2ndfk5z9lq9dyk4jf-elogind-241.3-checkout/src/basic/user-util.c:
>
> /* This is roughly the same as lckpwdf(), but not as awful. We
> * don't want to use alarm() and signals, hence we implement
> * our own trivial version of this.
Attach is a set of patches to lock /etc/.pwd.lock when we access
/etc/{passwd,shadow,group} from the activation snippets. It should
ensure that, when running ‘guix system reconfigure’, we’re honoring the
locking protocol that Shadow & co. follow.
It would be great if you could test again in this context.
Thanks!
Ludo’.
>From e26d9759ebe58c93e7eb449ea6bd3317b2840e99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Mon, 3 Jun 2019 16:23:01 +0200
Subject: [PATCH 1/5] syscalls: Add 'with-file-lock' macro.
* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock):
Move to...
* guix/build/syscalls.scm: ... here.
---
.dir-locals.el | 2 ++
guix/build/syscalls.scm | 27 +++++++++++++++++++++++++++
guix/scripts/offload.scm | 25 -------------------------
3 files changed, 29 insertions(+), 25 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index f1196fd781..228685a69f 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -34,6 +34,8 @@
(eval . (put 'modify-services 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
+ (eval . (put 'with-file-lock 'scheme-indent-function 1))
+
(eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'origin 'scheme-indent-function 0))
(eval . (put 'build-system 'scheme-indent-function 0))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3abe65bc4f..04fbebb8a2 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -81,7 +81,11 @@
fdatasync
pivot-root
scandir*
+
fcntl-flock
+ lock-file
+ unlock-file
+ with-file-lock
set-thread-name
thread-name
@@ -1067,6 +1071,29 @@ exception if it's already taken."
;; Presumably we got EAGAIN or so.
(throw 'flock-error err))))))
+(define (lock-file file)
+ "Wait and acquire an exclusive lock on FILE. Return an open port."
+ (let ((port (open-file file "w0")))
+ (fcntl-flock port 'write-lock)
+ port))
+
+(define (unlock-file port)
+ "Unlock PORT, a port returned by 'lock-file'."
+ (fcntl-flock port 'unlock)
+ (close-port port)
+ #t)
+
+(define-syntax-rule (with-file-lock file exp ...)
+ "Wait to acquire a lock on FILE and evaluate EXP in that context."
+ (let ((port (lock-file file)))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ exp ...)
+ (lambda ()
+ (unlock-file port)))))
+
;;;
;;; Miscellaneous, aka. 'prctl'.
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index eb02672dbf..0c0dd9d516 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -236,30 +236,6 @@ instead of '~a' of type '~a'~%")
;;; Synchronization.
;;;
-(define (lock-file file)
- "Wait and acquire an exclusive lock on FILE. Return an open port."
- (mkdir-p (dirname file))
- (let ((port (open-file file "w0")))
- (fcntl-flock port 'write-lock)
- port))
-
-(define (unlock-file lock)
- "Unlock LOCK."
- (fcntl-flock lock 'unlock)
- (close-port lock)
- #t)
-
-(define-syntax-rule (with-file-lock file exp ...)
- "Wait to acquire a lock on FILE and evaluate EXP in that context."
- (let ((port (lock-file file)))
- (dynamic-wind
- (lambda ()
- #t)
- (lambda ()
- exp ...)
- (lambda ()
- (unlock-file port)))))
-
(define (machine-slot-file machine slot)
"Return the file name of MACHINE's file for SLOT."
;; For each machine we have a bunch of files representing each build slot.
@@ -829,7 +805,6 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
(leave (G_ "invalid arguments: ~{~s ~}~%") x))))
;;; Local Variables:
-;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
;;; eval: (put 'with-timeout 'scheme-indent-function 2)
;;; End:
--
2.21.0
>From cf802dcd04425ce783714d70444b023902b36947 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Mon, 3 Jun 2019 16:24:31 +0200
Subject: [PATCH 2/5] syscalls: 'with-file-lock' expands to a call to
'call-with-file-lock'.
* guix/build/syscalls.scm (call-with-file-lock): New procedure.
(with-file-lock): Expand to a call to 'call-with-file-lock'.
---
guix/build/syscalls.scm | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 04fbebb8a2..3af41f2cf5 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1083,17 +1083,19 @@ exception if it's already taken."
(close-port port)
#t)
-(define-syntax-rule (with-file-lock file exp ...)
- "Wait to acquire a lock on FILE and evaluate EXP in that context."
+(define (call-with-file-lock file thunk)
(let ((port (lock-file file)))
(dynamic-wind
(lambda ()
#t)
- (lambda ()
- exp ...)
+ thunk
(lambda ()
(unlock-file port)))))
+(define-syntax-rule (with-file-lock file exp ...)
+ "Wait to acquire a lock on FILE and evaluate EXP in that context."
+ (call-with-file-lock file (lambda () exp ...)))
+
;;;
;;; Miscellaneous, aka. 'prctl'.
--
2.21.0
>From 7ddcb15289a25a478a6bf7f353f2b4754b4af017 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Mon, 3 Jun 2019 17:13:30 +0200
Subject: [PATCH 3/5] syscalls: 'with-lock-file' catches ENOSYS.
* guix/build/syscalls.scm (call-with-file-lock): Catch ENOSYS raised by
'lock-file'.
---
guix/build/syscalls.scm | 15 +++++++++++++--
1 file changed, 13 insertions(+), 2 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3af41f2cf5..5c2eb3c14d 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1084,13 +1084,24 @@ exception if it's already taken."
#t)
(define (call-with-file-lock file thunk)
- (let ((port (lock-file file)))
+ (let ((port (catch 'system-error
+ (lambda ()
+ (lock-file file))
+ (lambda args
+ ;; When using the statically-linked Guile in the initrd,
+ ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
+ ;; that error since we're typically the only process running
+ ;; at this point.
+ (if (= ENOSYS (system-error-errno args))
+ #f
+ (apply throw args))))))
(dynamic-wind
(lambda ()
#t)
thunk
(lambda ()
- (unlock-file port)))))
+ (when port
+ (unlock-file port))))))
(define-syntax-rule (with-file-lock file exp ...)
"Wait to acquire a lock on FILE and evaluate EXP in that context."
--
2.21.0
>From fffb20dddfd8b5def7255874ce38061acd7f7d10 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Mon, 3 Jun 2019 17:14:17 +0200
Subject: [PATCH 4/5] activation: Lock /etc/.pwd.lock before accessing
databases.
Fixes <http://bugs.gnu.org/35996>.
Reported by Florian Pelz <pelzflor...@pelzflorian.de>.
* gnu/build/accounts.scm (%password-lock-file): New variable.
* gnu/build/activation.scm (activate-users+groups): Wrap calls to
'user+group-databases', 'write-group', etc. into 'with-file-lock'.
---
gnu/build/accounts.scm | 6 ++++++
gnu/build/activation.scm | 33 +++++++++++++++++++--------------
2 files changed, 25 insertions(+), 14 deletions(-)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index c43ce85b60..8687446aa6 100644
--- a/gnu/build/accounts.scm
+++ b/gnu/build/accounts.scm
@@ -51,6 +51,7 @@
group-entry-gid
group-entry-members
+ %password-lock-file
write-group
write-passwd
write-shadow
@@ -224,6 +225,11 @@ each field."
(serialization list->comma-separated comma-separated->list)
(default '())))
+(define %password-lock-file
+ ;; The password database lock file used by libc's 'lckpwdf'. Users should
+ ;; grab this lock with 'with-file-lock' when they access the databases.
+ "/etc/.pwd.lock")
+
(define (database-writer file mode entry->string)
(lambda* (entries #:optional (file-or-port file))
"Write ENTRIES to FILE-OR-PORT. When FILE-OR-PORT is a file name, write
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index cfdf17df0f..c6c7e7fd3b 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -22,6 +22,7 @@
#:use-module (gnu build accounts)
#:use-module (gnu build linux-boot)
#:use-module (guix build utils)
+ #:use-module ((guix build syscalls) #:select (with-file-lock))
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@@ -129,22 +130,26 @@ group records) are all available."
;; Allow home directories to be created under /var/lib.
(mkdir-p "/var/lib")
- (let-values (((groups passwd shadow)
- (user+group-databases users groups)))
- (write-group groups)
- (write-passwd passwd)
- (write-shadow shadow)
+ ;; Take same lock as libc's 'lckpwdf' (but without a timeout) while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock %password-lock-file
+ (let-values (((groups passwd shadow)
+ (user+group-databases users groups)))
+ (write-group groups)
+ (write-passwd passwd)
+ (write-shadow shadow)))
- ;; Home directories of non-system accounts are created by
- ;; 'activate-user-home'.
- (for-each make-home-directory system-accounts)
+ ;; Home directories of non-system accounts are created by
+ ;; 'activate-user-home'.
+ (for-each make-home-directory system-accounts)
- ;; Turn shared home directories, such as /var/empty, into root-owned,
- ;; read-only places.
- (for-each (lambda (directory)
- (chown directory 0 0)
- (chmod directory #o555))
- (duplicates (map user-account-home-directory system-accounts)))))
+ ;; Turn shared home directories, such as /var/empty, into root-owned,
+ ;; read-only places.
+ (for-each (lambda (directory)
+ (chown directory 0 0)
+ (chmod directory #o555))
+ (duplicates (map user-account-home-directory system-accounts))))
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
--
2.21.0
>From dbe1fbab1e7d46258b20382d1587d18e915a5fee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Mon, 3 Jun 2019 17:18:41 +0200
Subject: [PATCH 5/5] nar: Really lock store files.
Previously, 'lock-store-file' would immediately close the file
descriptor of the '.lock' file, and thus it would immediately release
the lock.
* guix/nar.scm (lock-store-file, unlock-store-file): Remove.
(finalize-store-file): Use 'lock-file' and 'unlock-file' instead.
---
guix/nar.scm | 42 ++++++++++++++++--------------------------
1 file changed, 16 insertions(+), 26 deletions(-)
diff --git a/guix/nar.scm b/guix/nar.scm
index 8894f10d2b..29636aa0f8 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <l...@gnu.org>
;;; Copyright © 2014 Mark H Weaver <m...@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -76,16 +76,6 @@
;; most of the daemon is in Scheme :-)). But note that we do use a couple of
;; RPCs for functionality not available otherwise, like 'valid-path?'.
-(define (lock-store-file file)
- "Acquire exclusive access to FILE, a store file."
- (call-with-output-file (string-append file ".lock")
- (cut fcntl-flock <> 'write-lock)))
-
-(define (unlock-store-file file)
- "Release access to FILE."
- (call-with-input-file (string-append file ".lock")
- (cut fcntl-flock <> 'unlock)))
-
(define* (finalize-store-file source target
#:key (references '()) deriver (lock? #t))
"Rename SOURCE to TARGET and register TARGET as a valid store item, with
@@ -94,25 +84,25 @@ before attempting to register it; otherwise, assume TARGET's locks are already
held."
(with-database %default-database-file db
(unless (path-id db target)
- (when lock?
- (lock-store-file target))
+ (let ((lock (and lock?
+ (lock-file (string-append target ".lock")))))
- (unless (path-id db target)
- ;; If FILE already exists, delete it (it's invalid anyway.)
- (when (file-exists? target)
- (delete-file-recursively target))
+ (unless (path-id db target)
+ ;; If FILE already exists, delete it (it's invalid anyway.)
+ (when (file-exists? target)
+ (delete-file-recursively target))
- ;; Install the new TARGET.
- (rename-file source target)
+ ;; Install the new TARGET.
+ (rename-file source target)
- ;; Register TARGET. As a side effect, it resets the timestamps of all
- ;; its files, recursively, and runs a deduplication pass.
- (register-path target
- #:references references
- #:deriver deriver))
+ ;; Register TARGET. As a side effect, it resets the timestamps of all
+ ;; its files, recursively, and runs a deduplication pass.
+ (register-path target
+ #:references references
+ #:deriver deriver))
- (when lock?
- (unlock-store-file target)))))
+ (when lock?
+ (unlock-file lock))))))
(define (temporary-store-file)
"Return the file name of a temporary file created in the store."
--
2.21.0
