From jsquires at common-lisp.net Tue Jul 5 16:55:49 2005 From: jsquires at common-lisp.net (Julian E. C. Squires) Date: Tue, 5 Jul 2005 18:55:49 +0200 (CEST) Subject: [osicat-cvs] CVS update: src/ffi.lisp src/osicat-glue.c src/osicat.lisp src/packages.lisp src/test-osicat.lisp src/test-tools.lisp Message-ID: <20050705165549.117B7880DF@common-lisp.net> 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 #include #include +#include extern int osicat_mode (char * name, int follow_p) @@ -116,3 +117,16 @@ return pwent->pw_shell; } + +#include +#include + +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 , at 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 () From jsquires at common-lisp.net Tue Jul 5 17:48:13 2005 From: jsquires at common-lisp.net (Julian E. C. Squires) Date: Tue, 5 Jul 2005 19:48:13 +0200 (CEST) Subject: [osicat-cvs] CVS update: src/osicat.lisp Message-ID: <20050705174813.A3B70880DF@common-lisp.net> Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22256 Modified Files: osicat.lisp Log Message: Some OpenMCL fixes for ...-TEMPORARY-FILES and USER-INFO. Date: Tue Jul 5 19:48:13 2005 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.32 src/osicat.lisp:1.33 --- src/osicat.lisp:1.32 Tue Jul 5 18:55:46 2005 +++ src/osicat.lisp Tue Jul 5 19:48:12 2005 @@ -150,7 +150,8 @@ ;; 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)) + (open (convert-from-cstring (tmpnam (make-null-pointer 'cstring))) + :direction :io :element-type element-type)) (defmacro with-temporary-file ((stream &key element-type) &body body) @@ -465,9 +466,9 @@ (integer (getpwuid id)) (t (make-null-pointer :pointer-void))))) (when (not (null-pointer-p pwent)) - (list (cons :name (osicat-pwent-name pwent)) + (list (cons :name (convert-from-cstring (osicat-pwent-name pwent))) (cons :user-id (osicat-pwent-uid pwent)) (cons :group-id (osicat-pwent-gid pwent)) - (cons :gecos (osicat-pwent-gecos pwent)) - (cons :home (osicat-pwent-home pwent)) - (cons :shell (osicat-pwent-shell pwent)))))) + (cons :gecos (convert-from-cstring (osicat-pwent-gecos pwent))) + (cons :home (convert-from-cstring (osicat-pwent-home pwent))) + (cons :shell (convert-from-cstring (osicat-pwent-shell pwent))))))) From jsquires at common-lisp.net Fri Jul 8 14:18:21 2005 From: jsquires at common-lisp.net (Julian E. C. Squires) Date: Fri, 8 Jul 2005 16:18:21 +0200 (CEST) Subject: [osicat-cvs] CVS update: src/ffi.lisp src/osicat.lisp Message-ID: <20050708141821.E8C02880E0@common-lisp.net> Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv20175 Modified Files: ffi.lisp osicat.lisp Log Message: Updated MAKE-TEMPORARY-FILE to unlink temporary file when not using tmpfile(3). Date: Fri Jul 8 16:18:19 2005 Author: jsquires Index: src/ffi.lisp diff -u src/ffi.lisp:1.4 src/ffi.lisp:1.5 --- src/ffi.lisp:1.4 Tue Jul 5 18:55:46 2005 +++ src/ffi.lisp Fri Jul 8 16:18:19 2005 @@ -137,4 +137,8 @@ (def-function "tmpnam" ((template :cstring)) :module "osicat" - :returning :cstring) \ No newline at end of file + :returning :cstring) + +(def-function "unlink" ((pathname :cstring)) + :module "osicat" + :returning :int) Index: src/osicat.lisp diff -u src/osicat.lisp:1.33 src/osicat.lisp:1.34 --- src/osicat.lisp:1.33 Tue Jul 5 19:48:12 2005 +++ src/osicat.lisp Fri Jul 8 16:18:19 2005 @@ -148,10 +148,14 @@ :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. + ;; XXX Will unlinking the file after opening the stream work the way + ;; we expect? #-(or cmu sbcl) - (open (convert-from-cstring (tmpnam (make-null-pointer 'cstring))) - :direction :io :element-type element-type)) + (let* ((name (tmpnam (make-null-pointer 'cstring))) + (stream (open (convert-from-cstring name) :direction :io + :element-type element-type))) + (unlink name) + stream)) (defmacro with-temporary-file ((stream &key element-type) &body body)