-;;; FIXME: Isn't there now a POSIX routine to parse the passwd file?
-;;; getpwent? getpwuid?
-(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))))))))))))
+(defun directory (pathname &key)
+ #!+sb-doc
+ "Return a list of PATHNAMEs, each the TRUENAME of a file that matched the
+ given pathname. Note that the interaction between this ANSI-specified
+ TRUENAMEing and the semantics of the Unix filesystem (symbolic links..)
+ means this function can sometimes return files which don't have the same
+ directory as PATHNAME."
+ (let (;; We create one entry in this hash table for each truename,
+ ;; as an asymptotically efficient way of removing duplicates
+ ;; (which can arise when e.g. multiple symlinks map to the
+ ;; same truename).
+ (truenames (make-hash-table :test #'equal))
+ ;; FIXME: Possibly this MERGE-PATHNAMES call should only
+ ;; happen once we get a physical pathname.
+ (merged-pathname (merge-pathnames pathname)))
+ (labels ((do-physical-directory (pathname)
+ (aver (not (logical-pathname-p pathname)))
+ (!enumerate-matches (match pathname)
+ (let* ((*ignore-wildcards* t)
+ ;; FIXME: Why not TRUENAME? As reported by
+ ;; Milan Zamazal sbcl-devel 2003-10-05, using
+ ;; TRUENAME causes a race condition whereby
+ ;; removal of a file during the directory
+ ;; operation causes an error. It's not clear
+ ;; what the right thing to do is, though. --
+ ;; CSR, 2003-10-13
+ (truename (probe-file match)))
+ (when truename
+ (setf (gethash (namestring truename) truenames)
+ truename)))))
+ (do-directory (pathname)
+ (if (logical-pathname-p pathname)
+ (let ((host (intern-logical-host (pathname-host pathname))))
+ (dolist (x (logical-host-canon-transls host))
+ (destructuring-bind (from to) x
+ (let ((intersections
+ (pathname-intersections pathname from)))
+ (dolist (p intersections)
+ (do-directory (translate-pathname p from to)))))))
+ (do-physical-directory pathname))))
+ (do-directory merged-pathname))
+ (mapcar #'cdr
+ ;; Sorting isn't required by the ANSI spec, but sorting
+ ;; into some canonical order seems good just on the
+ ;; grounds that the implementation should have repeatable
+ ;; behavior when possible.
+ (sort (loop for name being each hash-key in truenames
+ using (hash-value truename)
+ collect (cons name truename))
+ #'string<
+ :key #'car))))