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

Modified Files: ffi.lisp osicat-glue.c osicat.lisp packages.lisp test-osicat.lisp test-tools.lisp Log Message: Experimental addition of MAKE-TEMPORARY-FILE, WITH-TEMPORARY-FILE. Some minor cleanups.

Date: Tue Jul 5 18:55:47 2005 Author: jsquires

Index: src/ffi.lisp diff -u src/ffi.lisp:1.3 src/ffi.lisp:1.4 --- src/ffi.lisp:1.3 Fri Apr 23 02:01:20 2004 +++ src/ffi.lisp Tue Jul 5 18:55:46 2005 @@ -69,6 +69,10 @@ :module "osicat" :returning :cstring)

+(def-function "osicat_tmpfile" () + :module "osicat" + :returning :int) + ;;;; PLAIN POSIX

(def-function "opendir" ((name :cstring)) @@ -130,3 +134,7 @@ (def-function "chdir" ((name :cstring)) :module "osicat" :returning :int) + +(def-function "tmpnam" ((template :cstring)) + :module "osicat" + :returning :cstring) \ No newline at end of file

Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.8 src/osicat-glue.c:1.9 --- src/osicat-glue.c:1.8 Fri Apr 23 02:01:20 2004 +++ src/osicat-glue.c Tue Jul 5 18:55:46 2005 @@ -25,6 +25,7 @@ #include <sys/stat.h> #include <pwd.h> #include <errno.h> +#include <unistd.h>

extern int osicat_mode (char * name, int follow_p) @@ -116,3 +117,16 @@ return pwent->pw_shell; }

+ +#include <stdio.h> +#include <stdlib.h> + +extern int +osicat_tmpfile (void) +{ + FILE *fp; + + fp = tmpfile (); + if (fp == NULL) return -1; + return fileno (fp); +}

Index: src/osicat.lisp diff -u src/osicat.lisp:1.31 src/osicat.lisp:1.32 --- src/osicat.lisp:1.31 Mon Jul 26 15:25:30 2004 +++ src/osicat.lisp Tue Jul 5 18:55:46 2005 @@ -45,7 +45,7 @@ regular-file symbolic-link pipe socket)) (t (error 'bug :message - (format nil "Unknown file mode: ~H." mode))))))))) + (format nil "Unknown file mode: ~A." mode))))))))) (def))

(defmacro with-c-file @@ -129,6 +129,39 @@ (with-cstring (cfile (namestring path)) (c-file-kind cfile nil))))

+;;;; Temporary files + +(defun make-temporary-file (&key (element-type 'character)) + "function MAKE-TEMPORARY-FILE (&key element-type) => stream + +Makes a temporary file setup for input and output, and returns a +stream connected to that file. ELEMENT-TYPE specifies the unit of +transaction of the stream. + +On failure, a FILE-ERROR may be signalled." + #+(or cmu sbcl) + (let ((fd (osicat-tmpfile))) + (unless (>= fd 0) (signal 'file-error)) + #+cmu(sys:make-fd-stream fd :input t :output t + :element-type element-type) + #+sbcl(sb-sys:make-fd-stream fd :input t :output t + :element-type element-type)) + ;; XXX Warn about insecurity? Or is any platform too dumb to have + ;; fds, also relatively safe from race conditions through obscurity? + ;; XXX Another bug with this: the file doesn't get unlinked. + #-(or cmu sbcl) + (open (tmpnam nil) :direction :io :element-type element-type)) + + +(defmacro with-temporary-file ((stream &key element-type) &body body) + "macro WITH-TEMPORARY-FILE (stream &key element-type) &body body => stream" + `(let ((,stream (make-temporary-file + ,@(when element-type + `(:element-type ,element-type))))) + (unwind-protect + (progn ,@body) + (close ,stream :abort t)))) + ;;;; Directory access

(defmacro with-directory-iterator ((iterator pathspec) &body body) @@ -346,7 +379,7 @@ (if hard "hard" "symbolic") new old)))) (setf (current-directory) old))))

-;;; File permissions +;;;; File permissions

(defconstant +permissions+ (if (boundp '+permissions+) (symbol-value '+permissions+)

Index: src/packages.lisp diff -u src/packages.lisp:1.12 src/packages.lisp:1.13 --- src/packages.lisp:1.12 Sun Apr 25 16:59:06 2004 +++ src/packages.lisp Tue Jul 5 18:55:46 2005 @@ -57,6 +57,9 @@ #:make-link ;; Permissions #:file-permissions + ;; Temporary files + #:make-temporary-file + #:with-temporary-file ;; Password entries #:user-info ;; Version info

Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.10 src/test-osicat.lisp:1.11 --- src/test-osicat.lisp:1.10 Sun Apr 25 17:10:58 2004 +++ src/test-osicat.lisp Tue Jul 5 18:55:47 2005 @@ -49,6 +49,8 @@ (error () :error))))) t)

+;;; XXX: (user-homedir-pathname) is "home:" under CMUCL, so this test +;;; will fail. (deftest environment.1 (namestring (probe-file (cdr (assoc "HOME" (environment) :test #'equal)))) @@ -312,20 +314,20 @@

;; 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))) + (let* ((uid (our-getuid)) + (user-info (user-info uid))) + (equal (cdr (assoc :user-id user-info)) uid)) 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)) + (let* ((uid (our-getuid)) + (user-info (user-info uid))) + (file-kind (cdr (assoc :home user-info)))) :directory)

;; We'll go out on a limb and assume that not only does the root @@ -336,3 +338,11 @@ (file-kind home)) :directory)

+ +(deftest temporary-file.1 + (with-temporary-file (stream) + (let ((pos (file-position stream))) + (print 'foo stream) + (file-position stream pos) + (eql (read stream) 'foo))) + t)

Index: src/test-tools.lisp diff -u src/test-tools.lisp:1.2 src/test-tools.lisp:1.3 --- src/test-tools.lisp:1.2 Mon Mar 1 00:28:22 2004 +++ src/test-tools.lisp Tue Jul 5 18:55:47 2005 @@ -49,6 +49,11 @@ ((null kind) (make-link link :target target)) (t (error "File exists and is not a link.")))))

+(defun our-getuid () + #+sbcl (sb-posix:getuid) + #+cmu (unix:unix-getuid) + #-(or sbcl cmu) 0) ; A sane enough default for testing? + ;;; Test environment

(defun teardown ()