diff options
| -rw-r--r-- | stdlib/path-test.tl | 92 | ||||
| -rw-r--r-- | txr.1 | 3 |
2 files changed, 39 insertions, 56 deletions
diff --git a/stdlib/path-test.tl b/stdlib/path-test.tl index 31a4d4be..5f28b352 100644 --- a/stdlib/path-test.tl +++ b/stdlib/path-test.tl @@ -169,61 +169,43 @@ (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))))))))) + (if-native-windows + t + (let* ((comps (spl path-sep-chars path)) + (head (car comps)) + (start "/")) + (if (empty head) + (set comps (cdr comps)) + (set start ".")) + (if (let ((st (stat start))) + (or (path-private-to-me-p st) + (if (nequal start "/") + (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 @@ -71624,7 +71624,7 @@ function is provided to perform a security check on an entire path. .mets (path-components-safe << path ) .syne .desc -The +On Unix platforms, the .code path-components-safe performs a security check on an entire relative or absolute .metn path , @@ -71633,6 +71633,7 @@ returning if the entire path is examined without encountering an error, and the check passes, otherwise .codn nil . +On native Microsoft Windows, the function unconditionally returns true. An exception may be thrown if an an inaccessible or nonexistent path component is encountered, too many symbolic links have to be resolved |