Block asyncs when starting inferiors

Because this code deals with global state, like environment variables.

1 files changed, 86 insertions, 84 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 6913e39..d5170b8 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1330,95 +1330,97 @@
 
 (define (start-inferior-for-data-extration store store-path guix-locpath
                                            extra-inferior-environment-variables)
-  (let* ((original-guix-locpath (getenv "GUIX_LOCPATH"))
-         (original-extra-env-vars-values
-          (map (match-lambda
-                 ((key . _)
-                  (getenv key)))
-               extra-inferior-environment-variables))
-         (inf (begin
-                ;; Unset the GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH to
-                ;; avoid the values for these being used in the
-                ;; inferior. Even though the inferior %load-path and
-                ;; %load-compiled-path has the inferior modules first, this
-                ;; can cause issues when there are modules present outside
-                ;; of the inferior Guix which aren't present in the inferior
-                ;; Guix (like the new (guix lint) module
-                (unsetenv "GUILE_LOAD_PATH")
-                (unsetenv "GUILE_LOAD_COMPILED_PATH")
-                (simple-format (current-error-port) "debug: set GUIX_LOCPATH to ~A\n"
-                               guix-locpath)
-                (for-each
-                 (match-lambda
-                   ((key . val)
-                    (simple-format (current-error-port)
-                                   "debug: set ~A to ~A\n"
-                                   key val)
-                    (setenv key val)))
-                 extra-inferior-environment-variables)
-
-                (if (defined?
-                      'open-inferior/container
-                      (resolve-module '(guix inferior)))
-                    (open-inferior/container store store-path
-                                             #:extra-shared-directories
-                                             '("/gnu/store")
-                                             #:extra-environment-variables
-                                             (list (string-append
-                                                    "GUIX_LOCPATH="
-                                                    guix-locpath)))
-                    (begin
-                      (setenv "GUIX_LOCPATH" guix-locpath)
-                      (simple-format #t "debug: using open-inferior\n")
-                      (open-inferior store-path
-                                     #:error-port (current-error-port)))))))
-    (setenv "GUIX_LOCPATH" original-guix-locpath) ; restore GUIX_LOCPATH
-    (for-each
-     (lambda (key val)
-       (setenv key val))
-     (map car extra-inferior-environment-variables)
-     original-extra-env-vars-values)
-
-    (when (eq? inf #f)
-      (error "error: inferior is #f"))
-
-    ;; Normalise the locale for the inferior process
-    (with-exception-handler
-        (lambda (key . args)
-          (simple-format
-           (current-error-port)
-           "warning: failed to set locale to en_US.UTF-8: ~A ~A\n"
-           key args))
-      (lambda ()
-        (inferior-eval '(setlocale LC_ALL "en_US.UTF-8") inf)))
-
-    (inferior-eval '(use-modules (srfi srfi-1)
-                                 (srfi srfi-34)
-                                 (srfi srfi-43)
-                                 (ice-9 history)
-                                 (guix grafts)
-                                 (guix derivations)
-                                 (gnu tests))
-                   inf)
+  (call-with-blocked-asyncs
+   (lambda ()
+     (let* ((original-guix-locpath (getenv "GUIX_LOCPATH"))
+            (original-extra-env-vars-values
+             (map (match-lambda
+                    ((key . _)
+                     (getenv key)))
+                  extra-inferior-environment-variables))
+            (inf (begin
+                   ;; Unset the GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH to
+                   ;; avoid the values for these being used in the
+                   ;; inferior. Even though the inferior %load-path and
+                   ;; %load-compiled-path has the inferior modules first, this
+                   ;; can cause issues when there are modules present outside
+                   ;; of the inferior Guix which aren't present in the inferior
+                   ;; Guix (like the new (guix lint) module
+                   (unsetenv "GUILE_LOAD_PATH")
+                   (unsetenv "GUILE_LOAD_COMPILED_PATH")
+                   (simple-format (current-error-port) "debug: set GUIX_LOCPATH to ~A\n"
+                                  guix-locpath)
+                   (for-each
+                    (match-lambda
+                      ((key . val)
+                       (simple-format (current-error-port)
+                                      "debug: set ~A to ~A\n"
+                                      key val)
+                       (setenv key val)))
+                    extra-inferior-environment-variables)
+
+                   (if (defined?
+                         'open-inferior/container
+                         (resolve-module '(guix inferior)))
+                       (open-inferior/container store store-path
+                                                #:extra-shared-directories
+                                                '("/gnu/store")
+                                                #:extra-environment-variables
+                                                (list (string-append
+                                                       "GUIX_LOCPATH="
+                                                       guix-locpath)))
+                       (begin
+                         (setenv "GUIX_LOCPATH" guix-locpath)
+                         (simple-format #t "debug: using open-inferior\n")
+                         (open-inferior store-path
+                                        #:error-port (current-error-port)))))))
+       (setenv "GUIX_LOCPATH" original-guix-locpath) ; restore GUIX_LOCPATH
+       (for-each
+        (lambda (key val)
+          (setenv key val))
+        (map car extra-inferior-environment-variables)
+        original-extra-env-vars-values)
+
+       (when (eq? inf #f)
+         (error "error: inferior is #f"))
+
+       ;; Normalise the locale for the inferior process
+       (with-exception-handler
+           (lambda (key . args)
+             (simple-format
+              (current-error-port)
+              "warning: failed to set locale to en_US.UTF-8: ~A ~A\n"
+              key args))
+         (lambda ()
+           (inferior-eval '(setlocale LC_ALL "en_US.UTF-8") inf)))
+
+       (inferior-eval '(use-modules (srfi srfi-1)
+                                    (srfi srfi-34)
+                                    (srfi srfi-43)
+                                    (ice-9 history)
+                                    (guix grafts)
+                                    (guix derivations)
+                                    (gnu tests))
+                      inf)
 
-    (inferior-eval '(disable-value-history!)
-                   inf)
+       (inferior-eval '(disable-value-history!)
+                      inf)
 
-    ;; For G_ and P_
-    (or (inferior-eval '(and (resolve-module '(guix i18n) #:ensure #f)
-                             (use-modules (guix i18n))
-                             #t)
-                       inf)
-        (inferior-eval '(use-modules (guix ui))
-                       inf))
+       ;; For G_ and P_
+       (or (inferior-eval '(and (resolve-module '(guix i18n) #:ensure #f)
+                                (use-modules (guix i18n))
+                                #t)
+                          inf)
+           (inferior-eval '(use-modules (guix ui))
+                          inf))
 
-    (inferior-eval '(when (defined? '%graft?) (%graft? #f)) inf)
+       (inferior-eval '(when (defined? '%graft?) (%graft? #f)) inf)
 
-    ;; TODO Have Guix make this easier
-    ((@@ (guix inferior) ensure-store-bridge!) inf)
-    (non-blocking-port ((@@ (guix inferior) inferior-bridge-socket) inf))
+       ;; TODO Have Guix make this easier
+       ((@@ (guix inferior) ensure-store-bridge!) inf)
+       (non-blocking-port ((@@ (guix inferior) inferior-bridge-socket) inf))
 
-    inf))
+       inf))))
 
 (define* (extract-information-from conn long-running-store-connection
                                    guix-revision-id commit