From de9d250b5538f8ff5ea35fc13516565c93d7a397 Mon Sep 17 00:00:00 2001 From: Puck Meerburg Date: Mon, 24 Nov 2025 18:37:10 +0000 Subject: [PATCH] (zilch vfs): don't symlink to symlinks This has pretty bad side effects, in case of relative symlinks. Change-Id: Ia7fe5607941dfb07cfb8f739e0dab9666a6a6964 --- core/src/vfs.sld | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/core/src/vfs.sld b/core/src/vfs.sld index ab35750..70f634e 100644 --- a/core/src/vfs.sld +++ b/core/src/vfs.sld @@ -81,9 +81,13 @@ (lambda (k contents) (define dir (car k)) (define fname (cdr k)) - (if (eq? contents 'directory) - (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname 'directory) v)) '())) - (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '())))) + (cond + ((eq? contents 'directory) + (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname 'directory) v)) '()))) + ((z-symlink? contents) + (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname contents) v)) '()))) + (else + (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '()))))) (vfs-contents vfs)) (define (read-dir dirname) (define contents (mapping-ref/default dirmap dirname '()))