Skip to content

Commit fbc1f9b

Browse files
CrazedProgrammerCrazedProgrammer
committed
Add copying and moving across mounts and fix tmpfs with nested files
1 parent e877e21 commit fbc1f9b

2 files changed

Lines changed: 70 additions & 66 deletions

File tree

‎vfs/init.lisp‎

Lines changed: 68 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -1,27 +1,20 @@
11
(import lua/basic (set-idx!))
22
(import vfs/ccfs ccfs)
33
(import vfs/tmpfs tmpfs)
4+
(import util (log!))
45

56
(defun create-vfs (vfs-mounts)
67
(let* [(mounts {})
78
(wrap-fun (lambda (function)
89
(lambda (path &rest)
910
(with ((mount local-path) (mount-path mounts path))
10-
((.> mount function) local-path (splice rest))))))
11-
(dir-list (lambda (x)
12-
(let* [(path (canonicalise x))
13-
(entries ((wrap-fun :list) path))]
14-
(for-each mount-path (keys mounts)
15-
(with (mount-path-parts (string/split mount-path "%/"))
16-
(when (and (= path (string/concat (init mount-path-parts) "/")) (/= mount-path "")
17-
(not (elem? (last mount-path-parts) (values entries))))
18-
(set-idx! entries (+ (len# entries) 1) (last mount-path-parts)))))
19-
entries)))]
11+
((.> mount function) local-path (splice rest))))))]
12+
; TODO: if the mount point is not /, check if the mount point is a directory in the existing vfs.
2013
(for-each vfs-mount vfs-mounts
2114
(let* [(mount-args (string/split vfs-mount "%:"))
2215
(attributes (string/split (car mount-args) ""))
2316
(mount-point (canonicalise (cadr mount-args)))
24-
(dir (canonicalise (caddr mount-args) false))
17+
(dir (canonicalise (caddr mount-args)))
2518
(fs-type (cond
2619
[(elem? "r" attributes) 'realfs ]
2720
[(elem? "t" attributes) 'tmpfs ]
@@ -32,56 +25,69 @@
3225
[tmpfs (.<! mounts mount-point (tmpfs/create dir))]
3326
[else (error! "unimplemented.")])))
3427

35-
{ :list dir-list
36-
:exists (wrap-fun :exists)
37-
:isDir (wrap-fun :isDir)
38-
:isReadOnly (wrap-fun :isReadOnly)
39-
:getName (lambda (path)
40-
(with (name (last (string/split (canonicalise path) "%/")))
41-
(if (= name "") "root" name)))
42-
:getDrive (lambda (path) "hdd")
43-
:getSize (wrap-fun :getSize)
44-
:getFreeSpace (wrap-fun :getFreeSpace)
45-
:makeDir (wrap-fun :makeDir)
46-
:move (lambda (from-path to-path)
47-
(if (or ((wrap-fun :isReadOnly) from-path)
48-
((wrap-fun :isReadOnly) to-path))
49-
(error! "permission denied.")
50-
(let* [((mount-from local-path-from) (mount-path mounts from-path))
51-
((mount-to local-path-to) (mount-path mounts to-path))]
52-
(if (/= mount-from mount-to)
53-
(error! "copying across mounts is currently not implemented.")
54-
((.> mount-from :move) local-path-from local-path-to)))))
55-
:copy (lambda (from-path to-path)
56-
(if ((wrap-fun :isReadOnly) to-path)
57-
(error! "permission denied.")
58-
(let* [((mount-from local-path-from) (mount-path mounts from-path))
59-
((mount-to local-path-to) (mount-path mounts to-path))]
60-
(if (/= mount-from mount-to)
61-
(error! "copying across mounts is currently not implemented.")
62-
((.> mount-from :copy) local-path-from local-path-to)))))
63-
:delete (wrap-fun :delete)
64-
:combine (lambda (path child-path)
65-
(canonicalise (.. path "/" child-path)))
66-
:open (wrap-fun :open)
67-
:find (lambda (wildcard)
68-
(if ((wrap-fun :exists) wildcard)
69-
(list wildcard)
70-
'()))
71-
:getDir (lambda (path)
72-
(with (parts (string/split (canonicalise path) "%/"))
73-
(cond [(= (car parts) "") ".."]
74-
[(= (n parts) 1) ""]
75-
[else (cadr (reverse parts))])))
76-
:complete (lambda (partial-name path include-files include-slashes)
77-
(if (not ((wrap-fun :isDir)))
78-
{}
79-
(with (names (dir-list path))
80-
(filter
81-
(lambda (x) (= x "nil"))
82-
(map (lambda (name)
83-
(if (= (string/sub name 1 (n partial-name)) partial-name)
84-
name "nil"))))))) }))
28+
(with (vfs
29+
{ :list (wrap-fun :list)
30+
:exists (wrap-fun :exists)
31+
:isDir (wrap-fun :isDir)
32+
; TODO: make the VFS prevent writing to read-only mounts.
33+
:isReadOnly (wrap-fun :isReadOnly)
34+
:getName (lambda (path)
35+
(with (name (last (string/split (canonicalise path) "%/")))
36+
(if (= name "") "root" name)))
37+
:getDrive (lambda (path) "hdd")
38+
:getSize (wrap-fun :getSize)
39+
:getFreeSpace (wrap-fun :getFreeSpace)
40+
:makeDir (wrap-fun :makeDir)
41+
:delete (wrap-fun :delete)
42+
:combine (lambda (path child-path)
43+
(canonicalise (.. path "/" child-path)))
44+
:open (wrap-fun :open)
45+
; TODO: proper wildcard support.
46+
:find (lambda (wildcard)
47+
(if ((wrap-fun :exists) wildcard)
48+
(list wildcard)
49+
'()))
50+
:getDir (lambda (path)
51+
(with (parts (string/split (canonicalise path) "%/"))
52+
(cond [(= (car parts) "") ".."]
53+
[(= (n parts) 1) ""]
54+
[else (cadr (reverse parts))])))
55+
:complete (lambda (partial-name path include-files include-slashes)
56+
(if (not ((wrap-fun :isDir)))
57+
{}
58+
(with (names ((wrap-fun :list) path))
59+
(filter
60+
(lambda (x) (= x "nil"))
61+
(map (lambda (name)
62+
(if (= (string/sub name 1 (n partial-name)) partial-name)
63+
name "nil"))))))) })
64+
; Copy and move need to be done manually in order to support copying across mounts.
65+
(.<! vfs :copy
66+
(lambda (raw-from-path raw-to-path)
67+
(let* [(from-path (canonicalise raw-from-path))
68+
(to-path (canonicalise raw-to-path))]
69+
(if (not ((.> vfs :exists) from-path))
70+
(error! "No such file")
71+
(if ((.> vfs :exists) to-path)
72+
(error! "File exists")
73+
(letrec [(copy-path (lambda (from to)
74+
(log! (.. "copying " from " to " to))
75+
(if ((.> vfs :isDir) from)
76+
(progn
77+
((.> vfs :makeDir) to)
78+
(do [(path (struct->list ((.> vfs :list) from)))]
79+
(copy-path (.. from "/" path) (.. to "/" path))))
80+
(let* [(read-handle ((.> vfs :open) from "r"))
81+
(write-handle ((.> vfs :open) to "w"))]
82+
((.> write-handle :write) ((.> read-handle :readAll)))
83+
((.> read-handle :close))
84+
((.> write-handle :close))))))]
85+
(copy-path from-path to-path)))))))
86+
87+
(.<! vfs :move (lambda (from-path to-path)
88+
((.> vfs :copy) from-path to-path)
89+
((.> vfs :delete) from-path)))
90+
vfs)))
8591

8692
(defun mount-path (mounts path)
8793
(let* [(abs-path (canonicalise path))
@@ -93,7 +99,7 @@
9399
(splice (list (.> mounts mount-name)
94100
(canonicalise (string/sub abs-path (+ 1 (n mount-name))))))))
95101

96-
(defun canonicalise (path abs)
102+
(defun canonicalise (path)
97103
(let* [(parts (string/split path "%/"))
98104
(i 1)]
99105
(while (<= i (n parts))

‎vfs/tmpfs.lisp‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,14 +2,13 @@
22
(import util (log!))
33

44
(defun access-tree! (inode path contents) :hidden
5-
(log! (.. "path: " path))
65
(if (= path "")
76
inode
87
(let* [(path-parts (string/split path "%/"))
98
(child-inode (.> inode (car path-parts)))]
109
(if (> (n path-parts) 1)
1110
(if (= (type# child-inode) "table")
12-
(access-tree! inode (string/concat (cdr path-parts) "/") contents)
11+
(access-tree! child-inode (string/concat (cdr path-parts) "/") contents)
1312
(error! "No such file or directory"))
1413
(if (/= (type# contents) "nil")
1514
(.<! inode (car path-parts) (or contents nil))
@@ -113,8 +112,7 @@
113112
:getSize (const 0)
114113
:getFreeSpace (const 1000000000)
115114
:makeDir (lambda (path)
116-
(access-tree! fs-tree path {})
117-
(log! (.. "tree: " (pretty fs-tree))))
115+
(access-tree! fs-tree path {}))
118116
:move (const nil)
119117
:copy (const nil)
120118
:delete (lambda (path) (access-tree! fs-tree path false))

0 commit comments

Comments
 (0)