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

Load new Guix revisions within a container

Browse source 
Use some experimental functionality to run the inferior repl in a
container. This provides some isolation.
This commit is contained in:
Christopher Baines 2019-02-24 09:05:17 +00:00
parent 83832a7862
commit a5cc703e18
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
1 changed files with 85 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,4 +1,5 @@
(define-module (guix-data-service jobs load-new-guix-revision)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (guix monads)
@ -6,6 +7,7 @@
#:use-module (guix channels)
#:use-module (guix inferior)
#:use-module (guix profiles)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix build utils)
#:use-module (guix-data-service model package)
@ -29,39 +31,92 @@
(inferior-packages->package-ids
conn packages packages-metadata-ids packages-derivation-ids)))
(define (channel->manifest-store-item store channel)
(let ((inferior (open-inferior
(dirname
(dirname
(which "guix"))))))
(define (guix-store-path store)
(let* ((guix-package (@ (gnu packages package-management)
guix))
(derivation (package-derivation store guix-package)))
(build-derivations store (list derivation))
(derivation->output-path derivation)))
(define (nss-certs-store-path store)
(let* ((nss-certs-package (@ (gnu packages certs)
nss-certs))
(derivation (package-derivation store nss-certs-package)))
(build-derivations store (list derivation))
(derivation->output-path derivation)))
(define (channel->derivation-file-name store channel)
(let ((inferior
(open-inferior/container
store
(guix-store-path store)
#:extra-shared-directories
'("/gnu/store")
#:extra-environment-variables
(list (string-append
"SSL_CERT_DIR=" (nss-certs-store-path store))))))
;; Create /etc/pass, as %known-shorthand-profiles in (guix
;; profiles) tries to read from this file. Because the environment
;; is cleaned in build-self.scm, xdg-directory in (guix utils)
;; falls back to accessing /etc/passwd.
(inferior-eval
'(begin
(mkdir "/etc")
(call-with-output-file "/etc/passwd"
(lambda (port)
(display "root:x:0:0::/root:/bin/bash" port))))
inferior)
(let ((channel-instance
(first
(latest-channel-instances store
(list channel)))))
(inferior-eval '(use-modules (guix channels)
(guix profiles))
inferior)
(inferior-eval '(define channel-instance
(@@ (guix channels) channel-instance))
inferior)
(inferior-eval-with-store
inferior
store
`(lambda (store)
(let ((instances (latest-channel-instances
store
(list (channel (name ',(channel-name channel))
(let ((instances
(list
(channel-instance
(channel (name ',(channel-name channel))
(url ,(channel-url channel))
(branch ,(channel-branch channel))
(commit ,(channel-commit channel)))))))
(commit ,(channel-commit channel)))
,(channel-instance-commit channel-instance)
,(channel-instance-checkout channel-instance)))))
(run-with-store store
(mlet* %store-monad ((manifest (channel-instances->manifest instances))
(derv (profile-derivation manifest)))
(mbegin %store-monad
(built-derivations (list derv))
(return (derivation->output-path derv))))))))))
(return (derivation-file-name derv)))))))))))
(define (channel->manifest-store-item store channel)
(let* ((manifest-store-item-derivation-file-name
(channel->derivation-file-name store channel))
(derivation
(read-derivation-from-file manifest-store-item-derivation-file-name)))
(build-derivations store (list derivation))
(derivation->output-path derivation)))
(define (channel->guix-store-item store channel)
(dirname
(readlink
(string-append (channel->manifest-store-item store channel)
(string-append (channel->manifest-store-item store
channel)
"/bin"))))
(define (extract-information-from store conn url commit store_path)
(let ((inf (open-inferior store_path)))
(let ((inf (open-inferior/container store store_path
#:extra-shared-directories
'("/gnu/store"))))
(inferior-eval '(use-modules (guix grafts)) inf)
(inferior-eval '(%graft? #f) inf)
@ -70,10 +125,13 @@
(let ((guix-revision-id
(insert-guix-revision conn url commit store_path)))
(insert-guix-revision-packages conn guix-revision-id package-ids)))
(insert-guix-revision-packages conn guix-revision-id package-ids))
(exec-query conn "COMMIT")
(simple-format
#t "Successfully loaded ~A packages\n" (length package-ids)))
(close-inferior inf)))
(define (load-new-guix-revision conn url commit)