[osicat-cvs] CVS update: src/ffi.lisp src/osicat-glue.c src/osicat.lisp src/packages.lisp src/test-osicat.lisp
Julian E. C. Squires
jsquires at common-lisp.net
Fri Apr 23 00:01:20 UTC 2004
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)
+
More information about the Osicat-cvs
mailing list