diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stdlib/path-test.tl | 72 |
2 files changed, 73 insertions, 0 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 4efb6391..98a4b668 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1423,6 +1423,7 @@ ("path-blkdev-p" "N-00198FC7") ("path-cat" "N-0033B27E") ("path-chrdev-p" "N-00198FC7") + ("path-components-safe" "N-02451630") ("path-dir-empty" "N-01EFC15D") ("path-dir-p" "N-00198FC7") ("path-equal" "N-02365F9E") diff --git a/stdlib/path-test.tl b/stdlib/path-test.tl index 3288ef79..31a4d4be 100644 --- a/stdlib/path-test.tl +++ b/stdlib/path-test.tl @@ -152,6 +152,78 @@ (and (all g.mem (orf (op equal name) (op equal suname)))))))))) +(eval-only + (defmacro if-windows (then : else) + (if (eql 2 (sizeof wchar)) + then + else)) + + (defmacro if-native-windows (then : else) + (if-windows + ^(if (find #\\ path-sep-chars) ,then ,else) + else))) + +(defun path-safe-sticky-dir (st) + (let ((sdir (logior s-ifdir s-isvtx))) + (and (eql (logand st.mode sdir) sdir) + (zerop st.uid)))) + +(defun path-components-safe (path) + (let* ((comps (spl path-sep-chars path)) + (start "/")) + (iflet ((head (car comps))) + (and + (if-native-windows + (match-case head + (@(or "" `@{vol #/[A-Za-z]+:/}`) + (set start `@head` + comps (cdr comps)) + (path-private-to-me-p start)) + (`@{vol #/A-Za-z]+:/}@name` + (set start `@vol@name` + comps (cdr comps)) + (and (path-private-to-me-p `@vol`) + (path-private-to-me-p start))) + (@else + (set start ".") + (let ((st (stat start))) + (or (path-private-to-me-p st) + (path-safe-sticky-dir st))))) + (cond + ((empty head) + (set start "/" + comps (cdr comps)) + (path-private-to-me-p "/")) + (t + (set start ".") + (let ((st (stat start))) + (or (path-private-to-me-p st) + (path-safe-sticky-dir st)))))) + (for ((ok t) (count 0) next (orig-start start)) + ((and ok (set next (pop comps))) ok) + () + (let* ((nxpath (path-cat start next)) + (st (lstat nxpath))) + (cond + ((eql (logand st.mode s-ifmt) s-iflnk) + (if (> (inc count) 16) + (throwf 'file-error "~a: too many symbolic links" + 'path-components-safe)) + (if (or (zerop st.uid) + (eql st.uid (geteuid))) + (let* ((target (readlink nxpath)) + (tcomps (spl path-sep-chars target))) + (set comps (nconc tcomps comps)) + (when (abs-path-p target) + (set start "/") + (if (nequal orig-start "/") + (set ok (path-private-to-me-p "/") + orig-start nil)))) + (set ok nil))) + ((or (path-private-to-me-p st) + (path-safe-sticky-dir st)) + (set start nxpath)) + (t (zap ok))))))))) (defmacro sys:path-examine ((sym statfun path) . body) ^[sys:do-path-test ,statfun ,path |