[gnu.emacs.bug] On BSD, file-writable-p always returns t if you're root

cks@white.toronto.edu (Chris Siebenmann) (06/27/89)

 This hinders attempts to do things like use write permissions to
indicate whether a file is currently checked in with a revision
control system. Unfortunately, the C code uses access() to determine
whether it can write to a file, so I don't have a fix; I've attached
my workaround.

--- improved-writable.el
;; redefine file-writable-p so it works more "correctly" when you are root
;
; BUGS: See improved-file-writable-p for details.
;
; Last edited: Mon Mar 13 20:32:37 1989 by cks (Chris Siebenmann) on sleepy.white

(defun improved-file-writable-p (fn)
  "Returns t if a file exists and can be written by you, or if the file
doesn't exist but the directory can be written by you. Doesn't suffer
from the old file-writable-p's defect of always returning t when your
UID is 0.

BUGS: The criterion for writablity when you are root are somewhat odd; if
the file is writable at all, or its parent directory exists, then we
return t. This problem exists both because of the author's laziness and
a defect in the GNU Emacs system interface (no user-gid function).

For extra bonus points, write one that works across NFS."
  (if (not (eq (user-uid) 0))
      (writeable-bogus fn)
    (let ((attr (file-attributes fn)))
      (if (not attr) ; not there, check parent directory.
	  (if (file-attributes (file-name-directory fn))
	      t
	    nil)
	(let ((modes (nth 8 attr))
	      (owner (nth 2 attr))
	      (group (nth 3 attr))
	      (dir (eq t (car attr))))
	  (cond (dir
		 t) ; directories always writable
		((string-match "w" modes) ; if it's writable to someone, we'll
					; take it
		 t)
	  ))))))

; rebind things (tadah!)
(defun writeable-bogus (fn)
  "dummy for stashing file-writable-p."
  nil)

; this is a magical incantation
; (possible theory : symbol-function generates a new lisp object for us;
;  with just fset, we're sharing the old one (which gets nuked with the next
;  fset)
(fset 'writeable-bogus (symbol-function 'file-writable-p))

; We only bother doing it when root for effeciency purposes.
(if (eq (user-uid) 0)
    (fset 'file-writable-p 'improved-file-writable-p))

-- 
	"I shall clasp my hands together and bow to the corners of the world."
			Number Ten Ox, "Bridge of Birds"
Chris Siebenmann		...!utgpu!{ncrcan,ontmoh!moore}!ziebmef!cks
cks@white.toronto.edu	     or ...!utgpu!{,csri!}cks