New function path-private-to-me.

* lisplib.c (path_test_set_entries: "path-private-to-me-p"
addred to name array.
* share/txr/stdlib/path-test.tl (path-private-to-me-p): New
function.

* txr.1: Documented path-private-to-me.

1 files changed, 12 insertions, 0 deletions

diff --git a/share/txr/stdlib/path-test.tl b/share/txr/stdlib/path-test.tl
index c7e825ed..35c11de9 100644
--- a/share/txr/stdlib/path-test.tl
+++ b/share/txr/stdlib/path-test.tl
@@ -72,6 +72,18 @@
 (defun path-writable-to-me-p (path)
   (sys:path-access path s-iwusr s-iwgrp s-iwoth))
 
+(defun path-private-to-me-p (path)
+  (sys:path-test (s stat path)
+    (let ((m s.mode)
+          (euid (geteuid))
+          (g (getgrgid s.gid)))
+      (and (eql euid s.uid)
+           (zerop (logand m s-iwoth))
+           (or (zerop (logand m s-iwgrp))
+               (null g.mem)
+               (and (not (rest g.mem))
+                    (equal (getpwuid euid).name (first g.mem))))))))
+
 (defmacro sys:path-examine ((var statfun path) . body)
   ^[sys:do-path-test ,statfun ,path
      (lambda (,var) ,*body)])