path access tests: use real credentials.

The various accessibility functions like path-writable-to-me
should use the real credentials, the same way that the
POSIX access function does. This makes them much more useful
and secure in setuid programs, since they answer the question
"does the underlying user, without these elevated privileges,
have this access".

* stdlib/path-test.tl (path-mine-p): Use getuid, not geteuid.
(path-my-group-p): Use getgid, not getegid.
(sys:path-access, path-private-to-me,
path-strictly-private-to-me): Use getuid, getgid and
rename euid variable to uid.

* txr.1: Updated.

1 files changed, 13 insertions, 13 deletions

diff --git a/stdlib/path-test.tl b/stdlib/path-test.tl
index 04ed2055..19bbb5ec 100644
--- a/stdlib/path-test.tl
+++ b/stdlib/path-test.tl
@@ -77,12 +77,12 @@
 
 (defun path-mine-p (path)
   (sys:path-test (s stat path)
-    (= s.uid (geteuid))))
+    (= s.uid (getuid))))
 
 (defun path-my-group-p (path)
   (sys:path-test (s stat path)
     (let ((g s.gid))
-      (or (= g (getegid))
+      (or (= g (getgid))
           (find g (getgroups))))))
 
 ;; umask, gmask and omask must test identical permissions
@@ -91,13 +91,13 @@
 (defun sys:path-access (path umask gmask omask)
   (sys:path-test (s stat path)
     (let ((m s.mode)
-          (euid (geteuid)))
+          (uid (getuid)))
       (cond
-        ((zerop euid) (or (zerop (logand umask s-ixusr))
-                          (plusp (logand m (logior umask gmask omask)))))
-        ((= euid s.uid) (= umask (logand m umask)))
+        ((zerop uid) (or (zerop (logand umask s-ixusr))
+                         (plusp (logand m (logior umask gmask omask)))))
+        ((= uid s.uid) (= umask (logand m umask)))
         ((let ((g s.gid))
-           (or (= g (getegid))
+           (or (= g (getgid))
                (find g (getgroups))))
          (= gmask (logand m gmask)))
         (t (= omask (logand m omask)))))))
@@ -120,14 +120,14 @@
 (defun path-private-to-me-p (path)
   (sys:path-test (s stat path)
     (let ((m s.mode)
-          (euid (geteuid)))
+          (uid (getuid)))
       (mlet ((g (getgrgid s.gid))
-             (name (let ((pw (getpwuid euid)))
+             (name (let ((pw (getpwuid uid)))
                      (if pw pw.name)))
              (suname (let ((pw (getpwuid 0)))
                        (if pw pw.name))))
         (and (or (zerop s.uid)
-                 (eql euid s.uid))
+                 (eql uid s.uid))
              (zerop (logand m s-iwoth))
              (or (zerop (logand m s-iwgrp))
                  (null g.mem)
@@ -137,14 +137,14 @@
 (defun path-strictly-private-to-me-p (path)
   (sys:path-test (s stat path)
     (let ((m s.mode)
-          (euid (geteuid)))
+          (uid (getuid)))
       (mlet ((g (getgrgid s.gid))
-             (name (let ((pw (getpwuid euid)))
+             (name (let ((pw (getpwuid uid)))
                      (if pw pw.name)))
              (suname (let ((pw (getpwuid 0)))
                        (if pw pw.name))))
         (and (or (zerop s.uid)
-                 (eql euid s.uid))
+                 (eql uid s.uid))
              (zerop (logand m (logior s-iroth s-iwoth)))
              (or (zerop (logand m (logior s-irgrp s-iwgrp)))
                  (null g.mem)