[osicat-cvs] CVS update: src/osicat-glue.c src/osicat.lisp src/packages.lisp src/release.txt

Nikodemus Siivola nsiivola at common-lisp.net
Sun Oct 26 14:19:33 UTC 2003


Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv12299

Modified Files:
	osicat-glue.c osicat.lisp packages.lisp release.txt 
Log Message:
Improved documentations. Semi-sane symlink resolution.
Date: Sun Oct 26 09:19:32 2003
Author: nsiivola

Index: src/osicat-glue.c
diff -u src/osicat-glue.c:1.2 src/osicat-glue.c:1.3
--- src/osicat-glue.c:1.2	Thu Oct 23 19:48:05 2003
+++ src/osicat-glue.c	Sun Oct 26 09:19:32 2003
@@ -26,17 +26,24 @@
 #include <pwd.h>
 
 extern int
-osicat_mode (char * name)
+osicat_mode (char * name, int follow_p)
 {
     struct stat buf;
-    if (0 == lstat (name, &buf))
+    int err;
+
+    if (follow_p)
+	err = stat (name, &buf);
+    else
+	err = lstat (name, &buf);
+
+    if (! err)
 	return buf.st_mode;
     else
 	/* I assume that -1 is not a valid mode? */
 	return -1;
 }
 
-char *
+extern char *
 osicat_dirent_name (struct dirent * entry)
 {
     return entry->d_name;


Index: src/osicat.lisp
diff -u src/osicat.lisp:1.2 src/osicat.lisp:1.3
--- src/osicat.lisp:1.2	Thu Oct 23 19:48:05 2003
+++ src/osicat.lisp	Sun Oct 26 09:19:32 2003
@@ -21,7 +21,7 @@
 
 (in-package :osicat)
 
-(def-function ("osicat_mode" c-file-mode) ((name :cstring))
+(def-function ("osicat_mode" c-file-mode) ((name :cstring) (follow-p :int))
   :module "osicat"
   :returning :int)
 
@@ -32,22 +32,24 @@
                              Please report on osicat-devel at common-lisp.net."
 		     (message condition)))))
 
-(eval `(defun c-file-kind (c-file)
-	 (let ((mode (c-file-mode c-file)))
-	   (unless (minusp mode)
-	     (case (logand mode-mask mode)
-	       ,@(mapcar
-		  (lambda (sym)
-		    (list (eval sym)
-			  (intern (symbol-name sym) :keyword)))
-		  ;; KLUDGE: OAOOM. These are in grovel-constants.lisp as well.
-		  '(directory character-device block-device
-		    regular-file symbolic-link pipe socket))
-	       (t (error
-		   'bug :message
-		   (format nil "Unknown file mode: ~H." mode))))))))
+;;; KLUDGE: Would macrolet frob be preferable here? I can't see why...
+(eval 
+ `(defun c-file-kind (c-file follow-p)
+    (let ((mode (c-file-mode c-file (if follow-p 1 0))))
+      (unless (minusp mode)
+	(case (logand mode-mask mode)
+	  ,@(mapcar
+	     (lambda (sym)
+	       (list (eval sym)
+		     (intern (symbol-name sym) :keyword)))
+	     ;; OAOOM: These are in grovel-constants.lisp as well.
+	     '(directory character-device block-device
+	       regular-file symbolic-link pipe socket))
+	  (t (error
+	      'bug :message
+	      (format nil "Unknown file mode: ~H." mode))))))))
 
