From 21bb73db9c3f333ead8a848f863b957a6db5a5c9 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 28 Dec 2001 22:58:10 +0000 Subject: [PATCH] 0.pre7.103: rewrote LOOKUP-LOGIN-NAME to use getpwuid() instead of parsing "/etc/passwd" and then trying to speed up that fundamentally slow process by maintaining a fundamentally bogus cache of previous lookup results... ...deleted *UID-HASH-TABLE* ...deleted GET-GROUP-OR-USER-NAME ...deleted GET-GROUP-OR-USER-NAME-AUX ...defined uid_username() in wrap.c to encapsulate the C-level struct dereferencing ...factored the C-to-Lisp conversion logic out of POSIX-GETCWD, anticipating reusing it in LOOKUP-LOGIN-NAME ...rewrote LOOKUP-LOGIN-NAME to call uid_username(), and renamed it to UID-USERNAME --- package-data-list.lisp-expr | 6 +++- src/code/filesys.lisp | 69 ++----------------------------------------- src/code/unix.lisp | 34 ++++++++++++++------- src/runtime/wrap.c | 26 ++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 58 insertions(+), 79 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 3578fd7..724b2f0 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1541,7 +1541,11 @@ This package only tries to implement what happens to be needed by the current implementation of SBCL, and makes no guarantees of interface stability." :use ("CL" "SB!ALIEN" "SB!C-CALL" "SB!EXT" "SB!INT" "SB!SYS") - :export ("D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" + :export (;; wrappers around Unix stuff to give just what Lisp needs + "UID-USERNAME" + + ;; stuff with a one-to-one mapping to Unix constructs + "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" "DEV-T" "DIRECT" "EXECGRP" "EXECOTH" "EXECOWN" "F-DUPFD" "F-GETFD" "F-GETFL" "F-GETOWN" "F-SETFD" "F-SETFL" "F-SETOWN" "FAPPEND" "FASYNC" "FCREAT" "FEXCL" "FIONREAD" "FNDELAY" "FTRUNC" diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 4569837..214e585 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -875,7 +875,7 @@ (defun file-author (file) #!+sb-doc - "Return the file author as a string, or nil if the author cannot be + "Return the file author as a string, or NIL if the author cannot be determined. Signal an error of type FILE-ERROR if FILE doesn't exist, or FILE is a wild pathname." (if (wild-pathname-p file) @@ -891,7 +891,7 @@ (multiple-value-bind (winp dev ino mode nlink uid) (sb!unix:unix-stat name) (declare (ignore dev ino mode nlink)) - (if winp (lookup-login-name uid)))))) + (and winp (sb!unix:uid-username uid)))))) ;;;; DIRECTORY @@ -932,71 +932,6 @@ #'string< :key #'car)))) -;;;; translating Unix uid's -;;;; -;;;; FIXME: should probably move into unix.lisp - -(defvar *uid-hash-table* (make-hash-table) - #!+sb-doc - "hash table for keeping track of uid's and login names") - -(/show0 "filesys.lisp 844") - -;;; 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 keeps the files from having to be -;;; 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))))) - -;;; 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. -;;; -;;; The result is a SIMPLE-STRING or NIL. -;;; -;;; FIXME: Now that we no longer have lookup-group-name, we no longer need -;;; the GROUP-OR-USER argument. -(defun get-group-or-user-name (group-or-user id) - (declare (type (member :group :user) group-or-user)) - (declare (type index id)) - (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))))) - -;;; 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)))))))))))) - (/show0 "filesys.lisp 899") ;;; predicate to order pathnames by; goes by name diff --git a/src/code/unix.lisp b/src/code/unix.lisp index fbae021..ec2c638 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -264,6 +264,16 @@ (type unix-file-mode mode)) (void-syscall ("mkdir" c-string int) name mode)) +;;; Given a C char* pointer allocated by malloc(), free it and return a +;;; corresponding Lisp string (or return NIL if the pointer is a C NULL). +(defun newcharstar-string (newcharstar) + (declare (type (alien (* char)) newcharstar)) + (if (null-alien newcharstar) + nil + (prog1 + (cast newcharstar c-string) + (free-alien newcharstar)))) + ;;; Return the Unix current directory as a SIMPLE-STRING, in the ;;; style returned by getcwd() (no trailing slash character). (defun posix-getcwd () @@ -272,15 +282,12 @@ ;; pointer is used. On a system which doesn't support that ;; extension, it'll have to be rewritten somehow. #!-(or linux openbsd freebsd) (,stub,) - (let* ((raw-char-ptr (alien-funcall (extern-alien "getcwd" - (function (* char) - (* char) size-t)) - nil 0))) - (if (null-alien raw-char-ptr) - (simple-perror "getcwd") - (prog1 - (cast raw-char-ptr c-string) - (free-alien raw-char-ptr))))) + (or (newcharstar-string (alien-funcall (extern-alien "getcwd" + (function (* char) + (* char) + size-t)) + nil 0)) + (simple-perror "getcwd"))) ;;; Return the Unix current directory as a SIMPLE-STRING terminated ;;; by a slash character. @@ -320,9 +327,16 @@ ;;; Return the process id of the current process. (define-alien-routine ("getpid" unix-getpid) int) -;;; Return the real user-id associated with the current process. +;;; Return the real user id associated with the current process. (define-alien-routine ("getuid" unix-getuid) int) +;;; Translate a user id into a login name. +(defun uid-username (uid) + (or (newcharstar-string (alien-funcall (extern-alien "uid_username" + (function (* char) int)) + uid)) + (error "found no match for Unix uid=~S" uid))) + ;;; Invoke readlink(2) on the file name specified by PATH. Return ;;; (VALUES LINKSTRING NIL) on success, or (VALUES NIL ERRNO) on ;;; failure. diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c index bf6088c..1331e6d 100644 --- a/src/runtime/wrap.c +++ b/src/runtime/wrap.c @@ -29,6 +29,8 @@ #include #include #include +#include + #include "runtime.h" #include "sbcl.h" @@ -224,3 +226,27 @@ fstat_wrapper(int filedes, struct stat_wrapper *buf) copy_to_stat_wrapper(buf, &real_buf); return ret; } + +/* + * getpwuid() stuff + */ + +/* Return a newly-allocated string holding the username for "uid", or + * NULL if there's no such user. + * + * KLUDGE: We also return NULL if malloc() runs out of memory + * (returning strdup() result) since it's not clear how to handle that + * error better. -- WHN 2001-12-28 */ +char * +uid_username(int uid) +{ + struct passwd *p = getpwuid(uid); + if (p) { + /* The object *p is a static struct which'll be overwritten by + * the next call to getpwuid(), so it'd be unsafe to return + * p->pw_name without copying. */ + return strdup(p->pw_name); + } else { + return 0; + } +} diff --git a/version.lisp-expr b/version.lisp-expr index a044495..24416c2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.102" +"0.pre7.103" -- 1.7.10.4