01/16: syscalls: 'with-file-lock' re-grabs lock when reentering its dynamic extent.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 9a067fe7ee3978a2f4f0ca0e89965f0fe49f4ce8
Author: Ludovic Courtès <address@hidden>
AuthorDate: Thu Mar 19 11:14:29 2020 +0100

    syscalls: 'with-file-lock' re-grabs lock when reentering its dynamic extent.
    
    * guix/build/syscalls.scm (call-with-file-lock)
    (call-with-file-lock/no-wait): Initialize PORT in the 'dynamic-wind'
    "in" handler.  This allows us to re-enter a captured continuation and
    have the lock grabbed anew.
---
 guix/build/syscalls.scm | 64 +++++++++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 31 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index ae79a97..0938ec0 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1104,47 +1104,49 @@ exception if it's already taken."
   #t)
 
 (define (call-with-file-lock file thunk)
-  (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))))))
+  (let ((port #f))
     (dynamic-wind
       (lambda ()
-        #t)
+        (set! 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))))))
       thunk
       (lambda ()
         (when port
           (unlock-file port))))))
 
 (define (call-with-file-lock/no-wait file thunk handler)
-  (let ((port (catch #t
-                (lambda ()
-                  (lock-file file #:wait? #f))
-                (lambda (key . args)
-                  (match key
-                    ('flock-error
-                     (apply handler args)
-                     ;; No open port to the lock, so return #f.
-                     #f)
-                    ('system-error
-                      ;; 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 (cons key args)))
-                          #f
-                          (apply throw key args)))
-                    (_ (apply throw key args)))))))
+  (let ((port #f))
     (dynamic-wind
       (lambda ()
-        #t)
+        (set! port
+          (catch #t
+            (lambda ()
+              (lock-file file #:wait? #f))
+            (lambda (key . args)
+              (match key
+                ('flock-error
+                 (apply handler args)
+                 ;; No open port to the lock, so return #f.
+                 #f)
+                ('system-error
+                 ;; 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 (cons key args)))
+                     #f
+                     (apply throw key args)))
+                (_ (apply throw key args)))))))
       thunk
       (lambda ()
         (when port