puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch vfs): don't symlink to symlinks

Browse source 
This has pretty bad side effects, in case of relative symlinks.

Change-Id: Ia7fe5607941dfb07cfb8f739e0dab9666a6a6964
This commit is contained in:
puck 2025-11-24 18:37:10 +00:00
parent 553df0b2fe
commit de9d250b55
1 changed files with 7 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

10
core/src/vfs.sld
View file

@ -81,9 +81,13 @@
(lambda (k contents) (lambda (k contents)
(define dir (car k)) (define dir (car k))
(define fname (cdr k)) (define fname (cdr k))
(if (eq? contents 'directory) (cond
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname 'directory) v)) '())) ((eq? contents 'directory)
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '())))) (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)) (vfs-contents vfs))
(define (read-dir dirname) (define (read-dir dirname)
(define contents (mapping-ref/default dirmap dirname '())) (define contents (mapping-ref/default dirmap dirname '()))