Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl
Commits: 146b616f by Raymond Toy at 2025-01-01T11:24:46-08:00 Add unix-mkdtemp and with-temporary-directory
Add `unix-mkdtemp` as a very basic interface to `mkdtemp` that returns the name of the directory.
The macro `ext:with-temporary-directory` creates a temporary directory with the given prefix and executes the body with the name of the directory. On completion, the directory is removed.
- - - - -
2 changed files:
- src/code/extensions.lisp - src/code/unix.lisp
Changes:
===================================== src/code/extensions.lisp ===================================== @@ -22,7 +22,8 @@ read-char-no-edit listen-skip-whitespace concat-pnames iterate once-only collect do-anonymous undefined-value required-argument define-hash-cache defun-cached - cache-hash-eq do-hash)) + cache-hash-eq do-hash + with-temporary-file))
(import 'lisp::whitespace-char-p)
@@ -622,7 +623,7 @@ decoding-error encoding-error) &parse-body (forms decls)) - "A temporary file is opened using the Open-args and bound to the + _N"A temporary file is opened using the Open-args and bound to the variable Var. The name of the temporary file uses Template-prefix for the name. If the temporary file cannot be opened, the forms are not evaluated. The Forms are executed, and when they terminate, @@ -639,19 +640,19 @@ (template (gensym "TEMPLATE-")))
`(let* ((,template (concatenate 'string - ,template-prefix - "XXXXXX")) - (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) - :auto-close t - :file ,template - :output t - :input t - :element-type ',element-type - :external-format ,external-format - :decoding-error ,decoding-error - :encoding-error ,encoding-error - :buffering ,buffering)) - (,abortp t)) + ,template-prefix + "XXXXXX")) + (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) + :auto-close t + :file ,template + :output t + :input t + :element-type ',element-type + :external-format ,external-format + :decoding-error ,decoding-error + :encoding-error ,encoding-error + :buffering ,buffering)) + (,abortp t)) ,@decls (unwind-protect (multiple-value-prog1 @@ -659,3 +660,21 @@ (setq ,abortp nil)) (when ,var (close ,var :abort ,abortp)))))) + +;; WITH-TEMPORARY-DIRECTORY -- Public +(defmacro with-temporary-directory ((var template-prefix) + &parse-body (forms decls)) + _N"Create a temporary directory using Template-prefix as the name of the directory." + (let ((template (gensym "TEMPLATE-"))) + `(let ((,template (concatenate 'string ,template-prefix + "XXXXXX"))) + ,@decls + (let ((,var (unix::unix-mkdtemp ,template))) + (unless ,var + (error "Could not create temporary directory using template ~A" + ,template)) + (unwind-protect + (multiple-value-prog1 + (progn ,@forms))) + ;; Remove the directory + (unix:unix-rmdir ,var)))))
===================================== src/code/unix.lisp ===================================== @@ -2909,3 +2909,33 @@ (syscall ("mkstemp" c-call:c-string) result (copy-seq template))) + +(defun unix-mkdtemp (template) + _N"Generate a uniquely named temporary directory from Template, + which must have "XXXXXX" as the last six characters. The + directory is created with permissions 0700. The name of the + directory is returned." + (let* ((new-template (copy-seq template)) + (result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + c-call:c-string)) + new-template))) + (if (zerop (deref result 0)) + (values nil (unix-errno)) + (cast result c-call:c-string)))) + +(defun unix-mkdtemp (template) + _N"Generate a uniquely named temporary directory from Template, + which must have "XXXXXX" as the last six characters. The + directory is created with permissions 0700. The name of the + directory is returned." + (let* ((new-template (copy-seq template)) + (result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + c-call:c-string)) + new-template))) + (if (zerop (sap-int (alien-sap result))) + (values nil (unix-errno)) + (cast result c-string))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/146b616fc2a125d60205534e...