-(defmacro with-c-file ((c-file pathname &optional required-kind) &body forms)
+(defmacro with-c-file ((c-file pathname &optional required-kind follow-p) &body forms)
   ;; FIXME: This assumes that OS has the same idea of current dir as Lisp
   (with-unique-names (path)
     `(let ((,path ,pathname))
@@ -55,14 +57,14 @@
 	 (error "Pathname is wild: ~S." ,path))
        (with-cstring (,c-file (namestring ,path))
 	 ,(etypecase required-kind
-	     (keyword `(let ((real-kind (c-file-kind ,c-file)))
+	     (keyword `(let ((real-kind (c-file-kind ,c-file ,follow-p)))
 			 (unless (eq ,required-kind real-kind)
 			   (if real-kind
 			       (error "~A is ~A, not ~A."
 				      ,path real-kind ,required-kind)
 			       (error "~A ~S does not exist."
 				      ,required-kind ,path)))))
-	     ((eql t) `(unless (c-file-kind ,c-file)
+	     ((eql t) `(unless (c-file-kind ,c-file ,follow-p)
 			 (error "~A does not exist." ,path)))
 	     (null nil))
 	 , at forms))))
@@ -71,15 +73,19 @@
   "function FILE-KIND pathspec => file-kind
 
 Returns a keyword indicating the kind of file designated by pathspec,
-or NIL if the file does not exist.
+or NIL if the file does not exist. Does not follow symbolic links.
 
 Possible file-kinds in addition to NIL are: :regular-file,
 :symbolic-link, :directory,:pipe, :socket, :character-device, and
 :block-device.
 
 Signals an error if pathspec is wild."
-  (with-c-file (c pathspec)
-    (c-file-kind c)))
+  ;; KLUDGE: OAOOM: We scurry to avoid an extra lstat here. 
+  (let ((path (pathname pathspec)))
+    (when (wild-pathname-p path)
+      (error "Pathname is wild: ~S." path))
+    (with-cstring (cfile (namestring path))
+      (c-file-kind cfile 0))))
 
 (def-function "opendir" ((name :cstring))
   :module "osicat"
@@ -97,8 +103,6 @@
   :module "osicat"
   :returning :cstring)
 
-;;; FIXME: Documentation, DIRECTORY-LIST?
-
 (defmacro with-directory-iterator ((iterator pathspec) &body body)
   "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value
 
@@ -110,12 +114,15 @@
 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.
+The value returned is the value of the last form evaluated in
+body.
+
+If pathspec designates a symbolic link, it is implicitly resolved.
 
-Signal an error if pathspec is wild or does not designate a directory."
+Signal an error if pathspec is wild or does not designate a directory."  
   (with-unique-names (dp dir cdir err default)
     `(let ((,dir ,pathspec))
-       (with-c-file (,cdir ,dir :directory)
+       (with-c-file (,cdir ,dir :directory t)
 	 (let ((,dp nil)
 	       (,default (make-pathname :name nil
 					:version nil
@@ -146,6 +153,8 @@
 Applies function to each entry in directory designated by pathspec in
 turn and returns a list of the results.
 
+If pathspec designates a symbolic link, it is implicitly resolved.
+
 Signals an error if pathspec is wild or doesn't designate a directory."
   (with-directory-iterator (next pathspec)
     (loop for entry = (next)
@@ -160,7 +169,7 @@
   "function DELETE-DIRECTORY pathspec => T
 
 Deletes the direcotry designated by pathspec. Returns T.  The
-directory must be empty.
+directory must be empty. Symbolic links are not followed.
 
 Signals an error if pathspec is wild, doesn't designate a directory,
 or if the direcotry could not be deleted."
@@ -213,14 +222,11 @@
 	  value
 	  (error "Could not set environment variable ~S to ~S." name value)))))
 
-(setf (documentation '(setf environment-variable) 'function)
-      (documentation 'environment-variable 'function))
-
 (defun makunbound-environment-variable (name)
   "function MAKUNBOUND-ENVIRONMENT-VARIABLE name => string
 
-Removes the environenr variable identified by NAME from the current
-environment. NAME can be either a string or a symbol. Returns the
+Removes the environment variable identified by name from the current
+environment. name can be either a string or a symbol. Returns the
 string designated by name. Signals an error on failure."
   (with-c-name (cname name)
     (if (zerop (unsetenv cname))
@@ -310,31 +316,32 @@
 function (SETF (FILE-PERMISSIONS pathspec) list) => list
 
 FILE-PERMISSIONS returns a list of keywords identifying the
-permissions of PATHSPEC. 
+permissions of pathspec.
 
-SETF FILE-PERMISSIONS sets the permissions of PATHSPEC as identified
+SETF FILE-PERMISSIONS sets the permissions of pathspec as identified
 by the symbols in list.
 
+If pathspec designates a symbolic link, that link is implicitly
+resolved.
+
 Permission symbols consist of :USER-READ, :USER-WRITE, :USER-EXEC,
 :GROUP-READ, :GROUP-WRITE, :GROUP-EXEC, :OTHER-READ, :OTHER-WRITE,
 :OTHER-EXEC, :SET-USER-ID, :SET-GROUP-ID, and :STICKY.
 
 Both signal an error is pathspec is wild, or doesn't designate an
 exiting file."
-  (with-c-file (path pathspec t)
-    (let ((mode (c-file-mode path)))
+  (with-c-file (path pathspec t t)
+    ;; FIXME: We stat twice here.
+    (let ((mode (c-file-mode path 1)))
       (loop for (name . value) in +permissions+
 	    when (plusp (logand mode value))
 	    collecting name))))
 
 (defun (setf file-permissions) (perms pathspec)
-  (with-c-file (path pathspec t)
+  (with-c-file (path pathspec t t)
     (if (zerop (chmod path (reduce (lambda (a b)
 				     (logior a (cdr (assoc b +permissions+))))
 				   perms
 				   :initial-value 0)))
 	perms
 	(error "Could not set file permissions of ~S to ~S." pathspec perms))))
-
-(setf (documentation '(setf file-permissions) 'function)
-      (documentation 'file-permissions 'function))


Index: src/packages.lisp
diff -u src/packages.lisp:1.1.1.1 src/packages.lisp:1.2
--- src/packages.lisp:1.1.1.1	Wed Oct 15 10:11:02 2003
+++ src/packages.lisp	Sun Oct 26 09:19:32 2003
@@ -21,6 +21,9 @@
 
 (defpackage :osicat  
   (:use :cl :uffi) 
+  (:documentation "Osicat is a lightweight operating system interface
+for Common Lisp on Unix-platforms. It is not a POSIX-style API, but
+rather a simple lispy accompaniment to the standard ANSI facilities.")
   (:export
    ;;; Evironment
    #:environment   


Index: src/release.txt
diff -u src/release.txt:1.2 src/release.txt:1.3
--- src/release.txt:1.2	Thu Oct 23 19:48:05 2003
+++ src/release.txt	Sun Oct 26 09:19:32 2003
@@ -6,3 +6,4 @@
 osicat.lisp
 osicat-glue.c
 LICENSE
+README





More information about the Osicat-cvs mailing list