From deb9602e05209ff2fefcf162df4da084a9c00d78 Mon Sep 17 00:00:00 2001 From: Davie Li Date: Mon, 8 Jan 2024 17:19:03 +0100 Subject: [PATCH] Add (env rust) --- Makefile.am | 4 +- env/rust.scm | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 156 insertions(+), 1 deletion(-) create mode 100644 env/rust.scm diff --git a/Makefile.am b/Makefile.am index fa834dc..c02e0f6 100644 --- a/Makefile.am +++ b/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 = diff --git a/env/rust.scm b/env/rust.scm new file mode 100644 index 0000000..5326a7c --- /dev/null +++ b/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))))