Improved FILE-NOT-ACCESSIBLE, which still has problems, and added discussion

of its problems to the manual.

doc/scsh-manual/syscalls.tex

@@ -1294,8 +1294,33 @@ For example,
     Since symlink permission bits are ignored by the filesystem, these
     calls do not take a \var{chase?} flag.
 
-    \oops{\ex{file-not-writeable?} does not currently do the directory
-            check.}
+    Note that these procedures use the process' \emph{effective} user
+    and group ids for permission checking. {\Posix} defines an \ex{access()}
+    function that uses the process' real uid and gids. This is handy
+    for setuid programs that would like to find out if the actual user
+    has specific rights; scsh ought to provide this functionality (but doesn't
+    at the current time). 
+
+    There are several problems with these procedures. First, there's an
+    atomicity issue. In between checking permissions for a file and then trying
+    an operation on the file, another process could change the permissions,
+    so a return value from these functions guarantees nothing. Second, 
+    the code special-cases permission checking when the uid is root---if
+    the file exists, root is assumed to have the requested permission.
+    However, not even root can write a file that is on a read-only file system,
+    such as a CD ROM. In this case, \ex{file-not-writable?} will lie, saying
+    that root has write access, when in fact the opening the file for write
+    access will fail.
+    Finally, write permission confounds write access and create access.
+    These should be disentangled.
+
+    Some of these problems could be avoided if {\Posix} had a real-uid
+    variant of the \ex{access()} call we could use, but the atomicity
+    issue is still a problem. In the final analysis, the only way to
+    find out if you have the right to perform an operation on a file
+    is to try and open it for the desired operation. These permission-checking
+    functions are mostly intended for script-writing, where loose guarantees
+    are tolerated.
 \end{desc}
 
 \defun  {file-readable?}   {fname} \boolean
@@ -1304,6 +1329,7 @@ For example,
 \begin{desc}
     These procedures are the logical negation of the 
     preceding \ex{file-not-\ldots?} procedures.
+    Refer to them for a discussion of their problems and limitations.
 \end{desc}
 
 \begin{defundesc}{file-not-exists?} {fname [chase?]} \object

scsh/fileinfo.scm

@@ -3,11 +3,31 @@
 ;;; chase? true (the default) means if the file is a symlink, chase the link
 ;;; and report on the file it references. chase? = #f means check the actual
 ;;; file itself, even if it's a symlink.
-;;; writeable means (1) file exists & is writeable OR (2) file doesn't exist
-;;;     but directory is writeable.
 
+;;; (file-not-accessible? perms fd/port/fname)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; PERMS is 3 bits, not 9.
+;;; writeable means (1) file exists & is writeable OR (2) file doesn't exist
+;;;     and directory is writeable. That is, writeable means writeable or
+;;;     creatable.
+;;;
+;;; There's a Posix call, access(), that checks using the *real* uid, not
+;;; the effective uid, so that setuid programs can figure out if the luser
+;;; has perms. file-not-accessible? is defined in terms of the effective uid, 
+;;; so we can't use access().
+;;; 
+;;; This is a kind of bogus function. The only way to do a real check is to
+;;; try an open() and see if it flies. Otherwise, there's an obvious atomicity
+;;; problem. Also, we special case root, saying root always has all perms. But
+;;; not even root can write on a read-only filesystem, such as a CD ROM. In
+;;; this case, we'd blithely say the file was writeable -- there's no way to
+;;; check for a ROFS without doing an open(). We need a euid analog to
+;;; access(). Ah, well.
+;;; 
+;;; I also should define a family of real uid perm-checking calls.
+;;;
 ;;; Return values:
-;;; #f			Accessible
+;;; #f			Accessible in at least one of the requested ways.
 ;;; search-denied	Can't stat
 ;;; permission		File exists but is protected
 ;;; 			(also for errno/rofs)
@@ -16,27 +36,43 @@
 ;;;
 ;;; Otherwise, signals an error.
 
-(define (file-not-accessible? perms fd/port/fname . maybe-chase?)
+(define (file-not-accessible? perms fd/port/fname)
   (let ((uid (user-effective-uid)))
-    (and (not (zero? uid)) ; Root can do what he likes.
-	 (with-errno-handler ((err data)
-			      ((errno/acces) 'search-denied)
-			      ((errno/noent) 'nonexistent)
-			      ((errno/notdir) 'not-directory))
+    (with-errno-handler ((err data)
+			 ((errno/acces) 'search-denied)
+			 ((errno/notdir) 'not-directory)
 
-	   (and (let* ((info (apply file-info fd/port/fname maybe-chase?))
-		       (acc (file-info:mode info)))
-		  (cond ((= (file-info:uid info) (user-effective-uid)) ; User
-			 (zero? (bitwise-and acc (arithmetic-shift perms 6))))
+			 ;; If the file doesn't exist, we usually return
+			 ;; 'nonexistent, but we special-case writability
+			 ;; for the directory check.
+			 ((errno/noent)
+			  (and (or (zero? (bitwise-and perms 2))
+				   ;; This string? test *has* to return #t.
+				   ;; If fd/port/fname is an fd or a port,
+				   ;; we wouldn't get an errno/noent error!
+				   ;; Just being paranoid...
+				   (not (string? fd/port/fname))
+				   ;; OK, check to see if we can create
+				   ;; files in the directory.
+				   (file-not-accessible? 2
+				     (directory-as-file-name
+				       (file-name-directory fd/port/fname))))
+			       'nonexistent)))
 
-			((= (file-info:gid info) (user-effective-gid)) ; Group
-			 (zero? (bitwise-and acc (arithmetic-shift perms 3))))
-			((memv (file-info:gid info) (user-supplementary-gids))
-			 (zero? (bitwise-and acc (arithmetic-shift perms 3))))
+      (and (let* ((info (file-info fd/port/fname))
+		  (acc (file-info:mode info)))
+	     (cond ((zero? uid) #f)	; Root can do as he wishes.
 
-			(else				    ; Other
-			 (zero? (bitwise-and acc perms)))))
-		'permission)))))
+		   ((= (file-info:uid info) (user-effective-uid)) ; User
+		    (zero? (bitwise-and acc (arithmetic-shift perms 6))))
+		      
+		   ((or (= (file-info:gid info) (user-effective-gid)) ; Group
+			(memv (file-info:gid info) (user-supplementary-gids)))
+		    (zero? (bitwise-and acc (arithmetic-shift perms 3))))
+		      
+		   (else		; Other
+		    (zero? (bitwise-and acc perms)))))
+	   'permission))))
 
 ;;;;;;