Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv25938 Modified Files: ffi.lisp osicat-glue.c osicat.lisp packages.lisp test-osicat.lisp Log Message: * Added USER-INFO, a function for accessing passwd entries. * Fixed left-over use of GET-ENVIRON in SETF ENVIRONMENT, and added test case to catch that happening again. Date: Thu Apr 22 20:01:20 2004 Author: jsquires Index: src/ffi.lisp diff -u src/ffi.lisp:1.2 src/ffi.lisp:1.3 --- src/ffi.lisp:1.2 Sun Feb 29 13:10:41 2004 +++ src/ffi.lisp Thu Apr 22 20:01:20 2004 @@ -41,6 +41,34 @@ :module "osicat" :returning :cstring) +(def-function "osicat_pwent_name" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_passwd" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_uid" ((entry :pointer-void)) + :module "osicat" + :returning :int) + +(def-function "osicat_pwent_gid" ((entry :pointer-void)) + :module "osicat" + :returning :int) + +(def-function "osicat_pwent_gecos" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_home" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_shell" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + ;;;; PLAIN POSIX (def-function "opendir" ((name :cstring)) @@ -73,6 +101,14 @@ (def-array-pointer cstring-array :cstring) (def-foreign-var "environ" 'cstring-array "osicat") + +(def-function "getpwnam" ((name :cstring)) + :module "osicat" + :returning :pointer-void) + +(def-function "getpwuid" ((id :int)) + :module "osicat" + :returning :pointer-void) (def-function "readlink" ((name :cstring) (buffer (* :unsigned-char)) (size :size-t)) Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.7 src/osicat-glue.c:1.8 --- src/osicat-glue.c:1.7 Sun Feb 29 13:10:41 2004 +++ src/osicat-glue.c Thu Apr 22 20:01:20 2004 @@ -73,3 +73,46 @@ } } } + +extern char * +osicat_pwent_name (struct passwd * pwent) +{ + return pwent->pw_name; +} + +extern char * +osicat_pwent_passwd (struct passwd * pwent) +{ + return pwent->pw_passwd; +} + +extern int +osicat_pwent_uid (struct passwd * pwent) +{ + return pwent->pw_uid; +} + +extern int +osicat_pwent_gid (struct passwd * pwent) +{ + return pwent->pw_gid; +} + +extern char * +osicat_pwent_gecos (struct passwd * pwent) +{ + return pwent->pw_gecos; +} + +extern char * +osicat_pwent_home (struct passwd * pwent) +{ + return pwent->pw_dir; +} + +extern char * +osicat_pwent_shell (struct passwd * pwent) +{ + return pwent->pw_shell; +} + Index: src/osicat.lisp diff -u src/osicat.lisp:1.18 src/osicat.lisp:1.19 --- src/osicat.lisp:1.18 Wed Apr 21 18:34:35 2004 +++ src/osicat.lisp Thu Apr 22 20:01:20 2004 @@ -106,9 +106,6 @@ (cond ((equal ".." name) :up) ((equal "." name) nil) ((stringp name) name)))) - (fixedtype (path) - (let ((type (pathname-type path))) - (and (stringp type) type))) (fixeddir (path) (let ((dir (pathname-directory (concatenate 'string (namestring path) @@ -275,7 +272,7 @@ (error "Could not access environment (~S)." e)))) (defun (setf environment) (alist) - (let ((oldenv (get-environ))) + (let ((oldenv (environment))) (loop for (var . val) in alist do (setf (environment-variable var) (string val) oldenv (delete var oldenv @@ -402,3 +399,23 @@ (if (minusp (chdir dir)) (error "Could not change current directory.") pathspec))) + +;;;; USER INFORMATION + +(defun user-info (id) + "function USER-INFO name => alist +function USER-INFO user-id => alist + +USER-INFO returns the password entry for the given name or numerical +user ID, as an alist." + (let ((pwent (typecase id + (string (with-cstring (name id) (getpwnam name))) + (integer (getpwuid id)) + (t (make-null-pointer :pointer-void))))) + (when (not (null-pointer-p pwent)) + (list (cons :name (osicat-pwent-name pwent)) + (cons :user-id (osicat-pwent-uid pwent)) + (cons :group-id (osicat-pwent-gid pwent)) + (cons :gecos (osicat-pwent-gid pwent)) + (cons :home (osicat-pwent-home pwent)) + (cons :shell (osicat-pwent-shell pwent)))))) Index: src/packages.lisp diff -u src/packages.lisp:1.7 src/packages.lisp:1.8 --- src/packages.lisp:1.7 Mon Mar 8 01:41:32 2004 +++ src/packages.lisp Thu Apr 22 20:01:20 2004 @@ -55,6 +55,8 @@ #:make-link ;; Permissions #:file-permissions + ;; Password entries + #:user-info ;; Version info #:*osicat-version* )) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.6 src/test-osicat.lisp:1.7 --- src/test-osicat.lisp:1.6 Wed Apr 21 18:34:35 2004 +++ src/test-osicat.lisp Thu Apr 22 20:01:20 2004 @@ -63,6 +63,11 @@ (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) +(deftest environment.3 + ;; No-op test to ensure setf environment actually works. + (setf (environment) (environment)) + #.(environment)) + (deftest environment-variable.1 (environment-variable 'test-variable) nil) @@ -205,16 +210,48 @@ (delete-directory dir))) (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) +;; Test that directories of form foo.bar/ don't become foo/bar/. (deftest mapdir.4 - ;; Test that directories of form foo.bar/ don't become foo/bar/. (let* ((dir (ensure-directories-exist - (merge-pathnames "mapdir-test.type/" *test-dir*))) - (file (ensure-file "foo.bar" dir))) + (merge-pathnames "mapdir-test.type/" *test-dir*)))) (unwind-protect - (let ((*default-directory-defaults* (truename "/tmp/"))) - (mapdir (lambda (x) - (pathname-directory (merge-pathnames x))) - dir)) - (delete-file file) + (dolist (list (remove-if + #'null + (osicat:mapdir + (lambda (x) (pathname-directory x)) + *test-dir*))) + (when (/= (length list) 2) (error "too many path elements."))) (delete-directory dir))) - (#.(pathname-directory (merge-pathnames "mapdir-test.type/" *test-dir*)))) + nil) + +;; Test behavior in the case of an obviously incorrect username. +(deftest user-info.1 + (user-info "definitely_not_a_user!") + nil) + +;; Does this test still work in the case of su/sudo? It should, I +;; think. +#+sbcl +(deftest user-info.2 + (let ((user-id (cdr (assoc :user-id (user-info (sb-posix:getuid)))))) + (equal user-id (sb-posix:getuid))) + t) + +;; Just get our home directory, and see if it exists. I don't +;; think this will work 100% of the time, but it should for most +;; people testing the package; given that, would it be even better +;; to compare the value to (user-homedir-pathname)? +#+sbcl +(deftest user-info.3 + (let ((home (cdr (assoc :home (user-info (sb-posix:getuid)))))) + (file-kind home)) + :directory) + +;; We'll go out on a limb and assume that not only does the root +;; account exist, but its home directory exists, as well. Note +;; that this is unfortunately not always true. +(deftest user-info.4 + (let ((home (cdr (assoc :home (user-info "root"))))) + (file-kind home)) + :directory) +