Add (env rust)

Makefile.am

@@ -32,7 +32,9 @@ SUFFIXES = .scm .go
 .scm.go:
 	$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
 
-SOURCES = env.scm
+SOURCES = \
+	env.scm \
+	env/rust.scm
 
 TESTS =
 

env/rust.scm

@@ -0,0 +1,153 @@
+(define-module (env rust)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages curl)
+  #:use-module (gnu packages certs)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages gcc)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages commencement)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu system file-systems)
+  #:use-module (guix download)
+  #:use-module (guix git-download)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix utils)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (launch-rustup-environment
+            init-rustup-environment))
+
+(define rustup-origin
+  (let ((name "rustup")
+        (commit "737ad82333742dfd350a733c1649ce4e36109773")
+        (version "1.26.0")
+        (revision "0"))
+    (origin
+      (method git-fetch)
+      (uri (git-reference
+            (url "https://github.com/rust-lang/rustup")
+            (commit commit)))
+      (file-name (git-file-name name version))
+      (sha256
+       (base32 "1b9dcy5ckaqy119r311ds6zr7h5l4b1q52q88ls82zkk4109rpg4")))))
+
+(define rustup-init-script-derivation
+  (let ((file "rustup-init.sh"))
+    (computed-file
+     file
+     (with-imported-modules '((guix build utils))
+       #~(begin (use-modules (guix build utils))
+                (let ((bin (string-append  #$output "/bin")))
+                  (mkdir-p bin)
+                  (symlink (string-append #$rustup-origin "/" #$file)
+                           (string-append bin "/" #$file ))))))))
+
+(define rustup-environment-manifest
+  (manifest-add
+   (packages->manifest
+    (list glibc-for-fhs ;; has to be first
+          (list (@@ (gnu packages gcc) gcc) "lib")
+          gcc-toolchain
+          coreutils
+          curl
+          grep
+          nss-certs
+          zlib)) ;; zlib is needed for rustc not for install
+   (list
+    (manifest-entry
+      (name (origin-file-name rustup-origin))
+      (version (substring (git-reference-commit
+                           (origin-uri rustup-origin))
+                          0 7))
+      (item rustup-init-script-derivation)))))
+
+(define* (exec-in-rustup-environment store launch cmd #:optional home)
+  (let* ((mappings  (if home
+                        (list
+                         (file-system-mapping
+                          (source home)
+                          (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)))))))
+
+(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."
+  (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
+    ;; SIGTTIN signals which put it to wait. Looks like a side-effect of hacks
+    ;; 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)))))
+
+(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))))
+
+(define* (launch-rustup-environment #:optional home)
+  (call-with-guix-shell-hacks
+   (λ (store launch)
+     (exec-in-rustup-environment
+      store launch '("/bin/sh") home))))