davie/guile-env
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

rust: Use with-store macro instead of manual conn handling

Browse source
This commit is contained in:
Davie Li 2024-01-10 15:12:56 +01:00
parent deb9602e05
commit b00e6e8bf5
Signed by: davie
GPG key ID: 29FD88532FC91BF4
1 changed files with 54 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
env/rust.scm vendored
View file

@ -69,7 +69,7 @@
0 7)) 0 7))
(item rustup-init-script-derivation))))) (item rustup-init-script-derivation)))))
(define* (exec-in-rustup-environment store launch cmd #:optional home) (define* (exec-in-rustup-environment launch cmd #:optional home)
(let* ((mappings (if home (let* ((mappings (if home
(list (list
(file-system-mapping (file-system-mapping
@ -77,6 +77,7 @@
(target "/home/rustup") (target "/home/rustup")
(writable? #t))) (writable? #t)))
'()))) '())))
(with-store store
(run-with-store store (run-with-store store
(mlet* %store-monad ((bash (package->derivation bash)) (mlet* %store-monad ((bash (package->derivation bash))
(profile (profile-derivation (profile (profile-derivation
@ -96,16 +97,15 @@
#:network? #t #:network? #t
#:map-cwd? #f #:map-cwd? #f
#:emulate-fhs? #t #:emulate-fhs? #t
#:nesting? #f))))))) #:nesting? #f))))))))
(define (call-with-guix-shell-hacks proc) (define (call-with-guix-shell-hacks proc)
"Overcome several pitfails calling launch-environment/container procedure we "Overcome several pitfails calling launch-environment/container procedure we
aren't supposed to. PROC is passed store connection and aren't supposed to. PROC is passed curried launch-environment/container
launch-environment/container function." function."
(let* ((_ (reload-module (resolve-module '(guix scripts environment)))) (let* ((_ (reload-module (resolve-module '(guix scripts environment))))
(launch (@@ (guix scripts environment) launch-environment/container)) (launch (@@ (guix scripts environment) launch-environment/container))
(setup-fhs (@@ (guix scripts environment) setup-fhs)) (setup-fhs (@@ (guix scripts environment) setup-fhs))
(store (open-connection))
(tcgrp (tcgetpgrp (current-input-port)))) (tcgrp (tcgetpgrp (current-input-port))))
;; during launch-environment/container does at least one fork take place, ;; during launch-environment/container does at least one fork take place,
;; for some reason when child exits this process receives SIGTTOU and ;; for some reason when child exits this process receives SIGTTOU and
@ -113,14 +113,11 @@ launch-environment/container function."
;; inside script folder or linux-container module. ;; inside script folder or linux-container module.
(sigaction SIGTTOU SIG_IGN) (sigaction SIGTTOU SIG_IGN)
(sigaction SIGTTIN SIG_IGN) (sigaction SIGTTIN SIG_IGN)
(dynamic-wind
(const #t)
(λ ()
(match (primitive-fork) (match (primitive-fork)
(0 (0
(catch 'system-error (catch 'system-error
(λ () (λ ()
(proc store (proc
;; Curried launch function with setup-hook = setup-fhs ;; Curried launch function with setup-hook = setup-fhs
(λ args (λ args
(apply (apply
@ -137,17 +134,18 @@ launch-environment/container function."
;; the prompt. ;; the prompt.
(tcsetpgrp (current-input-port) tcgrp) (tcsetpgrp (current-input-port) tcgrp)
;; Why not? ;; Why not?
(flush-all-ports)))) (flush-all-ports)))))
(λ () (close-connection store)))))
(define* (init-rustup-environment #:optional home) (define* (init-rustup-environment #:optional home)
(call-with-guix-shell-hacks (call-with-guix-shell-hacks
(λ (store launch) (λ (launch)
(exec-in-rustup-environment (exec-in-rustup-environment launch
store launch'("rustup-init.sh" "-q" "-y") home)))) '("rustup-init.sh" "-q" "-y")
home))))
(define* (launch-rustup-environment #:optional home) (define* (launch-rustup-environment #:optional home)
(call-with-guix-shell-hacks (call-with-guix-shell-hacks
(λ (store launch) (λ (launch)
(exec-in-rustup-environment (exec-in-rustup-environment launch
store launch '("/bin/sh") home)))) '("/bin/sh")
home))))