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