From 3cebd9c77bb90e1a114a9caf4b10eea70dc2ce7f Mon Sep 17 00:00:00 2001 From: Hilton Chain Date: Wed, 31 Jan 2024 20:50:03 +0800 Subject: multiarch-container: make-internal-script: Improve icd-symlink. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * nonguix/multiarch-container.scm (make-internal-script)[icd-symlink]: Allow custom directory. Rename to… [file-symlink]: …this. [get-files]: New procedure to simplify find-files use. Signed-off-by: John Kehayias --- nonguix/multiarch-container.scm | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) (limited to 'nonguix') diff --git a/nonguix/multiarch-container.scm b/nonguix/multiarch-container.scm index 3d040c2..7fda929 100644 --- a/nonguix/multiarch-container.scm +++ b/nonguix/multiarch-container.scm @@ -455,7 +455,9 @@ application." `((guix build utils)) #~(begin (use-modules (guix build utils) - (ice-9 getopt-long)) + (ice-9 getopt-long) + (srfi srfi-1) + (srfi srfi-26)) (define (path->str path) (if (list? path) (string-join path "/") @@ -465,9 +467,13 @@ application." (dest (path->str (cdr pair)))) (unless (file-exists? dest) (symlink target dest)))) - (define (icd-symlink file) + (define (file-symlink file dir) + (mkdir-p dir) (new-symlink - `(,file . ("/usr/share/vulkan/icd.d" ,(basename file))))) + `(,file . (,dir ,(basename file))))) + ;; Use stat to follow links from packages like MangoHud. + (define (get-files dir) + (find-files (path->str dir) #:stat stat)) (define fhs-option-spec '((asound32 (value #f)))) (let* ((guix-env (getenv "GUIX_ENVIRONMENT")) @@ -517,12 +523,11 @@ application." ((,union64 "share/vulkan/explicit_layer.d") . "/usr/share/vulkan/explicit_layer.d"))) (for-each - icd-symlink - ;; Use stat to follow links from packages like MangoHud. - `(,@(find-files (string-append union32 "/share/vulkan/icd.d") - #:directories? #t #:stat stat) - ,@(find-files (string-append union64 "/share/vulkan/icd.d") - #:directories? #t #:stat stat))) + (cut file-symlink <> "/usr/share/vulkan/icd.d") + (append-map + get-files + `((,union32 "share/vulkan/icd.d") + (,union64 "share/vulkan/icd.d")))) ;; TODO: This is not the right place for this. ;; Newer versions of Steam won't startup if they can't copy to here ;; (previous would output this error but continue). -- cgit v1.2.3