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

Support setting environment variables in the inferior

Browse source 
When processing jobs, this is mostly to allow setting GUIX_DOWNLOAD_METHODS.
This commit is contained in:
Christopher Baines 2024-06-24 15:17:52 +01:00
parent d7103eccc9
commit 31bd2156f7
5 changed files with 73 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1328,8 +1328,14 @@
output)))
(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)
(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
@ -1342,6 +1348,15 @@
(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)))
@ -1358,6 +1373,11 @@
(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"))
@ -1404,6 +1424,7 @@
guix-revision-id commit
guix-source store-path
#:key skip-system-tests?
extra-inferior-environment-variables
parallelism)
(define guix-locpath
@ -1422,12 +1443,13 @@
(make-resource-pool
(lambda ()
(let* ((inferior-store (open-connection))
(inferior (start-inferior-for-data-extration inferior-store
store-path
guix-locpath)))
(inferior (start-inferior-for-data-extration
inferior-store
store-path
guix-locpath
extra-inferior-environment-variables)))
(ensure-non-blocking-store-connection inferior-store)
(make-inferior-non-blocking! inferior)
(simple-format #t "debug: started new inferior and store connection\n")
(cons inferior inferior-store)))
@ -1666,7 +1688,8 @@
(prevent-inlining-for-tests load-channel-instances)
(define* (load-new-guix-revision conn git-repository-id commit
#:key skip-system-tests? parallelism)
#:key skip-system-tests? parallelism
extra-inferior-environment-variables)
(let* ((git-repository-fields
(select-git-repository conn git-repository-id))
(git-repository-url
@ -1712,6 +1735,8 @@
commit guix-source store-item
#:skip-system-tests?
skip-system-tests?
#:extra-inferior-environment-variables
extra-inferior-environment-variables
#:parallelism parallelism)))
(if (defined? 'channel-news-for-commit
@ -2115,6 +2140,7 @@ SKIP LOCKED")
(prevent-inlining-for-tests with-store-connection)
(define* (process-load-new-guix-revision-job id #:key skip-system-tests?
extra-inferior-environment-variables
parallelism)
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A" id)
@ -2146,11 +2172,14 @@ SKIP LOCKED")
(lambda ()
(with-throw-handler #t
(lambda ()
(load-new-guix-revision conn
git-repository-id
commit
#:skip-system-tests? #t
#:parallelism parallelism))
(load-new-guix-revision
conn
git-repository-id
commit
#:skip-system-tests? #t
#:extra-inferior-environment-variables
extra-inferior-environment-variables
#:parallelism parallelism))
(lambda (key . args)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A ~A\n"