GitLab

at 2025-02-18T02:53:23+00:00

Fix #375:  Return the name of the temp file or directory

Merge branch 'issue-375-mkstemp-return-filename' into 'master'

Fix #375:  Return the name of the temp file or directory

Closes #375

See merge request cmucl/cmucl!265
 (defun unix-mkstemp (template)

   _N"Generates a unique temporary file name from TEMPLATE, and creates

   and opens the file.  On success, the corresponding file descriptor

-  and name of the file is returned.

-

- The last six characters of the template must be \"XXXXXX\"."

-  ;; Hope this buffer is large enough!

-  (let ((octets (%name->file template)))

-    (syscall ("mkstemp" c-call:c-string)

+  and name of the file is returned.  Otherwise, NIL and the UNIX error

+  code is returned."

+  (let* ((format (if (eql *filename-encoding* :null)

+		     :iso8859-1

+		     *filename-encoding*))

+	 ;; Convert the string to octets using the

+	 ;; *FILENAME-ENCODING*.  Should we signal an error if the

+	 ;; string can't be encoded?

+	 (octets (stream:string-to-octets template

+					  :external-format format))

+	 (length (length octets)))

+    (with-alien ((buffer (* c-call:unsigned-char)))

+      (setf buffer (make-alien c-call:unsigned-char (1+ length)))

+      ;; Copy the octets from OCTETS to the null-terminated array BUFFER.

+      (system:without-gcing

+	  (kernel:system-area-copy (vector-sap octets) 0

+				   (alien-sap buffer) 0

+				   (* length vm:byte-bits)))

+      (setf (deref buffer length) 0)

+

+      (syscall ("mkstemp" (* c-call:char))

 	       (values result

-		       ;; Convert the file name back to a Lisp string.

-		       (%file->name octets))

-	       octets)))

+		       (progn

+			 ;; Copy out the alien bytes and convert back

+			 ;; to a lisp string.

+			 (system:without-gcing

+			     (kernel:system-area-copy (alien-sap buffer) 0

+						      (vector-sap octets) 0

+						      (* length vm:byte-bits)))

+			 (stream:octets-to-string octets

+						  :external-format format)))

+	       (cast buffer (* c-call:char))))))

 (defun unix-mkdtemp (template)

-  _N"Generate a uniquely named temporary directory from Template,

-  which must have \"XXXXXX\" as the last six characters.  The

+  _N"Generate a uniquely named temporary directory from Template.  The

   directory is created with permissions 0700.  The name of the

-  directory is returned."

-  (let* ((octets (%name->file template))

-	 (result (alien-funcall

-		  (extern-alien "mkdtemp"

-				(function (* char)

-					  c-call:c-string))

-		  octets)))

-    (if (null-alien result)

-	(values nil (unix-errno))

-	(%file->name octets))))
+  directory is returned.

+

+  If the directory cannot be created NIL and the UNIX error code is

+  returned."

+  (let* ((format (if (eql *filename-encoding* :null)

+		     :iso8859-1

+		     *filename-encoding*))

+	 ;; Encode the string using the appropriate

+	 ;; *filename-encoding*.  Should we signal an error if the

+	 ;; string can't be encoded in that format?

+	 (octets (stream:string-to-octets template

+					  :external-format format))

+	 (length (length octets)))

+    (with-alien ((buffer (* c-call:unsigned-char)))

+      (setf buffer (make-alien c-call:unsigned-char (1+ length)))

+      ;; Copy the octets from OCTETS to the null-terminated array BUFFER.

+      (system:without-gcing

+	  (kernel:system-area-copy (vector-sap octets) 0

+				   (alien-sap buffer) 0

+				   (* length vm:byte-bits)))

+      (setf (deref buffer length) 0)

+

+      (let ((result (alien-funcall

+		     (extern-alien "mkdtemp"

+				   (function (* char)

+					     (* char)))

+		     (cast buffer (* char)))))

+	;; If mkdtemp worked, a non-NIL value is returned, return the

+	;; resulting name.  Otherwise, return NIL and the errno.

+	(if (null-alien result)

+	    (values nil (unix-errno))

+	    (%file->name (cast result c-call:c-string)))))))
 msgid ""

 "Generates a unique temporary file name from TEMPLATE, and creates\n"

 "  and opens the file.  On success, the corresponding file descriptor\n"

