path-components-safe: refactoring.

* stdlib/path-test.tl (path-components-safe): Simplify code;
forget trying to do anything on Windows: just return true.

* txr.1: Document that path-components-safe is useless
on Windows.

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
diff --git a/txr.1 b/txr.1
index 3dd5ed0c..c1a832e9 100644
--- a/txr.1
+++ b/txr.1
@@ -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