April 2004 - osicat-cvs@common-lisp.net - mailman3.common-lisp.net

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22258 Modified Files: osicat.lisp test-osicat.lisp Log Message: Updated copyright on files I've done much with. Date: Sun Apr 25 11:10:58 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.29 src/osicat.lisp:1.30 --- src/osicat.lisp:1.29 Sun Apr 25 10:59:06 2004 +++ src/osicat.lisp Sun Apr 25 11:10:58 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003, 2004 Nikodemus Siivola +;; Copyright (c) 2003, 2004 Nikodemus Siivola, Julian Squires ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.9 src/test-osicat.lisp:1.10 --- src/test-osicat.lisp:1.9 Sun Apr 25 10:57:57 2004 +++ src/test-osicat.lisp Sun Apr 25 11:10:58 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003 Nikodemus Siivola +;; Copyright (c) 2003, 2004 Nikodemus Siivola, Julian Squires ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the

1 0

[osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv11045 Modified Files: make-readme.lisp osicat.lisp packages.lisp Log Message: * Documentation update. Date: Sun Apr 25 10:59:06 2004 Author: nsiivola Index: src/make-readme.lisp diff -u src/make-readme.lisp:1.2 src/make-readme.lisp:1.3 --- src/make-readme.lisp:1.2 Sun Apr 25 08:24:12 2004 +++ src/make-readme.lisp Sun Apr 25 10:59:06 2004 @@ -33,7 +33,7 @@ when doc collect (cons (symbol-name sym) doc)))) (setf syms (sort syms #'string< :key #'car)) - (format t "OSICAT ~A~%~%" osicat:*osicat-version*) + (format t "OSICAT ~{~A~^.~}~%~%" osicat:*osicat-version*) (format t "~A~%~%---~%~%" (documentation (find-package :osicat) t)) (format t "Dictionary:~%~%") (dolist (cons syms) Index: src/osicat.lisp diff -u src/osicat.lisp:1.28 src/osicat.lisp:1.29 --- src/osicat.lisp:1.28 Sun Apr 25 10:57:57 2004 +++ src/osicat.lisp Sun Apr 25 10:59:06 2004 @@ -21,7 +21,11 @@ (in-package :osicat) -(defparameter *osicat-version* '(0 4 0)) +(defparameter *osicat-version* '(0 4 0) + "variable *OSICAT-VERSION* + +Osicat version number represented as a list of three integers. The +three integers represent major, minor, and revision versions.") ;;;; Common subroutines @@ -345,7 +349,7 @@ ;;; File permissions (defconstant +permissions+ (if (boundp '+permissions+) - +permissions+ + (symbol-value '+permissions+) (mapcar (lambda (x) (cons (intern (symbol-name x) :keyword) (eval x))) Index: src/packages.lisp diff -u src/packages.lisp:1.11 src/packages.lisp:1.12 --- src/packages.lisp:1.11 Sun Apr 25 09:50:58 2004 +++ src/packages.lisp Sun Apr 25 10:59:06 2004 @@ -26,7 +26,9 @@ on Unix-platforms. It is not a POSIX-style API, but rather a simple lispy accompaniment to the standard ANSI facilities. -Osicat homepage: http://www.common-lisp.net/project/osicat +Osicat homepage: + + http://www.common-lisp.net/project/osicat/ Concepts:

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv3584 Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed a bug in READ-LINK for long links. * Updated tests with respect to dead NORMPATH. * Added WITH-DIRECTORY-ITERATOR tests. Date: Sun Apr 25 10:57:57 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.27 src/osicat.lisp:1.28 --- src/osicat.lisp:1.27 Sun Apr 25 10:44:34 2004 +++ src/osicat.lisp Sun Apr 25 10:57:57 2004 @@ -306,7 +306,7 @@ (with-c-file (path (absolute-pathname pathspec) :symbolic-link) (do* ((size 64 (* size 2)) (buffer #1=(allocate-foreign-string size) #1#) - (got (readlink path buffer size))) + (got #2=(readlink path buffer size) #2#)) ((< got size) (let ((str (convert-from-foreign-string buffer :length got))) (free-foreign-object buffer) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.8 src/test-osicat.lisp:1.9 --- src/test-osicat.lisp:1.8 Sat Apr 24 12:40:02 2004 +++ src/test-osicat.lisp Sun Apr 25 10:57:57 2004 @@ -50,9 +50,8 @@ t) (deftest environment.1 - (namestring (osicat::normpath (cdr (assoc "HOME" (environment) - :test #'equal)) - t)) + (namestring (probe-file (cdr (assoc "HOME" (environment) + :test #'equal)))) #.(namestring (user-homedir-pathname))) (deftest environment.2 @@ -158,7 +157,30 @@ (delete-file file) (delete-file link))) :symbolic-link) - + +;; Test the case of reading a link to a directory. +(deftest read-link.1 + (let ((link (merge-pathnames "read-link-test-link" *test-dir*))) + (unwind-protect + (progn + (make-link link :target *test-dir*) + (namestring (read-link link))) + (delete-file link))) + #.(namestring *test-dir*)) + +;; Test the case of reading a link with a very long name. +(deftest read-link.1 + (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) + (file (ensure-file "a-very-long-tmp-file-name-explicitly-for-the-purpose-of-testing-a-certain-condition-in-read-link-please-ignore-thanks"))) + (unwind-protect + (progn + (make-link link :target file) + (equal (namestring (merge-pathnames file *test-dir*)) + (namestring (read-link link)))) + (delete-file link) + (delete-file file))) + t) + (deftest maunbound-environment-variable.1 (let ((old (environment-variable :path))) (unwind-protect @@ -225,6 +247,63 @@ (when (/= (length list) 2) (error "too many path elements."))) (delete-directory dir))) nil) + +;; Be careful with this test. It deletes directories recursively. +(deftest with-directory-iterator.1 + (let ((dirs (list "wdi-test-1/" ".wdi-test.2/" ".wdi.test.3../"))) + (ensure-directories-exist (reduce (lambda (x y) (merge-pathnames y x)) + (cons *test-dir* dirs))) + (labels ((rm-r (dir) + (with-directory-iterator (next dir) + (loop for file = (next) + while file + when (and (eql (file-kind file) :directory) + (member (namestring file) dirs + :test #'string=)) + do (progn (rm-r file) + (delete-directory file)))))) + (rm-r *test-dir*))) + nil) + +;; Test iteration over a variety of objects. +(deftest with-directory-iterator.2 + (let ((playground '(:directory "wdi-test-1/" + (:directory "wdi-test-2/" + (:symbolic-link "bar" "foo") + (:directory "baz/" + (:file "quux")) + (:file "foo"))))) + (labels + ((create-playground (x base-dir) + (case (car x) + (:file (ensure-file (cadr x) base-dir)) + (:symbolic-link (make-link (merge-pathnames (cadr x) base-dir) + :target (merge-pathnames + (caddr x) base-dir))) + (:directory (ensure-directories-exist (merge-pathnames + (cadr x) base-dir)) + (dolist (y (cddr x)) + (create-playground y (merge-pathnames + (cadr x) base-dir)))))) + (walk (dir) + (with-directory-iterator (next dir) + (loop for file = (next) + while file + collect (case (file-kind file) + (:directory + (append (list :directory (namestring file)) + (sort (walk file) + (lambda (a b) + (string<= (cadr a) (cadr b)))))) + (:symbolic-link + (list :symbolic-link (namestring file) + (pathname-name (namestring + (read-link file))))) + (t (list :file (namestring file)))))))) + (create-playground playground *test-dir*) + (equal (walk (merge-pathnames (cadr playground) *test-dir*)) + (cddr playground)))) + t) ;; Test behavior in the case of an obviously incorrect username. (deftest user-info.1

1 0

[osicat-cvs] CVS update: src/osicat.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv23387 Modified Files: osicat.lisp Log Message: * Use a list as the internal version number, so that user code depending on version X doesn't have to do any parsing. Date: Sun Apr 25 10:44:34 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.26 src/osicat.lisp:1.27 --- src/osicat.lisp:1.26 Sun Apr 25 09:50:58 2004 +++ src/osicat.lisp Sun Apr 25 10:44:34 2004 @@ -21,10 +21,7 @@ (in-package :osicat) -(defparameter *osicat-version* - #.(with-open-file (f (merge-pathnames "version.txt" - *compile-file-truename*)) - (symbol-name (read f)))) +(defparameter *osicat-version* '(0 4 0)) ;;;; Common subroutines

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv3873 Modified Files: osicat.lisp packages.lisp Log Message: * New function ABSOLUTE-PATHNAME-P. * Export pathname utilities. Date: Sun Apr 25 09:50:58 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.25 src/osicat.lisp:1.26 --- src/osicat.lisp:1.25 Sun Apr 25 09:14:18 2004 +++ src/osicat.lisp Sun Apr 25 09:50:58 2004 @@ -26,7 +26,7 @@ *compile-file-truename*)) (symbol-name (read f)))) -;;;; COMMON SUBROUTINES +;;;; Common subroutines (declaim (inline c-file-kind)) (macrolet ((def () @@ -68,10 +68,25 @@ ,@forms)) forms))))) +;;;; Hopefully portable pathname manipulations + +(defun absolute-pathname-p (pathspec) + "function ABSOLUTE-PATHNAME-P pathspec => boolean + +Returns T if the pathspec designates an absolute pathname, NIL otherwise." + (eq :absolute (car (pathname-directory pathspec)))) + (defun relative-pathname-p (pathspec) - (not (eq :absolute (car (pathname-directory pathspec))))) + "function RELATIVE-PATHNAME-p pathspec => boolean + +Returns T if the pathspec designates a relative pathname, NIL otherwise." + (not (absolute-pathname-p pathspec))) (defun absolute-pathname (pathspec &optional (default *default-pathname-defaults*)) + "function ABSOLUTE-PATHNAME pathspec &optional default => pathname + +Returns an absolute pathname corresponding to pathspec by merging it with default, +and (current-directory) if necessary." (if (relative-pathname-p pathspec) (let ((tmp (merge-pathnames pathspec @@ -82,10 +97,13 @@ tmp)) pathspec)) -(defun unmerge-pathnames - (pathspec &optional (known *default-pathname-defaults*)) +(defun unmerge-pathnames (pathspec &optional (default *default-pathname-defaults*)) + "function UNMERGE-PATHNAMES pathspec &optional default => pathname + +Removes those leading directory components from pathspec that are +shared with default." (let* ((dir (pathname-directory pathspec)) - (mismatch (mismatch dir (pathname-directory known) :test #'equal))) + (mismatch (mismatch dir (pathname-directory default) :test #'equal))) (make-pathname :directory (when mismatch `(:relative ,@(subseq dir mismatch))) @@ -110,7 +128,7 @@ (with-cstring (cfile (namestring path)) (c-file-kind cfile nil)))) -;;;; DIRECTORY ACCESS +;;;; Directory access (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value @@ -208,6 +226,8 @@ pathspec (error "Could not delete directory ~S." pathspec)))) +;;;; Environment access + (defun environment-variable (name) "function ENVIRONMENT-VARIABLE name => string function (SETF (ENVIRONMENT-VARIABLE name) value) => value @@ -272,6 +292,8 @@ do (makunbound-environment-variable var))) alist) +;;;; Symbolic and hard links + (defun read-link (pathspec) "function READ-LINK pathspec => pathname @@ -323,14 +345,17 @@ (if hard "hard" "symbolic") new old)))) (setf (current-directory) old)))) -(define-symbol-macro +permissions+ - (load-time-value (mapcar (lambda (x) - (cons (intern (symbol-name x) :keyword) - (eval x))) - '(user-read user-write user-exec - group-read group-write group-exec - other-read other-write other-exec - set-user-id set-group-id sticky)))) +;;; File permissions + +(defconstant +permissions+ (if (boundp '+permissions+) + +permissions+ + (mapcar (lambda (x) + (cons (intern (symbol-name x) :keyword) + (eval x))) + '(user-read user-write user-exec + group-read group-write group-exec + other-read other-write other-exec + set-user-id set-group-id sticky)))) (defun file-permissions (pathspec) "function FILE-PERMISSIONS pathspec => list @@ -366,6 +391,8 @@ :initial-value 0))) perms (error "Could not set file permissions of ~S to ~S." pathspec perms)))) + +;;;; Current directory (defun current-directory () "function CURRENT-DIRECTORY => pathname Index: src/packages.lisp diff -u src/packages.lisp:1.10 src/packages.lisp:1.11 --- src/packages.lisp:1.10 Sun Apr 25 08:24:12 2004 +++ src/packages.lisp Sun Apr 25 09:50:58 2004 @@ -59,5 +59,9 @@ #:user-info ;; Version info #:*osicat-version* + ;; Pathname utilities + #:absolute-pathname + #:absolute-pathname-p + #:relative-pathname-p + #:unmerge-pathnames )) -

1 0

[osicat-cvs] CVS update: src/osicat.asd src/osicat.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv18664 Modified Files: osicat.asd osicat.lisp Log Message: * Die NORMPATH, die! Date: Sun Apr 25 09:14:18 2004 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.8 src/osicat.asd:1.9 --- src/osicat.asd:1.8 Sun Apr 25 07:02:24 2004 +++ src/osicat.asd Sun Apr 25 09:14:18 2004 @@ -83,7 +83,7 @@ ;;;; TESTING (defsystem :osicat-test - :depends-on (:osicat :rt) + :depends-on (:osicat :rt #+sbcl :sb-posix) :components ((:file "test-tools") (:file "test-osicat" :depends-on ("test-tools")))) Index: src/osicat.lisp diff -u src/osicat.lisp:1.24 src/osicat.lisp:1.25 --- src/osicat.lisp:1.24 Sun Apr 25 08:24:12 2004 +++ src/osicat.lisp Sun Apr 25 09:14:18 2004 @@ -91,24 +91,6 @@ `(:relative ,@(subseq dir mismatch))) :defaults pathspec))) -(defun normpath (pathspec &optional absolute) - (flet ((fixeddir (path) - (let ((dir (pathname-directory - (concatenate 'string (namestring path) "/")))) - (if (member (car dir) '(:absolute :relative)) - dir - (cons :relative dir))))) - (let ((path (absolute-pathname pathspec))) - (with-cstring (cfile (namestring path)) - (let ((abspath (if (eq :directory (c-file-kind cfile t)) - (make-pathname :name nil :type nil - :directory (fixeddir path) - :defaults path) - path))) - (if absolute - abspath - (unmerge-pathnames abspath))))))) - ;;;; FILE-KIND (defun file-kind (pathspec) @@ -153,12 +135,13 @@ (with-unique-names (one-iter) `(call-with-directory-iterator ,pathspec (lambda (,one-iter) + (declare (type function ,one-iter)) (macrolet ((,iterator () `(funcall ,',one-iter))) ,@body))))) (defun call-with-directory-iterator (pathspec fun) - (let ((dir (normpath pathspec t)) + (let ((dir (absolute-pathname pathspec)) (old-dir (current-directory))) (with-c-file (cdir dir :directory t) (let (dp) @@ -220,7 +203,7 @@ Signals an error if pathspec is wild, doesn't designate a directory, or if the directory could not be deleted." - (with-c-file (path (normpath pathspec t) :directory) + (with-c-file (path (absolute-pathname pathspec) :directory) (if (zerop (rmdir path)) pathspec (error "Could not delete directory ~S." pathspec)))) @@ -301,7 +284,7 @@ (handler-bind ;; FIXME: Declare types properly to get rid of this. (#+sbcl (sb-ext:compiler-note #'muffle-warning)) - (with-c-file (path (normpath pathspec t) :symbolic-link) + (with-c-file (path (absolute-pathname pathspec) :symbolic-link) (do* ((size 64 (* size 2)) (buffer #1=(allocate-foreign-string size) #1#) (got (readlink path buffer size))) @@ -333,7 +316,7 @@ (with-c-file (old (if hard (merge-pathnames target link) target)) (with-c-file (new link) (setf (current-directory) - (normpath *default-pathname-defaults* t)) + (absolute-pathname *default-pathname-defaults*)) (if (zerop (funcall (if hard #'link #'symlink) old new)) (pathname link) (error "MAKE-LINK: Could not create ~A link ~S -> ~S."

1 0

[osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv26078 Modified Files: make-readme.lisp osicat.lisp packages.lisp Log Message: * Documentation updates. Date: Sun Apr 25 08:24:12 2004 Author: nsiivola Index: src/make-readme.lisp diff -u src/make-readme.lisp:1.1 src/make-readme.lisp:1.2 --- src/make-readme.lisp:1.1 Sun Feb 29 07:44:47 2004 +++ src/make-readme.lisp Sun Apr 25 08:24:12 2004 @@ -34,9 +34,10 @@ collect (cons (symbol-name sym) doc)))) (setf syms (sort syms #'string< :key #'car)) (format t "OSICAT ~A~%~%" osicat:*osicat-version*) - (format t "~A~%~%~%" (documentation (find-package :osicat) t)) + (format t "~A~%~%---~%~%" (documentation (find-package :osicat) t)) + (format t "Dictionary:~%~%") (dolist (cons syms) (format t "~& - ~A~%" (string-downcase (car cons)))) - (format t "~%~%") + (format t "~%") (dolist (cons syms) (format t "---~%~%~A~%~%" (cdr cons))))) Index: src/osicat.lisp diff -u src/osicat.lisp:1.23 src/osicat.lisp:1.24 --- src/osicat.lisp:1.23 Sun Apr 25 08:11:31 2004 +++ src/osicat.lisp Sun Apr 25 08:24:12 2004 @@ -141,14 +141,15 @@ such that successive invocations of (iterator) return the directory entries, one by one. Both files and directories are returned, except '.' and '..'. The order of entries is not guaranteed. The entries are -returned as relative pathnames against the designated -directory. Entries that are symbolic links are not resolved, but links -that point to directories are interpreted as directory -designators. Once all entries have been returned, further invocations -of (iterator) will all return NIL. +returned as relative pathnames against the designated directory. +Entries that are symbolic links are not resolved, but links that point +to directories are interpreted as directory designators. Once all +entries have been returned, further invocations of (iterator) will all +return NIL. The value returned is the value of the last form evaluated in -body. Signals an error if pathspec is wild or does not designate a directory." +body. Signals an error if pathspec is wild or does not designate a +directory." (with-unique-names (one-iter) `(call-with-directory-iterator ,pathspec (lambda (,one-iter) @@ -298,6 +299,7 @@ Signals an error if pathspec is wild, or does not designate a symbolic link." (handler-bind + ;; FIXME: Declare types properly to get rid of this. (#+sbcl (sb-ext:compiler-note #'muffle-warning)) (with-c-file (path (normpath pathspec t) :symbolic-link) (do* ((size 64 (* size 2)) Index: src/packages.lisp diff -u src/packages.lisp:1.9 src/packages.lisp:1.10 --- src/packages.lisp:1.9 Sun Apr 25 07:16:25 2004 +++ src/packages.lisp Sun Apr 25 08:24:12 2004 @@ -34,8 +34,7 @@ When a relative pathname designator is used as a directory designator it is first resolved agains *default-pathname-default*, and then - against the current directory. (With MERGE-PATHNAMES in both cases.) -") + against the current directory. (With MERGE-PATHNAMES in both cases.)") (:shadow ;; DIRECTORY is used as constant internally. Let's not confuse other packages. #:directory)

1 0

[osicat-cvs] CVS update: src/osicat.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv17487 Modified Files: osicat.lisp Log Message: * Rewrote WITH-DIRECTORY-ITERATOR in CALL-WITH... style. Date: Sun Apr 25 08:11:32 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.22 src/osicat.lisp:1.23 --- src/osicat.lisp:1.22 Sun Apr 25 07:16:25 2004 +++ src/osicat.lisp Sun Apr 25 08:11:31 2004 @@ -142,52 +142,58 @@ entries, one by one. Both files and directories are returned, except '.' and '..'. The order of entries is not guaranteed. The entries are returned as relative pathnames against the designated -directory. Entries that are symbolic links are not resolved. Once all -entries have been returned, further invocations of (iterator) will all -return NIL. +directory. Entries that are symbolic links are not resolved, but links +that point to directories are interpreted as directory +designators. Once all entries have been returned, further invocations +of (iterator) will all return NIL. The value returned is the value of the last form evaluated in body. Signals an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir old-dir one-iter) - `(let ((,dir (normpath ,pathspec t)) - (,old-dir (current-directory))) - (with-c-file (,cdir ,dir :directory t) - (let (,dp) - (unwind-protect - (labels ((,one-iter () - (let ((entry (readdir ,dp))) - (if (null-pointer-p entry) - nil - (let* ((cname (osicat-dirent-name entry)) - (name (convert-from-cstring cname))) - (declare (type simple-string name)) - (cond - ((member name '("." "..") :test #'string=) - (,one-iter)) - ((eq :directory (c-file-kind cname t)) - (make-pathname - :directory `(:relative ,name))) - (t - (let ((dotpos (position #\. name :from-end t))) - (if (and dotpos (plusp dotpos)) - (make-pathname - :name (subseq name 0 dotpos) - :type (subseq name (1+ dotpos))) - (make-pathname - :name name)))))))))) - (macrolet ((,iterator () - `(,',one-iter))) - (setf ,dp (opendir ,cdir)) - (when (null-pointer-p ,dp) - (error "Error opening directory ~S." ,dir)) - (let ((*default-pathname-defaults* ,dir)) - (setf (current-directory) ,dir) - ,@body))) - (when ,dp - (if (zerop (closedir ,dp)) - nil - (error "Error closing directory ~S." ,dir))) - (setf (current-directory) ,old-dir))))))) + (with-unique-names (one-iter) + `(call-with-directory-iterator ,pathspec + (lambda (,one-iter) + (macrolet ((,iterator () + `(funcall ,',one-iter))) + ,@body))))) + +(defun call-with-directory-iterator (pathspec fun) + (let ((dir (normpath pathspec t)) + (old-dir (current-directory))) + (with-c-file (cdir dir :directory t) + (let (dp) + (unwind-protect + (labels ((one-iter () + (let ((entry (readdir dp))) + (if (null-pointer-p entry) + nil + (let* ((cname (osicat-dirent-name entry)) + (name (convert-from-cstring cname))) + (declare (type simple-string name)) + (cond + ((member name '("." "..") :test #'string=) + (one-iter)) + ((eq :directory (c-file-kind cname t)) + (make-pathname + :directory `(:relative ,name))) + (t + (let ((dotpos (position #\. name :from-end t))) + (if (and dotpos (plusp dotpos)) + (make-pathname + :name (subseq name 0 dotpos) + :type (subseq name (1+ dotpos))) + (make-pathname + :name name)))))))))) + (setf dp (opendir cdir)) + (when (null-pointer-p dp) + (error "Error opening directory ~S." dir)) + (let ((*default-pathname-defaults* dir)) + (setf (current-directory) dir) + (funcall fun #'one-iter))) + (when dp + (if (zerop (closedir dp)) + nil + (error "Error closing directory ~S." dir))) + (setf (current-directory) old-dir)))))) (defun mapdir (function pathspec) "function MAPDIR function pathspec => list

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv5559 Modified Files: osicat.lisp packages.lisp Log Message: * Arrgh. It seems that SBCL at least doesn't like pathname types with dots anymore, so make sure that all the dots end up in the name. Date: Sun Apr 25 07:16:25 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.21 src/osicat.lisp:1.22 --- src/osicat.lisp:1.21 Sun Apr 25 07:02:24 2004 +++ src/osicat.lisp Sun Apr 25 07:16:25 2004 @@ -168,7 +168,7 @@ (make-pathname :directory `(:relative ,name))) (t - (let ((dotpos (position #\. name))) + (let ((dotpos (position #\. name :from-end t))) (if (and dotpos (plusp dotpos)) (make-pathname :name (subseq name 0 dotpos) Index: src/packages.lisp diff -u src/packages.lisp:1.8 src/packages.lisp:1.9 --- src/packages.lisp:1.8 Thu Apr 22 20:01:20 2004 +++ src/packages.lisp Sun Apr 25 07:16:25 2004 @@ -34,7 +34,8 @@ When a relative pathname designator is used as a directory designator it is first resolved agains *default-pathname-default*, and then - against the current directory. (With MERGE-PATHNAMES in both cases.)") + against the current directory. (With MERGE-PATHNAMES in both cases.) +") (:shadow ;; DIRECTORY is used as constant internally. Let's not confuse other packages. #:directory)

1 0

[osicat-cvs] CVS update: src/osicat.asd src/osicat.lisp src/version.txt
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19018 Modified Files: osicat.asd osicat.lisp version.txt Log Message: * Better handling of returned directory entries in WITH-DIRECTORY-ITERATOR. This also let's use be rid of ESCAPE-WILD-NAME which was unportable. * Incremented version number to 0.4.0 in preparation for release. Date: Sun Apr 25 07:02:24 2004 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.7 src/osicat.asd:1.8 --- src/osicat.asd:1.7 Fri Mar 5 13:34:54 2004 +++ src/osicat.asd Sun Apr 25 07:02:24 2004 @@ -69,7 +69,7 @@ ;;;; SYSTEM (defsystem :osicat - :version "0.3.6" + :version "0.4.0" :depends-on (:uffi) :components ((:c-source-file "osicat-glue") Index: src/osicat.lisp diff -u src/osicat.lisp:1.20 src/osicat.lisp:1.21 --- src/osicat.lisp:1.20 Sat Apr 24 12:40:02 2004 +++ src/osicat.lisp Sun Apr 25 07:02:24 2004 @@ -82,15 +82,6 @@ tmp)) pathspec)) -(defun escape-wild-name (name) - (declare (simple-string name)) - (let (stack) - (loop for char across name - when (member char '(#\* #\[)) - do (push #\\ stack) - do (push char stack)) - (coerce (nreverse stack) 'simple-string))) - (defun unmerge-pathnames (pathspec &optional (known *default-pathname-defaults*)) (let* ((dir (pathname-directory pathspec)) @@ -142,21 +133,24 @@ (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value -The directory designated by pathspec is then bound to -*default-pathname-defaults* for the dynamic scope of the body. +Pathspec must be a valid directory designator: +*default-pathname-defaults* is bound, and (current-directory) is set +to the designated directory for the dynamic scope of the body. Within the lexical scope of the body, iterator is defined via macrolet such that successive invocations of (iterator) return the directory entries, one by one. Both files and directories are returned, except '.' and '..'. The order of entries is not guaranteed. The entries are -returned as relative pathnames against the directory. Entries that are -symbolic links are not resolved. Once all entries have been returned, -further invocations of (iterator) will all return NIL. +returned as relative pathnames against the designated +directory. Entries that are symbolic links are not resolved. Once all +entries have been returned, further invocations of (iterator) will all +return NIL. The value returned is the value of the last form evaluated in body. Signals an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir one-iter) - `(let ((,dir (normpath ,pathspec t))) + (with-unique-names (dp dir cdir old-dir one-iter) + `(let ((,dir (normpath ,pathspec t)) + (,old-dir (current-directory))) (with-c-file (,cdir ,dir :directory t) (let (,dp) (unwind-protect @@ -164,24 +158,36 @@ (let ((entry (readdir ,dp))) (if (null-pointer-p entry) nil - (let ((string - (convert-from-cstring - (osicat-dirent-name entry)))) - (if (member string '("." "..") - :test #'string=) - (,one-iter) - (normpath (escape-wild-name string)))))))) + (let* ((cname (osicat-dirent-name entry)) + (name (convert-from-cstring cname))) + (declare (type simple-string name)) + (cond + ((member name '("." "..") :test #'string=) + (,one-iter)) + ((eq :directory (c-file-kind cname t)) + (make-pathname + :directory `(:relative ,name))) + (t + (let ((dotpos (position #\. name))) + (if (and dotpos (plusp dotpos)) + (make-pathname + :name (subseq name 0 dotpos) + :type (subseq name (1+ dotpos))) + (make-pathname + :name name)))))))))) (macrolet ((,iterator () `(,',one-iter))) (setf ,dp (opendir ,cdir)) (when (null-pointer-p ,dp) (error "Error opening directory ~S." ,dir)) (let ((*default-pathname-defaults* ,dir)) + (setf (current-directory) ,dir) ,@body))) (when ,dp (if (zerop (closedir ,dp)) nil - (error "Error closing directory ~S." ,dir))))))))) + (error "Error closing directory ~S." ,dir))) + (setf (current-directory) ,old-dir))))))) (defun mapdir (function pathspec) "function MAPDIR function pathspec => list Index: src/version.txt diff -u src/version.txt:1.9 src/version.txt:1.10 --- src/version.txt:1.9 Fri Mar 5 13:34:54 2004 +++ src/version.txt Sun Apr 25 07:02:24 2004 @@ -1 +1 @@ -0.3.6 +0.4.0

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 24 Apr '04

24 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv30849 Modified Files: osicat.lisp test-osicat.lisp Log Message: Fixed a dumb USER-INFO typo. Fixed environment.3 test (#.(environment) of course can end up with a value different from (environment)). Removed extraneous fixednam flet. Date: Sat Apr 24 12:40:03 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.19 src/osicat.lisp:1.20 --- src/osicat.lisp:1.19 Thu Apr 22 20:01:20 2004 +++ src/osicat.lisp Sat Apr 24 12:40:02 2004 @@ -101,15 +101,9 @@ :defaults pathspec))) (defun normpath (pathspec &optional absolute) - (flet ((fixedname (path) - (let ((name (pathname-name path))) - (cond ((equal ".." name) :up) - ((equal "." name) nil) - ((stringp name) name)))) - (fixeddir (path) - (let ((dir (pathname-directory (concatenate 'string - (namestring path) - "/")))) + (flet ((fixeddir (path) + (let ((dir (pathname-directory + (concatenate 'string (namestring path) "/")))) (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) @@ -407,7 +401,7 @@ function USER-INFO user-id => alist USER-INFO returns the password entry for the given name or numerical -user ID, as an alist." +user ID, as an assoc-list." (let ((pwent (typecase id (string (with-cstring (name id) (getpwnam name))) (integer (getpwuid id)) @@ -416,6 +410,6 @@ (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 :gecos (osicat-pwent-gecos pwent)) (cons :home (osicat-pwent-home pwent)) (cons :shell (osicat-pwent-shell pwent)))))) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.7 src/test-osicat.lisp:1.8 --- src/test-osicat.lisp:1.7 Thu Apr 22 20:01:20 2004 +++ src/test-osicat.lisp Sat Apr 24 12:40:02 2004 @@ -63,10 +63,12 @@ (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) +;; No-op test to ensure setf environment actually works. (deftest environment.3 - ;; No-op test to ensure setf environment actually works. - (setf (environment) (environment)) - #.(environment)) + (let ((old-env (environment))) + (prog1 (setf (environment) nil) + (setf (environment) old-env))) + nil) (deftest environment-variable.1 (environment-variable 'test-variable)

1 0

[osicat-cvs] CVS update: src/ffi.lisp src/osicat-glue.c src/osicat.lisp src/packages.lisp src/test-osicat.lisp
by Julian E. C. Squires 23 Apr '04

23 Apr '04

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) +

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 21 Apr '04

21 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19938 Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed bug where foo.bar/ directories become foo/bar/. Date: Wed Apr 21 18:34:36 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.17 src/osicat.lisp:1.18 --- src/osicat.lisp:1.17 Mon Mar 8 01:41:32 2004 +++ src/osicat.lisp Wed Apr 21 18:34:35 2004 @@ -110,7 +110,9 @@ (let ((type (pathname-type path))) (and (stringp type) type))) (fixeddir (path) - (let ((dir (pathname-directory path))) + (let ((dir (pathname-directory (concatenate 'string + (namestring path) + "/")))) (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) @@ -118,12 +120,7 @@ (with-cstring (cfile (namestring path)) (let ((abspath (if (eq :directory (c-file-kind cfile t)) (make-pathname :name nil :type nil - :directory - (append (fixeddir path) - (remove-if - #'null - (list (fixedname path) - (fixedtype path)))) + :directory (fixeddir path) :defaults path) path))) (if absolute Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.5 src/test-osicat.lisp:1.6 --- src/test-osicat.lisp:1.5 Sun Feb 29 18:52:23 2004 +++ src/test-osicat.lisp Wed Apr 21 18:34:35 2004 @@ -50,14 +50,16 @@ t) (deftest environment.1 - (cdr (assoc "HOME" (environment) :test #'equal)) + (namestring (osicat::normpath (cdr (assoc "HOME" (environment) + :test #'equal)) + t)) #.(namestring (user-homedir-pathname))) (deftest environment.2 (unwind-protect (progn (setf (environment-variable 'test-variable) "TEST-VALUE") - (assoc "TEST-VARIABLE" environment :test 'equal)) + (assoc "TEST-VARIABLE" (environment) :test #'equal)) (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) @@ -202,3 +204,17 @@ (delete-file file) (delete-directory dir))) (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) + +(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))) + (unwind-protect + (let ((*default-directory-defaults* (truename "/tmp/"))) + (mapdir (lambda (x) + (pathname-directory (merge-pathnames x))) + dir)) + (delete-file file) + (delete-directory dir))) + (#.(pathname-directory (merge-pathnames "mapdir-test.type/" *test-dir*))))

1 0