7 files changed, 183 insertions(+), 0 deletions(-)

A modules/cross-shells/build/set-search-paths.scm
A modules/cross-shells/set-search-paths.scm
A pre-inst-env
A scripts/cross-shell
A scripts/example-config
A scripts/linux-embedded.scm
A tests/bash-search-paths.scm

@@ 1,92 @@
+(define-module (cross-shells build set-search-paths)
+  #:use-module (guix search-paths)
+  #:use-module (guix build gnu-build-system)
+  #:use-module (guix build utils)
+  #:use-module (guix build gremlin)
+  #:use-module (guix elf)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs io ports)
+  #:export (produce-/etc/profile
+            produce-activation))
+
+(define* (produce-/etc/profile #:key target inputs outputs native-inputs
+                                 (search-paths '()) (native-search-paths '())
+                                 #:allow-other-keys)
+  (define input-directories
+    ;; The "source" input can be a directory, but we don't want it for search
+    ;; paths.  See <https://issues.guix.gnu.org/44924>.
+    (match (alist-delete "source" inputs)
+      (((_ . dir) ...)
+       dir)))
+
+  (define native-input-directories
+    ;; When cross-compiling, the source appears in native-inputs rather than
+    ;; inputs.
+    (match (and=> native-inputs (cut alist-delete "source" <>))
+      (((_ . dir) ...)
+       dir)
+      (#f                               ;not cross-compiling
+       '())))
+
+  (mkdir-p (string-append (assoc-ref outputs "out") "/etc"))
+  (call-with-output-file (string-append (assoc-ref outputs "out") "/etc/profile")
+    (lambda (port)
+      ;; The use of $GUIX_PROFILE described below is not great.  Another
+      ;; option would have been to use "$1" and have users run:
+      ;;
+      ;;   source ~/.guix-profile/etc/profile ~/.guix-profile
+      ;;
+      ;; However, when 'source' is used with no arguments, $1 refers to the
+      ;; first positional parameter of the calling script, so we cannot rely
+      ;; on it.
+      (let* ((path  (search-path-as-list '("bin" "sbin")
+                                         (append native-input-directories
+                                                 (if target
+                                                     '()
+                                                     input-directories))))
+             (value (list->search-path-as-string path ":")))
+        (unless (string-null? value)
+          (format port "export ~a=\"~a:$PATH\"~%" "PATH" value)))
+
+      (for-each (match-lambda
+                  ((env-var (files ...) separator type pattern)
+                   (let* ((path  (search-path-as-list files input-directories
+                                                      #:type type
+                                                      #:pattern pattern))
+                          (value (list->search-path-as-string path separator)))
+                     (unless (string-null? value)
+                       (format port "export ~a=\"~a~a$~a\"~%" env-var value separator env-var)))))
+                search-paths)
+      (for-each (match-lambda
+                  ((env-var (files ...) separator type pattern)
+                   (let* ((path  (search-path-as-list files native-input-directories
+                                                      #:type type
+                                                      #:pattern pattern))
+                          (value (list->search-path-as-string path separator)))
+                     (unless (string-null? value)
+                       (format port "export ~a=\"~a~a$~a\"~%" env-var value separator env-var)))))
+                native-search-paths))))
+
+
+(define* (produce-activation #:key target inputs outputs native-inputs
+                             #:allow-other-keys)
+  (let* ((out (assoc-ref outputs "out"))
+         (profile (string-append out "/etc/profile"))
+         (bin (string-append out "/bin"))
+         (activate (string-append bin "/activate")))
+    (mkdir-p bin)
+    (call-with-output-file activate
+      (lambda (port)
+        (format port "#!~a~%(source ~a && $SHELL)"
+                (search-input-file inputs "/bin/bash")
+                profile)))
+    (chmod activate #o555)))

@@ 1,42 @@
+(define-module (cross-shells set-search-paths)
+  #:use-module (gnu packages bash)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+
+  #:export (;; make-search-path-package-from-manifest
+            make-search-path-package-from-packages
+            make-search-path-package-from-package))
+
+(define (make-search-path-package-from-packages packages)
+  (package
+    (name "search-path-pkg")
+    (version "0.0.0")
+    (source #f)
+    (build-system gnu-build-system)
+    (inputs (cons*
+             bash
+             (apply append (map package-inputs packages))))
+    (native-inputs (apply append (map package-native-inputs packages)))
+    (propagated-inputs (apply append (map package-propagated-inputs packages)))
+    (arguments
+     (list
+      #:modules `((cross-shells build set-search-paths)
+                  ,@(source-module-closure '((guix search-paths)))
+                  ,@%default-gnu-modules)
+      #:imported-modules `((cross-shells build set-search-paths)
+                           ,@(source-module-closure '((guix search-paths)))
+                           ,@%default-gnu-imported-modules)
+      #:phases #~(list
+                  `(profile . ,produce-/etc/profile)
+                  `(activation . ,produce-activation))))
+    (synopsis #f)
+    (description #f)
+    (home-page #f)
+    (license #f)))
+
+(define (make-search-path-package-from-package package)
+  (make-search-path-package-from-packages (list package)))
+
+;; (define (build-search-path-package-from-manifest))

@@ 1,6 @@
+#!/bin/sh
+
+SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
+export GUILE_LOAD_PATH="$SCRIPT_DIR/modules"
+
+exec "$@"<
\ No newline at end of file

@@ 1,23 @@
+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+target="$1"
+file="$2"
+shift 2
+
+built="$(guix build -f "$file" --target="$target")"
+
+full_path_file="$(realpath "$file")"
+
+tmpmanifest="$(mktemp)"
+tmpmanifest_contents="
+(package->development-manifest
+  (load \"$full_path_file\")
+  #:target \"$target\")
+"
+
+echo "$tmpmanifest_contents" > "$tmpmanifest"
+
+guix shell -m "$tmpmanifest" --expose=/gnu "$@" -- "$built/bin/activate"
+#guix shell -e "(begin (use-modules (guix profiles) (guix packages)) (package->development-manifest (load \"$file\")))" --expose=/gnu "$@" -- "$built/bin/activate"

@@ 1,1 @@
+--target=aarch64-linux-gnu<
\ No newline at end of file

@@ 1,14 @@
+(use-modules
+ (guix store)
+ (guix packages)
+ (guix gexp)
+ (gnu packages linux)
+ (cross-shells set-search-paths))
+
+;; (with-store %store
+;;   (run-with-store %store
+;;     (package->cross-derivation
+     (make-search-path-package-from-packages
+      (list
+       linux-libre))
+;;      "arm-linux-gnueabihf")))

@@ 1,5 @@
+(use-modules
+ (gnu packages bash)
+ (cross-shells set-search-paths))
+
+(make-search-path-package-from-package bash)