-"  and name of the file is returned.\n"

-"\n"

-" The last six characters of the template must be \"XXXXXX\"."

+"  and name of the file is returned.  Otherwise, NIL and the UNIX error\n"

+"  code is returned."

 msgstr ""

 #: src/code/unix.lisp

 msgid ""

-"Generate a uniquely named temporary directory from Template,\n"

-"  which must have \"XXXXXX\" as the last six characters.  The\n"

+"Generate a uniquely named temporary directory from Template.  The\n"

 "  directory is created with permissions 0700.  The name of the\n"

-"  directory is returned."

+"  directory is returned.\n"

+"\n"

+"  If the directory cannot be created NIL and the UNIX error code is\n"

+"  returned."

 msgstr ""

+;;; Tests for the unix interface

+

+(defpackage :unix-tests

+  (:use :cl :lisp-unit))

+

+(in-package "UNIX-TESTS")

+

+(define-test mkstemp.name-returned

+  (:tag :issues)

+  (let (fd filename)

+    (unwind-protect

+	 (progn

+	   (let ((template "test-XXXXXX"))

+	     (multiple-value-setq (fd filename)

+	       (unix::unix-mkstemp (copy-seq template)))

+	     (assert-true fd)

+	     (assert-true (equalp (length filename) (length template)))

+	     (assert-false (equalp filename template))

+	     (assert-true (>= 5 (mismatch filename template))))))

+      (when fd

+	(unix:unix-unlink filename)))))

+

+(define-test mkstemp.non-ascii-name-returned

+  (:tag :issues)

+  (let ((unix::*filename-encoding* :utf-8)

+	fd name)

+    (unwind-protect

+	 (progn

+	   ;; Temp name starts with a lower case alpha character.

+	   (let* ((template (concatenate 'string (string #\u+3b1)

+					 "test-XXXXXX"))

+		  (x-posn (position #\X template)))

+	     (multiple-value-setq (fd name)

+	       (unix::unix-mkstemp template))

+	     (assert-true fd)

+	     (assert-false (search "XXXXXX" name)

+			   name)

+	     (assert-true (string= name template :end1 x-posn :end2 x-posn)

+			  name)))

+      (when fd

+	(unix:unix-unlink name)))))

+

+(define-test mkstemp.bad-path

+  (:tag :issues)

+  (multiple-value-bind (fd errno)

+      ;; Assumes that the directory "random-dir" doesn't exist

+      (unix::unix-mkstemp "random-dir/test-XXXXXX")

+    ;; Can't create and open the file so the FD should be NIL, and a

+    ;; positive Unix errno value should be returned.

+    (assert-false fd)

+    (assert-true (and (integerp errno) (plusp errno)))))

+

+(define-test mkdtemp.name-returned

+  (:tag :issues)

+  (let (name)

+    (unwind-protect

+	 (progn

+	   (setf name (unix::unix-mkdtemp "dir-XXXXXX"))

+	   ;; Verify that the dir name no longer has X's.

+	   (assert-true (stringp name))

+	   (assert-false (search "XXXXXX" name)))

+      (when name

+	(unix:unix-rmdir name)))))

+

+(define-test mkdtemp.non-ascii-name-returned

+  (:tag :issues)

+  (let ((unix::*filename-encoding* :utf-8)

+	name)

+    (unwind-protect

+	 (progn

+	   ;; Temp name starts with a lower case alpha character.

+	   (let* ((template (concatenate 'string (string #\u+3b1)

+					 "dir-XXXXXX"))

+		  (x-posn (position #\X template)))

+	     (setf name (unix::unix-mkdtemp template))

+	     ;; Verify that the dir name no longer has X's.

+	     (assert-true (stringp name))

+	     (assert-false (search "XXXXXX" name))

+	     (assert-true (string= name template :end1 x-posn :end2 x-posn)

+			  name x-posn)))

+      (when name

+	(unix:unix-rmdir name)))))

+

+(define-test mkdtemp.bad-path

+  (:tag :issues)

+  (multiple-value-bind (result errno)

+      (unix::unix-mkdtemp "random-dir/dir-XXXXXX")

+    (assert-false result)

+    (assert-true (and (integerp errno) (plusp errno)))))

+

+

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

3 changed files:

Changes: