From e08558456aa8084106d165bed1622e45aa3a3e4d Mon Sep 17 00:00:00 2001 From: Puck Meerburg Date: Sun, 11 May 2025 22:21:07 +0000 Subject: [PATCH] (zilch vfs): support symlinks Change-Id: I6a6a69647b11d85f5440262c8e5e27cc220aefb8 --- core/src/vfs.sld | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/core/src/vfs.sld b/core/src/vfs.sld index f19f00b..8899c1f 100644 --- a/core/src/vfs.sld +++ b/core/src/vfs.sld @@ -3,7 +3,7 @@ (define-library (zilch vfs) (import (scheme base) (scheme file) - (chicken file) + (chicken file) (chicken file posix) (zilch magic) (zilch file) (zilch zexpr) (srfi 4) (srfi 113) (srfi 128) (srfi 146) (srfi 152)) @@ -118,12 +118,18 @@ (define contents (directory reldir)) (for-each (lambda (name) + (define full-path (string-append reldir "/" name)) (unless (string=? (string-copy name 0 1) ".") - (if (directory-exists? (string-append reldir "/" name)) + (case (file-type full-path #t #f) + ((directory) (begin (iter-dir (if (string=? dirpath "") name (string-append dirpath "/" name))) - (set! out (mapping-set! out (cons dirpath name) 'directory))) - (set! out (mapping-set! out (cons dirpath name) (zfile (zexp ,(call-with-input-file (string-append reldir "/" name) read-full-file)) (file-executable? (string-append reldir "/" name)))))))) + (set! out (mapping-set! out (cons dirpath name) 'directory)))) + ((symbolic-link) + (set! out (mapping-set! out (cons dirpath name) (zsymlink (read-symbolic-link full-path))))) + ((regular-file) + (set! out (mapping-set! out (cons dirpath name) (zfile (zexp ,(call-with-input-file full-path read-full-file)) (file-executable? full-path))))) + (else (error "Cannot vfsify path" (cons full-path (file-type full-path #t))))))) contents)) (iter-dir "") (make-vfs out))