cbaines pushed a commit to branch master
in repository data-service.
commit e37eb34db63b1096215cfc61cdb9561ba08e5c0d
Author: Christopher Baines <m...@cbaines.net>
AuthorDate: Mon Jun 24 23:02:41 2024 +0100
Block asyncs when starting inferiors
Because this code deals with global state, like environment variables.
---
guix-data-service/jobs/load-new-guix-revision.scm | 170 +++++++++++-----------
1 file 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
