/[cmucl]/src/code/filesys.lisp
ViewVC logotype

Diff of /src/code/filesys.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.70 by toy, Fri Nov 8 15:26:51 2002 UTC revision 1.71 by toy, Fri Nov 15 15:08:11 2002 UTC
# Line 765  Line 765 
765    
766  ;;; Probe-File  --  Public  ;;; Probe-File  --  Public
767  ;;;  ;;;
768  ;;; If PATHNAME exists, return it's truename, otherwise NIL.  ;;; If PATHNAME exists, return its truename, otherwise NIL.
769  ;;;  ;;;
770  (defun probe-file (pathname)  (defun probe-file (pathname)
771    "Return a pathname which is the truename of the file if it exists, NIL    "Return a pathname which is the truename of the file if it exists, NIL
# Line 885  Line 885 
885          (multiple-value-bind (winp dev ino mode nlink uid)          (multiple-value-bind (winp dev ino mode nlink uid)
886                               (unix:unix-stat name)                               (unix:unix-stat name)
887            (declare (ignore dev ino mode nlink))            (declare (ignore dev ino mode nlink))
888            (if winp (lookup-login-name uid))))))            (when winp
889                (let ((user-info (unix:unix-getpwuid uid)))
890                  (when user-info
891                    (unix:user-info-name user-info))))))))
892    
893    
894  ;;;; DIRECTORY.  ;;;; DIRECTORY.
895    
896  ;;; DIRECTORY  --  public.  ;;; DIRECTORY  --  public.
897  ;;;  ;;;
898  (defun directory (pathname &key (all t) (check-for-subdirs t)  (defun directory (pathname &key (all t) (check-for-subdirs t)
899                             (truenamep t) (follow-links t))                             (truenamep t) (follow-links t))
900    "Returns a list of pathnames, one for each file that matches the given    "Returns a list of pathnames, one for each file that matches the given
# Line 989  Line 992 
992                     (declare (ignore sec min hour date month))                     (declare (ignore sec min hour date month))
993                     (format t "~2D ~8A ~8D ~12A ~A~@[/~]~%"                     (format t "~2D ~8A ~8D ~12A ~A~@[/~]~%"
994                             nlink                             nlink
995                             (or (lookup-login-name uid) uid)                             (let ((user-info (unix:unix-getpwuid uid)))
996                                 (if user-info (unix:user-info-name user-info) uid))
997                             size                             size
998                             (decode-universal-time-for-files mtime year)                             (decode-universal-time-for-files mtime year)
999                             tail                             tail
# Line 1064  Line 1068 
1068      (when return-list      (when return-list
1069        result)))        result)))
1070    
   
   
 ;;;; Translating uid's and gid's.  
   
 (defvar *uid-hash-table* (make-hash-table)  
   "Hash table for keeping track of uid's and login names.")  
   
 ;;; LOOKUP-LOGIN-NAME translates a user id into a login name.  Previous  
 ;;; lookups are cached in a hash table since groveling the passwd(s) files  
 ;;; is somewhat expensive.  The table may hold nil for id's that cannot  
 ;;; be looked up since this means the files are searched in their entirety  
 ;;; each time this id is translated.  
 ;;;  
 (defun lookup-login-name (uid)  
   (multiple-value-bind (login-name foundp) (gethash uid *uid-hash-table*)  
     (if foundp  
         login-name  
         (setf (gethash uid *uid-hash-table*)  
               (get-group-or-user-name :user uid)))))  
   
 (defvar *gid-hash-table* (make-hash-table)  
   "Hash table for keeping track of gid's and group names.")  
   
 ;;; LOOKUP-GROUP-NAME translates a group id into a group name.  Previous  
 ;;; lookups are cached in a hash table since groveling the group(s) files  
 ;;; is somewhat expensive.  The table may hold nil for id's that cannot  
 ;;; be looked up since this means the files are searched in their entirety  
 ;;; each time this id is translated.  
 ;;;  
 (defun lookup-group-name (gid)  
   (multiple-value-bind (group-name foundp) (gethash gid *gid-hash-table*)  
     (if foundp  
         group-name  
         (setf (gethash gid *gid-hash-table*)  
               (get-group-or-user-name :group gid)))))  
   
   
 ;;; GET-GROUP-OR-USER-NAME first tries "/etc/passwd" ("/etc/group") since it is  
 ;;; a much smaller file, contains all the local id's, and most uses probably  
 ;;; involve id's on machines one would login into.  Then if necessary, we look  
 ;;; in "/etc/passwds" ("/etc/groups") which is really long and has to be  
 ;;; fetched over the net.  
 ;;;  
 (defun get-group-or-user-name (group-or-user id)  
   "Returns the simple-string user or group name of the user whose uid or gid  
    is id, or NIL if no such user or group exists.  Group-or-user is either  
    :group or :user."  
   (let ((id-string (let ((*print-base* 10)) (prin1-to-string id))))  
     (declare (simple-string id-string))  
     (multiple-value-bind (file1 file2)  
                          (ecase group-or-user  
                            (:group (values "/etc/group" "/etc/groups"))  
                            (:user (values "/etc/passwd" "/etc/passwd")))  
       (or (get-group-or-user-name-aux id-string file1)  
           (get-group-or-user-name-aux id-string file2)))))  
   
 (defun get-group-or-user-name-aux (id-string passwd-file)  
   (with-open-file (stream passwd-file)  
     (loop  
       (let ((entry (read-line stream nil)))  
         (unless entry (return nil))  
         (let ((name-end (position #\: (the simple-string entry)  
                                   :test #'char=)))  
           (when name-end  
             (let ((id-start (position #\: (the simple-string entry)  
                                       :start (1+ name-end) :test #'char=)))  
               (when id-start  
                 (incf id-start)  
                 (let ((id-end (position #\: (the simple-string entry)  
                                         :start id-start :test #'char=)))  
                   (when (and id-end  
                              (string= id-string entry  
                                       :start2 id-start :end2 id-end))  
                     (return (subseq entry 0 name-end))))))))))))  
   
1071    
1072  ;;;; File completion.  ;;;; File completion.
1073    

Legend:
Removed from v.1.70  
changed lines
  Added in v.1.71

  ViewVC Help
Powered by ViewVC 1.1.5