rust: Use with-store macro instead of manual conn handling
This commit is contained in:
parent
deb9602e05
commit
b00e6e8bf5
GPG key ID:
29FD88532FC91BF4
1 changed files with 54 additions and 56 deletions
110
env/rust.scm
vendored
110
env/rust.scm
vendored
|
|
@ -69,7 +69,7 @@
|
|||
0 7))
|
||||
(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
|
||||
(list
|
||||
(file-system-mapping
|
||||
|
|
@ -77,35 +77,35 @@
|
|||
(target "/home/rustup")
|
||||
(writable? #t)))
|
||||
'())))
|
||||
(run-with-store store
|
||||
(mlet* %store-monad ((bash (package->derivation bash))
|
||||
(profile (profile-derivation
|
||||
rustup-environment-manifest)))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list bash profile))
|
||||
(let ((bash-binary (string-append (derivation->output-path bash)
|
||||
"/bin/sh"))
|
||||
(profile-dir (derivation->output-path profile)))
|
||||
(launch #:command cmd
|
||||
#:bash bash-binary
|
||||
#:user "rustup"
|
||||
#:user-mappings mappings
|
||||
#:profile profile-dir
|
||||
#:manifest rustup-environment-manifest
|
||||
#:link-profile? #f
|
||||
#:network? #t
|
||||
#:map-cwd? #f
|
||||
#:emulate-fhs? #t
|
||||
#:nesting? #f)))))))
|
||||
(with-store store
|
||||
(run-with-store store
|
||||
(mlet* %store-monad ((bash (package->derivation bash))
|
||||
(profile (profile-derivation
|
||||
rustup-environment-manifest)))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list bash profile))
|
||||
(let ((bash-binary (string-append (derivation->output-path bash)
|
||||
"/bin/sh"))
|
||||
(profile-dir (derivation->output-path profile)))
|
||||
(launch #:command cmd
|
||||
#:bash bash-binary
|
||||
#:user "rustup"
|
||||
#:user-mappings mappings
|
||||
#:profile profile-dir
|
||||
#:manifest rustup-environment-manifest
|
||||
#:link-profile? #f
|
||||
#:network? #t
|
||||
#:map-cwd? #f
|
||||
#:emulate-fhs? #t
|
||||
#:nesting? #f))))))))
|
||||
|
||||
(define (call-with-guix-shell-hacks proc)
|
||||
"Overcome several pitfails calling launch-environment/container procedure we
|
||||
aren't supposed to. PROC is passed store connection and
|
||||
launch-environment/container function."
|
||||
aren't supposed to. PROC is passed curried launch-environment/container
|
||||
function."
|
||||
(let* ((_ (reload-module (resolve-module '(guix scripts environment))))
|
||||
(launch (@@ (guix scripts environment) launch-environment/container))
|
||||
(setup-fhs (@@ (guix scripts environment) setup-fhs))
|
||||
(store (open-connection))
|
||||
(tcgrp (tcgetpgrp (current-input-port))))
|
||||
;; during launch-environment/container does at least one fork take place,
|
||||
;; for some reason when child exits this process receives SIGTTOU and
|
||||
|
|
@ -113,41 +113,39 @@ launch-environment/container function."
|
|||
;; inside script folder or linux-container module.
|
||||
(sigaction SIGTTOU SIG_IGN)
|
||||
(sigaction SIGTTIN SIG_IGN)
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(λ ()
|
||||
(match (primitive-fork)
|
||||
(0
|
||||
(catch 'system-error
|
||||
(λ ()
|
||||
(proc store
|
||||
;; Curried launch function with setup-hook = setup-fhs
|
||||
(λ args
|
||||
(apply
|
||||
launch (append args
|
||||
(list #:setup-hook setup-fhs))))))
|
||||
(λ args
|
||||
(format (current-error-port)
|
||||
"error: ~a" (strerror (system-error-errno args))))))
|
||||
(pid (waitpid pid)
|
||||
;; Again, maybe because of guix shell hacks or because of hacks
|
||||
;; to make guix shell importable (eg ignoring signals) group ID
|
||||
;; for the terminal used by input port changed after child
|
||||
;; exits. That causes input/output error when we jump back to
|
||||
;; the prompt.
|
||||
(tcsetpgrp (current-input-port) tcgrp)
|
||||
;; Why not?
|
||||
(flush-all-ports))))
|
||||
(λ () (close-connection store)))))
|
||||
(match (primitive-fork)
|
||||
(0
|
||||
(catch 'system-error
|
||||
(λ ()
|
||||
(proc
|
||||
;; Curried launch function with setup-hook = setup-fhs
|
||||
(λ args
|
||||
(apply
|
||||
launch (append args
|
||||
(list #:setup-hook setup-fhs))))))
|
||||
(λ args
|
||||
(format (current-error-port)
|
||||
"error: ~a" (strerror (system-error-errno args))))))
|
||||
(pid (waitpid pid)
|
||||
;; Again, maybe because of guix shell hacks or because of hacks
|
||||
;; to make guix shell importable (eg ignoring signals) group ID
|
||||
;; for the terminal used by input port changed after child
|
||||
;; exits. That causes input/output error when we jump back to
|
||||
;; the prompt.
|
||||
(tcsetpgrp (current-input-port) tcgrp)
|
||||
;; Why not?
|
||||
(flush-all-ports)))))
|
||||
|
||||
(define* (init-rustup-environment #:optional home)
|
||||
(call-with-guix-shell-hacks
|
||||
(λ (store launch)
|
||||
(exec-in-rustup-environment
|
||||
store launch'("rustup-init.sh" "-q" "-y") home))))
|
||||
(λ (launch)
|
||||
(exec-in-rustup-environment launch
|
||||
'("rustup-init.sh" "-q" "-y")
|
||||
home))))
|
||||
|
||||
(define* (launch-rustup-environment #:optional home)
|
||||
(call-with-guix-shell-hacks
|
||||
(λ (store launch)
|
||||
(exec-in-rustup-environment
|
||||
store launch '("/bin/sh") home))))
|
||||
(λ (launch)
|
||||
(exec-in-rustup-environment launch
|
||||
'("/bin/sh")
|
||||
home))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue