cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Block asyncs when starting inferiors

Browse source 
Because this code deals with global state, like environment variables.
This commit is contained in:
Christopher Baines 2024-06-24 23:02:41 +01:00
parent 31bd2156f7
commit e37eb34db6
1 changed files with 82 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

162
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -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)
(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)
(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"))
(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)))
;; 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 '(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