bug#35996: User account password got locked when booting old generation

["Ludovic Courtès" <ludo@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 844 bytes --]

Hello,

"pelzflorian (Florian Pelz)" <pelzflorian@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’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-syscalls-Add-with-file-lock-macro.patch --]
[-- Type: text/x-patch, Size: 3661 bytes --]

From e26d9759ebe58c93e7eb449ea6bd3317b2840e99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@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)))))
+
 \f
 ;;;
 ;;; 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-syscalls-with-file-lock-expands-to-a-call-to-call-wi.patch --]
[-- Type: text/x-patch, Size: 1301 bytes --]

From cf802dcd04425ce783714d70444b023902b36947 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@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 ...)))
+
 \f
 ;;;
 ;;; Miscellaneous, aka. 'prctl'.
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-syscalls-with-lock-file-catches-ENOSYS.patch --]
[-- Type: text/x-patch, Size: 1553 bytes --]

From 7ddcb15289a25a478a6bf7f353f2b4754b4af017 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-activation-Lock-etc-.pwd.lock-before-accessing-datab.patch --]
[-- Type: text/x-patch, Size: 3785 bytes --]

From fffb20dddfd8b5def7255874ce38061acd7f7d10 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@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 <pelzflorian@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


[-- Attachment #6: 0005-nar-Really-lock-store-files.patch --]
[-- Type: text/x-patch, Size: 3509 bytes --]

From dbe1fbab1e7d46258b20382d1587d18e915a5fee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Mark H Weaver <mhw@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