November 2025 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-454-signal-error-for-bad-pathname-parts] 2 commits: Signal error not cerror for make-pathname errors
by Raymond Toy (＠rtoy) 15 Nov '25

15 Nov '25

Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl Commits: 9e279ba7 by Raymond Toy at 2025-11-15T07:20:05-08:00 Signal error not cerror for make-pathname errors - - - - - b2c51c98 by Raymond Toy at 2025-11-15T07:20:39-08:00 Add tests for make-pathname errors - - - - - 2 changed files: - src/code/pathname.lisp - tests/pathname.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -843,8 +843,11 @@ a host-structure or string." (flet ((check-component-validity (name name-or-type) (when (stringp name) (when (eq host (%pathname-host *default-pathname-defaults*)) - (when (or (find #\/ name :test #'char=) - (find #\nul name :test #'char=)) + (when (find-if #'(lambda (c) + ;; Illegal characters are a slash or NUL. + (or (char= c #\/) + (char= c #\nul))) + name) (cerror _"Continue anyway" _"Pathname component ~A cannot contain a slash or nul character: ~S" name-or-type name)))))) ===================================== tests/pathname.lisp ===================================== @@ -142,3 +142,28 @@ "/*.*") :truenamep nil :follow-links nil))) (assert-equal dir-tilde dir-home)))) + +(define-test issue.454.illegal-pathname-chars + (:tag :issues) + ;; A slash (Unix directory separater) is not allowed. + (assert-error 'simple-error + (make-pathname :name "a/b")) + (assert-error 'simple-error + (make-pathname :type "a/b")) + (assert-error 'simple-error + (make-pathname :directory '(:relative "a/b"))) + ;; ASCII NUL characters are not allowed in Unix pathnames. + (let ((string-with-nul (concatenate 'string "a" (string #\nul) "b"))) + (assert-error 'simple-error + (make-pathname :name string-with-nul)) + (assert-error 'simple-error + (make-pathname :type string-with-nul)) + (assert-error 'simple-error + (make-pathname :directory (list :relative string-with-nul))))) + +(define-test issue.454.illegal-pathname-dot + (:tag :issues) + (assert-error 'simple-error + (make-pathname :name ".")) + (assert-error 'simple-error + (make-pathname :name ".."))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a880… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a880… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-454-signal-error-for-bad-pathname-parts
by Raymond Toy (＠rtoy) 14 Nov '25

14 Nov '25

Raymond Toy pushed new branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-454-signal-error-fo… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update 22a release notes
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 7d268755 by Raymond Toy at 2025-11-13T14:21:32-08:00 Update 22a release notes Add recently fixed issues to the notes. [skip-ci] - - - - - 1 changed file: - src/general-info/release-22a.md Changes: ===================================== src/general-info/release-22a.md ===================================== @@ -25,8 +25,15 @@ public domain. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: - * #387: Update CLX from upstream to version from 2024-09-11. + * #373: Add macros to handle temp files and directories + * #387: Update CLX from upstream to version from 2024-09-11 + * #408: Add C functions to get user name and home dir + * #437: Use `realpath` to find the lisp executable * #444: `unix-stat` and friends return wrong timestamp + * #449: Touch 64-bit timestamp.txt with desired time for testing + * #446: Use C compiler to get errno values to update UNIX + defpackage with errno symbols + * #453: Use correct flags for analyzer and always save logs. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d268755e3caf640ffd6b56… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d268755e3caf640ffd6b56… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #408: Add C functions to get user name and home dir
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 420d3ee2 by Raymond Toy at 2025-11-13T13:38:01-08:00 Fix #408: Add C functions to get user name and home dir - - - - - 143a7651 by Raymond Toy at 2025-11-13T13:38:01-08:00 Merge branch 'issue-408-get-user-name-and-homedir' into 'master' Fix #408: Add C functions to get user name and home dir Closes #408, #373, and #375 See merge request cmucl/cmucl!300 - - - - - 6 changed files: - src/code/filesys.lisp - src/code/os.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/Darwin-os.c - src/lisp/os-common.c Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1232,8 +1232,7 @@ optionally keeping some of the most recent old versions." (declare (ignore sec min hour date month)) (format t "~2D ~8A ~8D ~12A ~A~@[/~]~%" nlink - (let ((user-info (unix:unix-getpwuid uid))) - (if user-info (unix:user-info-name user-info) uid)) + (or (unix::unix-get-username uid) uid) size (decode-universal-time-for-files mtime year) tail ===================================== src/code/os.lisp ===================================== @@ -69,29 +69,21 @@ The status is 0 if no errors occurred. Otherwise a non-zero value is returned. Examining errno may give information about what failed." (declare (string name)) - (cond - ((zerop (length name)) - (multiple-value-bind (user-info status) - (unix:unix-getpwuid (unix:unix-getuid)) - (values (when user-info - (unix:user-info-dir user-info)) - status))) - (t - (alien:with-alien ((status c-call:int)) - (let (result) - (unwind-protect - (progn - (setf result - (alien:alien-funcall - (alien:extern-alien "os_get_user_homedir" - (function (alien:* c-call:c-string) - c-call:c-string - (* c-call:int))) - name - (alien:addr status))) - (if (and (zerop status) - (not (alien:null-alien result))) - (values (alien:cast result c-call:c-string) - status) - (values nil status))) - (alien:free-alien result))))))) + (alien:with-alien ((status c-call:int)) + (let (result) + (unwind-protect + (progn + (setf result + (alien:alien-funcall + (alien:extern-alien "os_get_user_homedir" + (function (alien:* c-call:c-string) + c-call:c-string + (* c-call:int))) + name + (alien:addr status))) + (if (and (zerop status) + (not (alien:null-alien result))) + (values (alien:cast result c-call:c-string) + status) + (values nil status))) + (alien:free-alien result))))) ===================================== src/code/unix.lisp ===================================== @@ -2541,3 +2541,28 @@ ;; Result from strerror can be localized so we need to decode ;; those octets to get a proper Lisp string. (string-decode (cast result c-string) :default))) + +(defun unix-get-username (uid) + _N"Returns a string that is the user name corresponding to the given UID. + If no such uid exists or if the user name does not exist, NIL is + returned." + (with-alien ((status c-call:int)) + (let (result) + (unwind-protect + (progn + (setf result + (alien-funcall + (extern-alien "os_get_user_name" + (function (* c-call:c-string) + uid-t + (* c-call:int))) + uid + (addr status))) + (values + (if (and (zerop status) + (not (null-alien result))) + (cast result c-call:c-string) + nil) + status)) + (free-alien name))))) + ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -810,3 +810,10 @@ msgstr "" msgid "Returns a string that describes the error code Errno" msgstr "" +#: src/code/unix.lisp +msgid "" +"Returns a string that is the user name corresponding to the given UID.\n" +" If no such uid exists or if the user name does not exist, NIL is\n" +" returned." +msgstr "" + ===================================== src/lisp/Darwin-os.c ===================================== @@ -593,7 +593,7 @@ os_temporary_directory(void) len = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); if (len == 0 || len > PATH_MAX || (len == PATH_MAX && path[len - 1] != '/')) { - strlcpy(path, "/tmp/"); + strcpy(path, "/tmp/"); } else if (path[len - 1] != '/') { strcat(path, "/"); } ===================================== src/lisp/os-common.c ===================================== @@ -734,58 +734,97 @@ os_lstat(const char* path, uint64_t *dev, uint64_t *ino, unsigned int *mode, uin } /* - * Interface for file-author. Given a pathname, returns a new string - * holding the author of the file or NULL if some error occurred. The - * caller is responsible for freeing the memory used by the string. + * Basic interface to getpwuid, except we will automatically retry if + * the given buffer is too small. To support this |buffer| is a + * pointer to a char buffer. This will be updated with a new buffer + * if we needed to retry getpwuid with a larger buffer. The remaining + * parameters are the same as for getpwuid. */ -char * -os_file_author(const char *path) +static int +os_getpwuid(uid_t uid, struct passwd *pwd, char **buffer, size_t buflen, struct passwd **result) { - struct stat sb; - char initial[1024]; - char *buffer, *obuffer; - size_t size; - struct passwd pwd; - struct passwd *ppwd; - char *result; - - if (stat(path, &sb) != 0) { - return NULL; - } - - result = NULL; - buffer = initial; - obuffer = NULL; - size = sizeof(initial) / sizeof(initial[0]); + int status; + char *obuffer = NULL; /* * Keep trying with larger buffers until a maximum is reached. We * assume (1 << 20) is large enough for any OS. */ again: - switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + switch (status = getpwuid_r(uid, pwd, *buffer, buflen, result)) { case 0: /* Success, though we might not have a matching entry */ - result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); break; case ERANGE: /* Buffer is too small, double its size and try again */ - size *= 2; - if (size > (1 << 20)) { + buflen *= 2; + if (buflen > (1 << 20)) { break; } - if ((buffer = realloc(obuffer, size)) == NULL) { + if ((*buffer = realloc(obuffer, buflen)) == NULL) { break; } - obuffer = buffer; + obuffer = *buffer; goto again; default: /* All other errors */ break; } free(obuffer); - - return result; + + return status; +} + + +/* + * Given the UID, return the user name. If the uid does not exist, + * returns NULL. The caller must call free on the string that is + * returned. + */ +char * +os_get_user_name(uid_t uid, int *status) +{ + char *buf; + char *name; + struct passwd pwd; + struct passwd *result; + char buffer[1024]; + + buf = buffer; + + *status = os_getpwuid(uid, &pwd, &buf, sizeof(buffer), &result); + + if (*status != 0 || result == NULL || result->pw_name == NULL) { + name = NULL; + } else { + name = strdup(result->pw_name); + if (name == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return name; +} + +/* + * Interface for file-author. Given a pathname, returns a new string + * holding the author of the file or NULL if some error occurred. The + * caller is responsible for freeing the memory used by the string. + */ +char * +os_file_author(const char *path) +{ + int status; + struct stat sb; + + if (stat(path, &sb) != 0) { + return NULL; + } + + return os_get_user_name(sb.st_uid, &status); } int @@ -874,15 +913,8 @@ os_software_version(void) return result; } -/* - * Return the home directory of the user named NAME. If the user does - * not exist, returns NULL. Also returns NULL if the home directory - * cannot be determined for any reason. The parameter STATUS is 0 if - * getpwnam_r was successful. Otherwise it is the return value from - * getpwnam_r or -1 if we ran out of memory for the buffer. - */ -char * -os_get_user_homedir(const char* name, int *status) +static char * +get_homedir_by_user_name(const char* name, int *status) { int buflen; char *buf = NULL; @@ -944,6 +976,60 @@ os_get_user_homedir(const char* name, int *status) return NULL; } +/* + * Return the home directory for the given UID. If the home directory + * does not exist, NULL is returned. STATUS is set to 0 if the home + * directory could be found. Otherwise, it is the errno. + * + * The caller must free the memory returned. + */ +static char * +get_homedir_by_uid(uid_t uid, int *status) +{ + char buffer[1024]; + char *buf; + char *dir; + struct passwd pwd; + struct passwd *result; + + buf = buffer; + dir = NULL; + + *status = os_getpwuid(uid, &pwd, &buf, sizeof(buffer), &result); + + if (*status == 0 && result != NULL && result->pw_dir != NULL) { + dir = strdup(result->pw_dir); + if (dir == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return dir; +} + +/* + * Return the home directory of the user named NAME. If NAME is the + * empty string, returns the home directory of the current user. If + * the user does not exist, returns NULL. Also returns NULL if the + * home directory cannot be determined for any reason. The parameter + * STATUS is 0 if the home directory could be determined. Otherwise + * it is the errno value. + * + * The caller must free the memory returned for the result. + */ +char * +os_get_user_homedir(const char* name, int *status) +{ + if (strlen(name) == 0) { + return get_homedir_by_uid(getuid(), status); + } + + return get_homedir_by_user_name(name, status); +} + /* * Return a new string (or NULL) for the current working directory. * The caller must free this space. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f5484369b32ca4537618d6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f5484369b32ca4537618d6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] Fix typo: strcpy instead of strlcpy
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: 2d139cbe by Raymond Toy at 2025-11-13T12:50:51-08:00 Fix typo: strcpy instead of strlcpy We're copying "/tmp/" into path which is large enough (PATH_MAX) to hold the desired string. - - - - - 1 changed file: - src/lisp/Darwin-os.c Changes: ===================================== src/lisp/Darwin-os.c ===================================== @@ -593,7 +593,7 @@ os_temporary_directory(void) len = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); if (len == 0 || len > PATH_MAX || (len == PATH_MAX && path[len - 1] != '/')) { - strlcpy(path, "/tmp/"); + strcpy(path, "/tmp/"); } else if (path[len - 1] != '/') { strcat(path, "/"); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2d139cbea433ed33d8a7d5c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2d139cbea433ed33d8a7d5c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] 74 commits: Fix #375: Return the name of the temp file or directory
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: 1091de2a by Raymond Toy at 2025-01-31T22:01:28-08:00 Fix #375: Return the name of the temp file or directory The functions `unix-mkstemp` and `unix-mkdtemp` are supposed to return the name of the temporary file or directory. They weren't. Fix these functions so that they do. Also add a new file, tests/unix.lisp, that tests these functions. Finally, update the pot file for the updated docstrings. - - - - - 15501db4 by Raymond Toy at 2025-02-01T09:11:11-08:00 Update bad template tests for Darwin Darwin seems to require at least one X in the template, unlike Linux which requires 6. Update the test for bad templates for both mkstemp and mkdtemp to have no X's in the template. - - - - - 544a6787 by Raymond Toy at 2025-02-01T15:59:09-08:00 Simplify mkdtemp and fix error in mkstemp Since mkdtemp returns a pointer to the resulting directory name, we can convert that to the desired lisp string. In mkstemp, we were converting the resulting buffer to a string but we had `:end (1- length)`. It should be `:end length` to get all the characters. - - - - - 0111bb50 by Raymond Toy at 2025-02-01T16:34:20-08:00 Add tests with template with non-ascii char Add a test for mkstemp and mkdtemp where the template name contains a non-ascii char (lower case alpha) to test the we convert the returned name to a Lisp string correctly. - - - - - 6e0378ea by Raymond Toy at 2025-02-01T16:35:27-08:00 Need to convert the return result of mkdtemp Forgot that we need to encode the result to a proper UTF-16 Lisp string. - - - - - 7275edf3 by Raymond Toy at 2025-02-02T16:01:15-08:00 Disable bad template tests on Darwin Darwin bizarrely allows 0(!) or more X's in the template, so our test for a bad template can't work on Darwin. Disable them. - - - - - 3b6909fe by Raymond Toy at 2025-02-03T07:26:09-08:00 Enforce 6 X's in template for mkstemp/mkdtemp Our API enforces the template to have exactly 6 X's at the end of the template. This is only a problem on Darwin which allows 0 or more X's. Also re-enable the tests for too few X's on Darwin and add tests for too many X's. - - - - - 2759e80f by Raymond Toy at 2025-02-03T07:28:50-08:00 Add tests for template that doesn't end in X's. - - - - - 144065ee by Raymond Toy at 2025-02-03T10:16:16-08:00 Fix typo in unix-mkdtemp We were returning from `unix-mkstemp` instead of `unix-mkdtemp`. - - - - - e9f2fd2d by Raymond Toy at 2025-02-07T10:06:23-08:00 Remove check on template As discussed, we remove the check on the template format. Update the tests because Darwin allows any number of X's in the string. This tests won't be run on Darwin. - - - - - 5814e20d by Raymond Toy at 2025-02-07T12:50:18-08:00 Remove invalid tests and update pot file On linux, the only requirement on the template is the last 6 chars are X's. There could be more. Hence remove these tests. Update the pot file for the changed docstrings. - - - - - 7698e84e by Raymond Toy at 2025-02-07T17:57:05-08:00 Disable some tests on Darwin I tested these on Darwin, and the templates "test-" and ""test-XXXXXXa" succeed by returning exactly these files. Another call would then generate an error since we can't create new files. So it seems on Darwin, any template will work but the only time we get a filename different from the template is if the template ends in X's. - - - - - e9f4ca93 by Raymond Toy at 2025-02-13T20:27:27-08:00 Fix #373: Add macros for temporary streams, files, and directories Add `with-temporary-stream` to create a stream to temp file. Add `with-temporary-directory` to create a temporary directory using a template as a prefix for the name of the directory. The directory and all its contents are removed afterwards. - - - - - 7aa502a1 by Raymond Toy at 2025-02-14T06:45:51-08:00 Update according to review Use an alien array to hold the C string needed by mkstemp and mkdtemp. - - - - - 284722c5 by Raymond Toy at 2025-02-14T10:25:16-08:00 Merge branch 'issue-375-mkstemp-return-filename' into issue-373-handle-temp-files - - - - - 25077d5b by Raymond Toy at 2025-02-14T12:11:38-08:00 Fix with-temporarry-stream so it actually works. Lots of little stupid things were needed to make it actually work instead of producing compilation errors or runtime errors (unknown var). - - - - - 5979379f by Raymond Toy at 2025-02-14T12:12:56-08:00 Add pprinter for with-temporary-{stream,directory} - - - - - eddbb928 by Raymond Toy at 2025-02-14T12:13:24-08:00 Modify test trac.36 to use with-temporary-stream. Original left in, but commented out, for reference. - - - - - 0eb4531e by Raymond Toy at 2025-02-14T12:41:40-08:00 Make with-temporary-directory actuall work. Minor fixups to make with-temporary-directory actually work. - - - - - b3fde57b by Raymond Toy at 2025-02-14T14:35:56-08:00 Append a "/" to the resulting dirname Append a "/" to make the returned string a directory. Thus, calling `pathname` on the result returns a pathname that is a directory, instead of a (possible) directory and a pathname-name. - - - - - 578efc93 by Raymond Toy at 2025-02-17T17:48:37-08:00 Add with-temporary-file to create a temporary file Use mkstemp to create a file and return the file name. On completion, the file is deleted. - - - - - b7ca3635 by Raymond Toy at 2025-02-17T18:55:33-08:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - 9da10f58 by Raymond Toy at 2025-02-18T05:54:18-08:00 Update from HEAD to fix incorrect merge Just update tests/unix.lisp from HEAD because we messed up the merge previously and left some unmerged diffs in by accident. - - - - - 7a2eeb73 by Raymond Toy at 2025-02-19T07:16:22-08:00 Export the new temp file/stream/dir macros These are public interfaces. - - - - - 4411d4ef by Raymond Toy at 2025-02-19T07:16:53-08:00 Add :prefix keyword arg and more error checking For `with-temporary-{file,directory}`, add a `:prefix` keyword arg to allow the user to specify a prefix for the name of the temporary file or directory. Add sume error checking if `mkstemp` or `mkdtemp` fail to create the requested object. We just throw an error with a message with the template and the reason (from errno). Finally, in for the temporary stream, don't add the name of the file to the fd-stream object. The name, by default, ends up being "descriptor n" where n is the fd used. - - - - - 823351a2 by Raymond Toy at 2025-02-19T07:21:27-08:00 Change test trac.43 to use with-temporary-file Tests still passes. - - - - - ade0813f by Raymond Toy at 2025-02-19T13:24:19-08:00 First cut at adding os_temp_path Add os_temp_path to os-common.c to return an appropriate location where temporary files can be placed, depending on the OS. Currently, MacOS, has a special method to return a secure per-user temp directory. For everywhere else, we look at the TMP envvar. If it's not set, we just use "/tmp". Add get-os-temp-path in extensions.lisp to get the temporary path. This is used in the macros, but get-os-temp-path doesn't yet call `os_temp_path`. - - - - - aef4de54 by Raymond Toy at 2025-02-19T18:30:00-08:00 Define PATH_MAX on Macos - - - - - 1f465c57 by Raymond Toy at 2025-02-19T18:32:19-08:00 Use limits.h instead - - - - - 19b21612 by Raymond Toy at 2025-02-19T19:10:27-08:00 Remove unused variable. - - - - - 1a051ff3 by Raymond Toy at 2025-02-19T19:10:44-08:00 Update get-os-temp-path to call os_temp_path Directly call os_temp_path in get-os-temp-path. We take care to free the string that was returned. We also throw an error if NULL is returned. The path returned is made to end with a slash so that creating a CL pathname from it only has directory components. - - - - - 921b2043 by Raymond Toy at 2025-02-20T19:01:54-08:00 Add some comments for os_temp_path. - - - - - 221fa0ae by Raymond Toy at 2025-02-20T19:02:31-08:00 Fix error in creating default template name; clarify docstrings If the prefix arg is no supplied, we choose a default value for the template. It was previously incorrectly computed so make it right. Clarify some docstrings. - - - - - 6698b2c1 by Raymond Toy at 2025-02-20T19:47:44-08:00 Add function to create the template from the prefix or a default name. All of the temporary file/stream/directory macros had common code to create the actual template. Move this into a common function so that we do it the same for everyone. - - - - - 63fdbf0b by Raymond Toy at 2025-02-21T06:14:57-08:00 Convert more tests to use with-temporary-foo - - - - - c8b9082b by Raymond Toy at 2025-02-21T06:21:49-08:00 Convert test to use with-temporary-file - - - - - 087eb17f by Raymond Toy at 2025-02-21T17:54:57-08:00 Fix a typo and use exported symbols Fix a typo in a comment in os_temp_path. `with-temporary-stream` is an exported symbol, so just use "ext:" insteadof "ext::". [SKIP-CI] - - - - - b37ed3a9 by Raymond Toy at 2025-05-10T08:30:16-07:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - 0b748144 by Raymond Toy at 2025-05-26T13:22:35-07:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - bf280b99 by Raymond Toy at 2025-05-26T13:24:11-07:00 Clean up and remove extraneous trailing blanks before EOL - - - - - ce5f05f5 by Raymond Toy at 2025-06-02T07:20:32-07:00 Rename os_temp_path to os_temporary_directory Also, remove the implementation from os-common.c and place it in the various foo-os.c files since the original implementation in os-common.c used some OS-specific features. Update pot file with the new docstrings. - - - - - ee9111e6 by Raymond Toy at 2025-06-02T07:28:56-07:00 Don't use camel case `pathSize` -> `path_size` - - - - - 2beeead3 by Raymond Toy at 2025-06-02T08:48:39-07:00 Darwin needs unistd.h to define confstr Forgot this when we moved os_temporary_directory to here. - - - - - c5c80aef by Raymond Toy at 2025-11-06T06:38:25-08:00 21f is not a WIP Remove the heading from the release notes for 21f. Forgot to fix this when doing the 21f release. [skip-ci] - - - - - b764d014 by Raymond Toy at 2025-11-06T07:20:10-08:00 Fix #437: Use realpath to find the executable - - - - - 2a9edb1f by Raymond Toy at 2025-11-06T07:20:11-08:00 Merge branch 'issue-437-find-self' into 'master' Fix #437: Use realpath to find the executable Closes #437 See merge request cmucl/cmucl!329 - - - - - c1904aaa by Raymond Toy at 2025-11-06T08:37:30-08:00 Fix #446: Use C compiler to get errno values and generate UNIX defpackage for errno - - - - - f6df759b by Raymond Toy at 2025-11-06T08:37:30-08:00 Merge branch 'issue-446-use-cc-to-get-errno' into 'master' Fix #446: Use C compiler to get errno values and generate UNIX defpackage for errno Closes #446 See merge request cmucl/cmucl!327 - - - - - b61d6e17 by Raymond Toy at 2025-11-06T17:28:00-08:00 Fix #452: Move bin/errno-foo.lisp to src/tools/ - - - - - 8508d11e by Raymond Toy at 2025-11-06T17:28:00-08:00 Merge branch 'issue-452-move-errno-ref-files' into 'master' Fix #452: Move bin/errno-foo.lisp to src/tools/ Closes #452 See merge request cmucl/cmucl!330 - - - - - 0789a95b by Raymond Toy at 2025-11-07T09:37:01-08:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - 346db6a8 by Raymond Toy at 2025-11-07T10:27:52-08:00 Return pathname objects instead of strings for temp files and dirs `with-temporary-file` and `with-temporary-directory` now produce a pathname object instead of a namestring. This change required updating a couple of tests in trac.lisp to convert the pathname to a namestring for use by `run-program`. - - - - - c9181e31 by Raymond Toy at 2025-11-07T10:37:51-08:00 Remove with-temporary-stream As mentioned in the review, we probably don't want this. Hence, remove it. - - - - - ef79c4ec by Raymond Toy at 2025-11-07T10:38:26-08:00 Convert clear-output-1 test to use with-temporary-file - - - - - cc969535 by Raymond Toy at 2025-11-07T10:53:07-08:00 Really remove WITH-TEMPORARY-STREAM Forgot to remove `with-temporary-stream` from exports.lisp an pprint.lisp. Remove the test from trac.lisp and use the `with-temporary-file` version instead. - - - - - ec60199f by Raymond Toy at 2025-11-09T11:30:40-08:00 Address #453: Save analyzer logs even if analyzer fails - - - - - 23ef5ca7 by Raymond Toy at 2025-11-09T11:30:40-08:00 Merge branch 'issue-453-save-analyzer-results' into 'master' Address #453: Save analyzer logs even if analyzer fails See merge request cmucl/cmucl!331 - - - - - 2072ca19 by Raymond Toy at 2025-11-10T05:07:47-08:00 Fix #453: Use correct flags when running the analyzer - - - - - 671d8973 by Raymond Toy at 2025-11-10T05:07:47-08:00 Merge branch 'issue-453-update-make-options-for-analyzer' into 'master' Fix #453: Use correct flags when running the analyzer Closes #453 See merge request cmucl/cmucl!332 - - - - - 32f4adb8 by Raymond Toy at 2025-11-10T09:32:05-08:00 Allow specifying a directory for the temp file or directory Add a new keyword arg :directory that specifies a directory where the temporary file or directory is. If not provided an OS-dependent directory is used. This applies to both `with-temporary-file` and `with-temporary-directory`. - - - - - 14902acd by Raymond Toy at 2025-11-10T10:09:12-08:00 Implement "rm -r" in Lisp Instead of using "rm -rf" to delete the temporary directory produced by `with-temporary-directory`, do the deletion in lisp so we don't have to fork/exec. The new function `recursively-delete-directory` recursively deletes a directory and all its contents. - - - - - fef970d5 by Raymond Toy at 2025-11-10T10:14:36-08:00 Remove nil'ed out test code. The original clear-output-1 test has been replaced with a version that uses with-temporary-file. - - - - - def9886b by Raymond Toy at 2025-11-10T11:25:06-08:00 Minor tweak to with-temporary-directory Call `recursive-delete-directory` with the temp directory pathname object instead of the namestring. Update pot file for new docstrings. - - - - - 78dc0983 by Raymond Toy at 2025-11-10T16:37:11-08:00 Remove old nil'ed out tests Really remove these old tests that were updated to use with-temporary-file to get a temp file for testing. - - - - - 71b5e795 by Raymond Toy at 2025-11-11T18:37:08-08:00 Let os_temporary_directory append a slash if needed. Update ext::get-os-temp-path so that it doesn't append a slash since os_temporary_directory does. Update pot file for new docstring too. - - - - - a96bdc2e by Raymond Toy at 2025-11-13T07:24:54-08:00 Apply 3 suggestion(s) to 3 file(s) Co-authored-by: Carl Shapiro <cshapiro(a)panix.com> - - - - - 19dec394 by Raymond Toy at 2025-11-13T07:25:30-08:00 Remove old function recursive-delete-directory This was replaced by `delete-directory`. - - - - - 196dd6cf by Raymond Toy at 2025-11-13T08:08:42-08:00 Fixed typo and remove extra closing brace - - - - - f544c481 by Raymond Toy at 2025-11-13T08:09:02-08:00 Update these files to match Linux These OSes use the same method as used on Linux to get the temp directory so update them to match what Linux is doing now. - - - - - 2ef1bd43 by Raymond Toy at 2025-11-13T08:39:23-08:00 Update pot file for changed docstring - - - - - aca11a4b by Raymond Toy at 2025-11-13T10:56:53-08:00 Fix #373: Add macros to handle temporary files, streams, and directories - - - - - f5484369 by Raymond Toy at 2025-11-13T10:56:53-08:00 Merge branch 'issue-373-handle-temp-files' into 'master' Fix #373: Add macros to handle temporary files, streams, and directories Closes #373 and #375 See merge request cmucl/cmucl!269 - - - - - 9feac3a0 by Raymond Toy at 2025-11-13T12:07:18-08:00 Merge branch 'issue-373-handle-temp-files' into issue-408-get-user-name-and-homedir - - - - - df529110 by Raymond Toy at 2025-11-13T12:07:32-08:00 Merge branch 'master' into issue-408-get-user-name-and-homedir - - - - - 34 changed files: - .gitignore - .gitlab-ci.yml - bin/build-world.sh - − bin/create-def-unix-error.awk - bin/create-errno.sh - − bin/errno-darwin.lisp - − bin/errno-default.lisp - − bin/errno-linux.lisp - − bin/errno-solaris.lisp - bin/run-ansi-tests.sh - src/code/exports.lisp - src/code/extensions.lisp - src/code/pprint.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - src/lisp/Config.x86_linux - src/lisp/Darwin-os.c - src/lisp/FreeBSD-os.c - src/lisp/Linux-os.c - src/lisp/NetBSD-os.c - src/lisp/OpenBSD-os.c - src/lisp/lisp.c - src/lisp/os-common.c - src/lisp/solaris-os.c - + src/tools/errno-darwin.lisp - + src/tools/errno-default.lisp - + src/tools/errno-linux.lisp - + src/tools/errno-solaris.lisp - bin/errno-template.lisp → src/tools/errno-template.lisp - + src/tools/unix-pkg-template.lisp - src/tools/worldcom.lisp - src/tools/worldload.lisp - tests/fd-streams.lisp - tests/trac.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95c50a3684f31eb4b18bba… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95c50a3684f31eb4b18bba… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #373: Add macros to handle temporary files, streams, and directories
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: aca11a4b by Raymond Toy at 2025-11-13T10:56:53-08:00 Fix #373: Add macros to handle temporary files, streams, and directories - - - - - f5484369 by Raymond Toy at 2025-11-13T10:56:53-08:00 Merge branch 'issue-373-handle-temp-files' into 'master' Fix #373: Add macros to handle temporary files, streams, and directories Closes #373 and #375 See merge request cmucl/cmucl!269 - - - - - 13 changed files: - src/code/exports.lisp - src/code/extensions.lisp - src/code/pprint.lisp - src/i18n/locale/cmucl.pot - src/lisp/Darwin-os.c - src/lisp/FreeBSD-os.c - src/lisp/Linux-os.c - src/lisp/NetBSD-os.c - src/lisp/OpenBSD-os.c - src/lisp/os-common.c - src/lisp/solaris-os.c - tests/fd-streams.lisp - tests/trac.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1211,7 +1211,9 @@ "*TRUST-DYNAMIC-EXTENT-DECLARATIONS*" - "INVALID-FASL") + "INVALID-FASL" + "WITH-TEMPORARY-DIRECTORY" + "WITH-TEMPORARY-FILE") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/extensions.lisp ===================================== @@ -612,3 +612,108 @@ "Return an EQ hash of X. The value of this hash for any given object can (of course) change at arbitary times." `(lisp::pointer-hash ,x)) + + +(defun get-os-temp-path () + "Get a path to an appropriate temporary location from the OS. A string + is returned to that path. The path ends with a \"/\" character." + (let ((path (alien:alien-funcall + (alien:extern-alien "os_temporary_directory" + (function (alien:* c-call:char)))))) + (when (alien:null-alien path) + (error "Unable to find path to temporary directory")) + + (unwind-protect + (unix::%file->name (cast path c-call:c-string)) + (unless (alien:null-alien path) + (alien:free-alien path))))) + +;; Create a template suitable for mkstemp and mkdtemp. DIRECTORY is +;; the directory for the template. If DIRECTORY is NIL, an +;; OS-dependent location is used. PREFIX is string that is the prefix +;; for the filename for the template. In all cases, we append exactly +;; 6 X's to create the finale template. +(defun create-template (directory prefix) + (concatenate 'string + (or directory + (get-os-temp-path)) + "/" + prefix + "XXXXXX")) + +;;; WITH-TEMPORARY-FILE -- Public +(defmacro with-temporary-file ((filename &key directory (prefix "cmucl-temp-file-")) + &parse-body (forms decls)) + _N"Creates a temporary file with a name bound to Filename which a + namestring. If Directory is not provided, the temporary file is created + in a OS-dependent location. The Prefix is a prefix to the file name + to be created. If not provided a default prefix is used. + On completion, the file is automatically removed." + (let ((fd (gensym "FD-")) + (file-template (gensym "TEMP-PATH-")) + (unique-filename (gensym "UNIQUE-FILENAME-"))) + `(let ((,file-template (create-template ,directory ,prefix)) + ,unique-filename) + (unwind-protect + (let (,fd) + (multiple-value-setq (,fd ,unique-filename) + (unix::unix-mkstemp ,file-template)) + (unless ,fd + (error "Unable to create temporary file with template ~S: ~A~%" + ,file-template + (unix:get-unix-error-msg ,unique-filename))) + (unix:unix-close ,fd) + (setf ,filename (pathname ,unique-filename)) + (locally ,@decls + ,@forms)) + ;; We're done so delete the temp file, if one was created. + (when (pathnamep ,filename) + (delete-file ,filename)))))) + +(defun delete-directory (dirname &key recursive) + _N"Delete the directory Dirname. If the Recursive is non-NIL, + recursively delete the directory Dirname including all files and + subdirectories. Dirname must be a pathname to a directory. Any NAME + or TYPE components in Dirname are ignored." + (declare (type pathname dirname)) + (when recusive + ;; Find all the files or directories in DIRNAME. + (dolist (path (directory (merge-pathnames "*.*" dirname))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (delete-directory path :recursive t) + (delete-file path)))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dirname)) + (values)) + + +;;; WITH-TEMPORARY-DIRECTORY -- Public +(defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) + &parse-body (forms decls)) + _N"Return a namestring to a temporary directory. If Directory is not + provided, the directory is created in an OS-dependent location. The + Prefix is a string that is used as a prefix for the name of the + temporary directory. If Prefix is not given, a default prefix is + used. The directory and all its contents are automatically removed + afterward." + (let ((err (gensym "ERR-")) + (dir-template (gensym "DIR-TEMPLATE-"))) + `(let ((,dir-template (create-template ,directory ,prefix)) + ,dirname ,err) + (unwind-protect + (progn + (multiple-value-setq (,dirname ,err) + (unix::unix-mkdtemp ,dir-template)) + (unless ,dirname + (error "Unable to create temporary directory at ~S: ~A" + ,dir-template + (unix:get-unix-error-msg ,err))) + (setf ,dirname (pathname (concatenate 'string ,dirname "/"))) + (locally ,@decls + ,@forms)) + ;; If a temp directory was created, remove it and all its + ;; contents. Is there a better way? + (when ,dirname + (delete-directory ,dirname :recursive t)))))) ===================================== src/code/pprint.lisp ===================================== @@ -2092,7 +2092,8 @@ When annotations are present, invoke them at the right positions." (c:deftransform pprint-defun) (c:defoptimizer pprint-defun) (ext:with-float-traps-masked pprint-with-like) - (ext:with-float-traps-enabled pprint-with-like))) + (ext:with-float-traps-enabled pprint-with-like) + (ext::with-temporary-directory pprint-with-like))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5992,6 +5992,39 @@ msgid "" " course) change at arbitary times." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Get a path to an appropriate temporary location from the OS. A string\n" +" is returned to that path. The path ends with a \"/\" character." +msgstr "" + +#: src/code/extensions.lisp +msgid "" +"Creates a temporary file with a name bound to Filename which a\n" +" namestring. If Directory is not provided, the temporary file is created\n" +" in a OS-dependent location. The Prefix is a prefix to the file name\n" +" to be created. If not provided a default prefix is used.\n" +" On completion, the file is automatically removed." +msgstr "" + +#: src/code/extensions.lisp +msgid "" +"Delete the directory Dirname. If the Recursive is non-NIL,\n" +" recursively delete the directory Dirname including all files and\n" +" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" +" or TYPE components in Dirname are ignored." +msgstr "" + +#: src/code/extensions.lisp +msgid "" +"Return a namestring to a temporary directory. If Directory is not\n" +" provided, the directory is created in an OS-dependent location. The\n" +" Prefix is a string that is used as a prefix for the name of the\n" +" temporary directory. If Prefix is not given, a default prefix is\n" +" used. The directory and all its contents are automatically removed\n" +" afterward." +msgstr "" + #: src/code/commandline.lisp msgid "A list of all the command line arguments after --" msgstr "" ===================================== src/lisp/Darwin-os.c ===================================== @@ -23,6 +23,7 @@ #include <dlfcn.h> #include <string.h> #include <assert.h> +#include <unistd.h> #include "os.h" #include "arch.h" @@ -571,3 +572,30 @@ os_support_sse2() return TRUE; } #endif + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. If NULL is + * returned, such a location could not be found or some other error + * happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * macosx has a secure per-user temporary directory. + * Don't cache the result as this is only called once. + */ + size_t len; + char path[PATH_MAX]; + + len = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); + if (len == 0 || len > PATH_MAX || (len == PATH_MAX && path[len - 1] != '/')) { + strlcpy(path, "/tmp/"); + } else if (path[len - 1] != '/') { + strcat(path, "/"); + } + return strdup(path); +} ===================================== src/lisp/FreeBSD-os.c ===================================== @@ -362,3 +362,37 @@ os_support_sse2() return TRUE; } #endif + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ + char *tmp; + size_t len; + char *result; + + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); + } + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; +} ===================================== src/lisp/Linux-os.c ===================================== @@ -628,3 +628,37 @@ os_support_sse2(void) return TRUE; } #endif + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ + char *tmp; + size_t len; + char *result; + + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); + } + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; +} ===================================== src/lisp/NetBSD-os.c ===================================== @@ -427,3 +427,37 @@ os_support_sse2() return FALSE; } #endif + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ + char *tmp; + size_t len; + char *result; + + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); + } + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; +} ===================================== src/lisp/OpenBSD-os.c ===================================== @@ -190,3 +190,37 @@ os_install_interrupt_handlers(void) interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ + char *tmp; + size_t len; + char *result; + + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); + } + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; +} ===================================== src/lisp/os-common.c ===================================== @@ -26,6 +26,9 @@ #include <sys/utsname.h> #include <unistd.h> #include <time.h> +#if defined(DARWIN) +#include <limits.h> +#endif #include "os.h" #include "internals.h" @@ -940,7 +943,6 @@ os_get_user_homedir(const char* name, int *status) *status = -1; return NULL; } - /* * Return a new string (or NULL) for the current working directory. ===================================== src/lisp/solaris-os.c ===================================== @@ -643,3 +643,37 @@ os_support_sse2() return TRUE; } #endif + +/* + * Return a new string containing the path to an OS-dependent location + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. + * + * Caller must call free() on the string returned. + */ +char * +os_temporary_directory(void) +{ + /* + * If the TMP envvar is set, use that as the temporary directory. + * Otherwise, just assume "/tmp" will work. + */ + char *tmp; + size_t len; + char *result; + + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); + } + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; +} ===================================== tests/fd-streams.lisp ===================================== @@ -18,22 +18,23 @@ (ensure-directories-exist *test-path* :verbose t)) (define-test clear-output-1 - (:tag :trac) + (:tag :trac) (assert-eql 0 - (unwind-protect - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - ;; Write a character to the (fully buffered) output - ;; stream. Clear the output and close the file. Nothing - ;; should have been written to the file. - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (delete-file *test-file*)))) + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + ;; Write a character to the (fully buffered) output + ;; stream. Clear the output and close the file. Nothing + ;; should have been written to the file. + (write-char #\a s) + (clear-output s) + (close s) + (setf s (open test-file)) + (prog1 + (file-length s) + (close s)))))) (define-test file-position.1 (:tag :issues) ===================================== tests/trac.lisp ===================================== @@ -104,42 +104,39 @@ (pathname-directory "/tmp/Foo/BAR/" :case :common))) (define-test trac.36 - (:tag :trac) - (let ((path "/tmp/trac.36.bom.txt")) - (flet ((bug (&optional (format :utf16)) + (:tag :trac) + (flet ((bug (&optional (format :utf16)) + (ext:with-temporary-file (path) (with-open-file (s path :direction :output - :if-exists :supersede :external-format format) (format s "Hello~%")) (with-open-file (s path :direction :input :external-format format) (let ((ch (read-char s))) - (values ch (file-position s)))))) - (assert-equal (values #\H 4) - (bug :utf16)) - (assert-equal (values #\H 8) - (bug :utf32))))) + (values ch (file-position s))))))) + (assert-equal (values #\H 4) + (bug :utf16)) + (assert-equal (values #\H 8) + (bug :utf32)))) (define-test trac.43 - (:tag :trac) + (:tag :trac) (assert-true - (let ((path "/tmp/trac.43.txt")) - (unwind-protect - (progn - (with-open-file (ostream path :direction :output - :external-format :utf-8) - (dotimes (i 1000) - (write-char (code-char #x1234) ostream))) - - (with-open-file (stream path :direction :input - :external-format :utf-8) - (let ((p0 (file-position stream)) - (ch (read-char stream))) - (unread-char ch stream) - (let ((p0* (file-position stream))) - (eql p0* p0))))))))) + (ext:with-temporary-file (path) + (with-open-file (ostream path :direction :output + :external-format :utf-8) + (dotimes (i 1000) + (write-char (code-char #x1234) ostream))) + + (with-open-file (stream path :direction :input + :external-format :utf-8) + (let ((p0 (file-position stream)) + (ch (read-char stream))) + (unread-char ch stream) + (let ((p0* (file-position stream))) + (eql p0* p0))))))) (define-test trac.50 (:tag :trac) @@ -147,23 +144,21 @@ (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) (define-test trac.58 - (:tag :trac) + (:tag :trac) (assert-false - (let ((path "/tmp/trac.58.txt") - failures) - (unwind-protect - (progn - (with-open-file (s path :direction :output :external-format :utf-16) - (dotimes (i 300) - (write-char (code-char i) s))) - - (with-open-file (s path :direction :input :external-format :utf-16) - (dotimes (i 300) - (let ((ch (read-char s nil nil))) - (unless (= i (char-code ch)) - (push (list i ch (char-code ch)) failures))))) - failures) - (delete-file path))))) + (let (failures) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :external-format :utf-16) + (dotimes (i 300) + (write-char (code-char i) s))) + + (with-open-file (s path :direction :input :external-format :utf-16) + (dotimes (i 300) + (let ((ch (read-char s nil nil))) + (unless (= i (char-code ch)) + (push (list i ch (char-code ch)) failures))))) + failures)) + failures)) (define-test trac.63 (:tag :trac) @@ -254,19 +249,16 @@ ;; Create a temp file full of latin1 characters. (assert-equal '(0 1) - (let ((path "/tmp/trac.70.txt")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (dotimes (k 255) - (write-char (code-char k) s))) - (with-open-file (s path :direction :input :external-format :latin1) - (list (file-position s) - (progn - (read-char s) - (file-position s))))) - (delete-file path))))) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede + :external-format :latin1) + (dotimes (k 255) + (write-char (code-char k) s))) + (with-open-file (s path :direction :input :external-format :latin1) + (list (file-position s) + (progn + (read-char s) + (file-position s))))))) (define-test trac.80 (:tag :trac) @@ -278,49 +270,43 @@ (:tag :trac) ;; Test that run-program accepts :element-type and produces the ;; correct output. - (let ((path "/tmp/trac.87.output") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede :external-format :latin1) - (write-string string s)) - (let* ((expected (stream:string-to-octets string :external-format :latin1)) - (octets (make-array (length expected) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :output :stream - :element-type '(unsigned-byte 8)))) - (read-sequence octets (ext:process-output proc)) - (assert-equalp - expected - octets))) - (delete-file path)))) + (write-string string s)) + (let* ((expected (stream:string-to-octets string :external-format :latin1)) + (octets (make-array (length expected) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list (namestring path)) + :output :stream + :element-type '(unsigned-byte 8)))) + (read-sequence octets (ext:process-output proc)) + (assert-equalp + expected + octets))))) (define-test trac.87.input (:tag :trac) ;; Test that run-program accepts :element-type and produces the ;; correct input (and output). - (let ((path "/tmp/trac.87.input") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede + (let ((string "Hello")) + (ext:with-temporary-file (path) + (with-open-file (s path :direction :output :if-exists :supersede :external-format :latin1) - (write-string string s)) - (let ((octets (stream:string-to-octets string :external-format :latin1)) - (output (make-array (length string) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :input :stream - :output :stream - :element-type '(unsigned-byte 8)))) - (write-sequence octets (ext:process-input proc)) - (read-sequence output (ext:process-output proc)) - (assert-equalp - octets - output))) - (delete-file path)))) + (write-string string s)) + (let ((octets (stream:string-to-octets string :external-format :latin1)) + (output (make-array (length string) + :element-type '(unsigned-byte 8))) + (proc (ext:run-program "/bin/cat" (list (namestring path)) + :input :stream + :output :stream + :element-type '(unsigned-byte 8)))) + (write-sequence octets (ext:process-input proc)) + (read-sequence output (ext:process-output proc)) + (assert-equalp + octets + output))))) (define-test trac.92 (:tag :trac) @@ -384,18 +370,15 @@ (:tag :trac) (assert-eql 0 - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - (unwind-protect - (progn - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) + (ext:with-temporary-file (test-file) + (let ((s (open test-file + :direction :output + :if-exists :supersede))) + (write-char #\a s) + (clear-output s) (close s) - (delete-file *test-file*))))) + (setf s (open test-file)) + (file-length s))))) (defun read-string-fn (str) (handler-case View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/671d8973d1453ffc4a652f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/671d8973d1453ffc4a652f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] Address review comments
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: 95c50a36 by Raymond Toy at 2025-11-13T08:49:14-08:00 Address review comments Rename get_homedir_from_name to get_homedir_by_user_name and get_homedir_from_uid by get_homedir_by_uid. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -911,7 +911,7 @@ os_software_version(void) } static char * -get_homedir_from_name(const char* name, int *status) +get_homedir_by_user_name(const char* name, int *status) { int buflen; char *buf = NULL; @@ -981,7 +981,7 @@ get_homedir_from_name(const char* name, int *status) * The caller must free the memory returned. */ static char * -get_homedir_from_uid(uid_t uid, int *status) +get_homedir_by_uid(uid_t uid, int *status) { char buffer[1024]; char *buf; @@ -1021,10 +1021,10 @@ char * os_get_user_homedir(const char* name, int *status) { if (strlen(name) == 0) { - return get_homedir_from_uid(getuid(), status); + return get_homedir_by_uid(getuid(), status); } - return get_homedir_from_name(name, status); + return get_homedir_by_user_name(name, status); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95c50a3684f31eb4b18bba6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95c50a3684f31eb4b18bba6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Update pot file for changed docstring
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 2ef1bd43 by Raymond Toy at 2025-11-13T08:39:23-08:00 Update pot file for changed docstring - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6007,13 +6007,6 @@ msgid "" " On completion, the file is automatically removed." msgstr "" -#: src/code/extensions.lisp -msgid "" -"Recursively delete the directory DIR. All files and subdirectories of\n" -" DIR are removed. DIR must be a pathname to a directory. Any NAME\n" -" or TYPE components in DIR are ignored." -msgstr "" - #: src/code/extensions.lisp msgid "" "Delete the directory Dirname. If the Recursive is non-NIL,\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ef1bd4340ae2a3dd08e734… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ef1bd4340ae2a3dd08e734… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] Apply 3 suggestion(s) to 1 file(s)
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: 53c2da21 by Raymond Toy at 2025-11-13T08:38:42-08:00 Apply 3 suggestion(s) to 1 file(s) Co-authored-by: Carl Shapiro <cshapiro(a)panix.com> - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -737,7 +737,7 @@ os_lstat(const char* path, uint64_t *dev, uint64_t *ino, unsigned int *mode, uin * if we needed to retry getpwuid with a larger buffer. The remaining * parameters are the same as for getpwuid. */ -int +static int os_getpwuid(uid_t uid, struct passwd *pwd, char **buffer, size_t buflen, struct passwd **result) { int status; @@ -789,7 +789,7 @@ os_get_user_name(uid_t uid, int *status) buf = buffer; - *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); + *status = os_getpwuid(uid, &pwd, &buf, sizeof(buffer), &result); if (*status != 0 || result == NULL || result->pw_name == NULL) { name = NULL; @@ -992,7 +992,7 @@ get_homedir_from_uid(uid_t uid, int *status) buf = buffer; dir = NULL; - *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); + *status = os_getpwuid(uid, &pwd, &buf, sizeof(buffer), &result); if (*status == 0 && result != NULL && result->pw_dir != NULL) { dir = strdup(result->pw_dir); View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/53c2da2131e00343171b678… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/53c2da2131e00343171b678… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Fixed typo and remove extra closing brace
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 196dd6cf by Raymond Toy at 2025-11-13T08:08:42-08:00 Fixed typo and remove extra closing brace - - - - - f544c481 by Raymond Toy at 2025-11-13T08:09:02-08:00 Update these files to match Linux These OSes use the same method as used on Linux to get the temp directory so update them to match what Linux is doing now. - - - - - 5 changed files: - src/lisp/FreeBSD-os.c - src/lisp/Linux-os.c - src/lisp/NetBSD-os.c - src/lisp/OpenBSD-os.c - src/lisp/solaris-os.c Changes: ===================================== src/lisp/FreeBSD-os.c ===================================== @@ -365,9 +365,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -378,11 +378,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/Linux-os.c ===================================== @@ -631,9 +631,9 @@ os_support_sse2(void) /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -662,4 +662,3 @@ os_temporary_directory(void) } return result; } -} ===================================== src/lisp/NetBSD-os.c ===================================== @@ -430,9 +430,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -443,11 +443,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/OpenBSD-os.c ===================================== @@ -193,9 +193,9 @@ os_install_interrupt_handlers(void) /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -206,11 +206,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/solaris-os.c ===================================== @@ -646,9 +646,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -659,11 +659,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/19dec394ac637e3090500a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/19dec394ac637e3090500a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Remove old function recursive-delete-directory
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 19dec394 by Raymond Toy at 2025-11-13T07:25:30-08:00 Remove old function recursive-delete-directory This was replaced by `delete-directory`. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -670,23 +670,6 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) -#+nil -(defun recursive-delete-directory (dir) - _N"Recursively delete the directory DIR. All files and subdirectories of - DIR are removed. DIR must be a pathname to a directory. Any NAME - or TYPE components in DIR are ignored." - (declare (type pathname dir)) - ;; Find all the files or directories in DIR. - (dolist (path (directory (merge-pathnames "*.*" dir))) - ;; If the path is a directory, recursively delete the directory. - ;; Otherwise delete the file. We do not follow any symlinks. - (if (eq (unix:unix-file-kind (namestring path)) :directory) - (recursive-delete-directory path) - (delete-file path))) - ;; Finally delete the directory. - (unix:unix-rmdir (namestring dir)) - (values)) - (defun delete-directory (dirname &key recursive) _N"Delete the directory Dirname. If the Recursive is non-NIL, recursively delete the directory Dirname including all files and View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/19dec394ac637e3090500a6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/19dec394ac637e3090500a6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Apply 3 suggestion(s) to 3 file(s)
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: a96bdc2e by Raymond Toy at 2025-11-13T07:24:54-08:00 Apply 3 suggestion(s) to 3 file(s) Co-authored-by: Carl Shapiro <cshapiro(a)panix.com> - - - - - 3 changed files: - src/code/extensions.lisp - src/lisp/Darwin-os.c - src/lisp/Linux-os.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -702,7 +702,7 @@ (delete-directory path :recursive t) (delete-file path)))) ;; Finally delete the directory. - (unix:unix-rmdir (namestring dir)) + (unix:unix-rmdir (namestring dirname)) (values)) ===================================== src/lisp/Darwin-os.c ===================================== @@ -588,27 +588,14 @@ os_temporary_directory(void) * macosx has a secure per-user temporary directory. * Don't cache the result as this is only called once. */ - int len; - char *result; + size_t len; char path[PATH_MAX]; - int path_size = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); - if (path_size == 0 || path_size > PATH_MAX) { - strlcpy(path, "/tmp", sizeof(path)); - } - - /* Append a slash if needed */ - len = strlen(path); - result = malloc(len + 1); - - /* If malloc fails, just return NULL. */ - if (result) { - strcpy(result, path); - - if (path[len] != '/') { - strcat(result, "/"); - } + len = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); + if (len == 0 || len > PATH_MAX || (len == PATH_MAX && path[len - 1] != '/')) { + strlcpy(path, "/tmp/"); + } else if (path[len - 1] != '/') { + strcat(path, "/"); } - - return result; + return strdup(path); } ===================================== src/lisp/Linux-os.c ===================================== @@ -644,26 +644,22 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; char *result; - int len; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - /* Append a slash if needed */ - len = strlen(tmp_path); - result = malloc(len + 1); - - /* If malloc fails, just return NULL. */ + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); if (result) { - strcpy(result, tmp_path); - - if (tmp_path[len] != '/') { - strcat(result, "/"); - } + sprintf(result, "%s/", tmp); } - return result; } +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a96bdc2e50c473356862a8d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a96bdc2e50c473356862a8d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Let os_temporary_directory append a slash if needed.
by Raymond Toy (＠rtoy) 12 Nov '25

12 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 71b5e795 by Raymond Toy at 2025-11-11T18:37:08-08:00 Let os_temporary_directory append a slash if needed. Update ext::get-os-temp-path so that it doesn't append a slash since os_temporary_directory does. Update pot file for new docstring too. - - - - - 4 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - src/lisp/Darwin-os.c - src/lisp/Linux-os.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -624,11 +624,7 @@ (error "Unable to find path to temporary directory")) (unwind-protect - (let* ((string (unix::%file->name (cast path c-call:c-string))) - (len (length string))) - (if (char= #\/ (aref string (1- len))) - string - (concatenate 'string string "/"))) + (unix::%file->name (cast path c-call:c-string)) (unless (alien:null-alien path) (alien:free-alien path))))) @@ -674,6 +670,7 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +#+nil (defun recursive-delete-directory (dir) _N"Recursively delete the directory DIR. All files and subdirectories of DIR are removed. DIR must be a pathname to a directory. Any NAME @@ -690,6 +687,25 @@ (unix:unix-rmdir (namestring dir)) (values)) +(defun delete-directory (dirname &key recursive) + _N"Delete the directory Dirname. If the Recursive is non-NIL, + recursively delete the directory Dirname including all files and + subdirectories. Dirname must be a pathname to a directory. Any NAME + or TYPE components in Dirname are ignored." + (declare (type pathname dirname)) + (when recusive + ;; Find all the files or directories in DIRNAME. + (dolist (path (directory (merge-pathnames "*.*" dirname))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (delete-directory path :recursive t) + (delete-file path)))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + + ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) @@ -717,4 +733,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (recursive-delete-directory ,dirname)))))) + (delete-directory ,dirname :recursive t)))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6014,6 +6014,14 @@ msgid "" " or TYPE components in DIR are ignored." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Delete the directory Dirname. If the Recursive is non-NIL,\n" +" recursively delete the directory Dirname including all files and\n" +" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" +" or TYPE components in Dirname are ignored." +msgstr "" + #: src/code/extensions.lisp msgid "" "Return a namestring to a temporary directory. If Directory is not\n" ===================================== src/lisp/Darwin-os.c ===================================== @@ -588,6 +588,8 @@ os_temporary_directory(void) * macosx has a secure per-user temporary directory. * Don't cache the result as this is only called once. */ + int len; + char *result; char path[PATH_MAX]; int path_size = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); @@ -595,5 +597,18 @@ os_temporary_directory(void) strlcpy(path, "/tmp", sizeof(path)); } - return strdup(path); + /* Append a slash if needed */ + len = strlen(path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, path); + + if (path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } ===================================== src/lisp/Linux-os.c ===================================== @@ -645,10 +645,25 @@ os_temporary_directory(void) * Otherwise, just assume "/tmp" will work. */ char *tmp_path = getenv("TMP"); + char *result; + int len; if (tmp_path == NULL) { tmp_path = "/tmp"; } - return strdup(tmp_path); + /* Append a slash if needed */ + len = strlen(tmp_path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, tmp_path); + + if (tmp_path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Minor tweak to with-temporary-directory
by Raymond Toy (＠rtoy) 11 Nov '25

11 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: def9886b by Raymond Toy at 2025-11-10T11:25:06-08:00 Minor tweak to with-temporary-directory Call `recursive-delete-directory` with the temp directory pathname object instead of the namestring. Update pot file for new docstrings. - - - - - 78dc0983 by Raymond Toy at 2025-11-10T16:37:11-08:00 Remove old nil'ed out tests Really remove these old tests that were updated to use with-temporary-file to get a temp file for testing. - - - - - 3 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - tests/trac.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -717,4 +717,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (recursive-delete-directory (namestring ,dirname))))))) + (recursive-delete-directory ,dirname)))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6007,6 +6007,13 @@ msgid "" " On completion, the file is automatically removed." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Recursively delete the directory DIR. All files and subdirectories of\n" +" DIR are removed. DIR must be a pathname to a directory. Any NAME\n" +" or TYPE components in DIR are ignored." +msgstr "" + #: src/code/extensions.lisp msgid "" "Return a namestring to a temporary directory. If Directory is not\n" ===================================== tests/trac.lisp ===================================== @@ -103,78 +103,24 @@ (assert-equal '(:absolute "TMP" "Foo" "bar") (pathname-directory "/tmp/Foo/BAR/" :case :common))) -#+nil (define-test trac.36 - (:tag :trac) - (let ((path "/tmp/trac.36.bom.txt")) - (flet ((bug (&optional (format :utf16)) + (:tag :trac) + (flet ((bug (&optional (format :utf16)) + (ext:with-temporary-file (path) (with-open-file (s path :direction :output - :if-exists :supersede :external-format format) (format s "Hello~%")) (with-open-file (s path :direction :input :external-format format) (let ((ch (read-char s))) - (values ch (file-position s)))))) - (assert-equal (values #\H 4) - (bug :utf16)) - (assert-equal (values #\H 8) - (bug :utf32))))) - -#+nil -(define-test trac.36 - (:tag :trac) - (flet ((bug (&optional (format :utf16)) - (ext:with-temporary-stream (s :direction :io :external-format format) - (format s "Hello~%") - (file-position s 0) - (let ((ch (read-char s))) - (values ch (file-position s)))))) + (values ch (file-position s))))))) (assert-equal (values #\H 4) (bug :utf16)) (assert-equal (values #\H 8) (bug :utf32)))) -(define-test trac.36 - (:tag :trac) - (flet ((bug (&optional (format :utf16)) - (ext:with-temporary-file (path) - (with-open-file (s path - :direction :output - :external-format format) - (format s "Hello~%")) - (with-open-file (s path - :direction :input - :external-format format) - (let ((ch (read-char s))) - (values ch (file-position s))))))) - (assert-equal (values #\H 4) - (bug :utf16)) - (assert-equal (values #\H 8) - (bug :utf32))))) - -#+nil -(define-test trac.43 - (:tag :trac) - (assert-true - (let ((path "/tmp/trac.43.txt")) - (unwind-protect - (progn - (with-open-file (ostream path :direction :output - :external-format :utf-8) - (dotimes (i 1000) - (write-char (code-char #x1234) ostream))) - - (with-open-file (stream path :direction :input - :external-format :utf-8) - (let ((p0 (file-position stream)) - (ch (read-char stream))) - (unread-char ch stream) - (let ((p0* (file-position stream))) - (eql p0* p0))))))))) - (define-test trac.43 (:tag :trac) (assert-true @@ -197,26 +143,6 @@ (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) -#+nil -(define-test trac.58 - (:tag :trac) - (assert-false - (let ((path "/tmp/trac.58.txt") - failures) - (unwind-protect - (progn - (with-open-file (s path :direction :output :external-format :utf-16) - (dotimes (i 300) - (write-char (code-char i) s))) - - (with-open-file (s path :direction :input :external-format :utf-16) - (dotimes (i 300) - (let ((ch (read-char s nil nil))) - (unless (= i (char-code ch)) - (push (list i ch (char-code ch)) failures))))) - failures) - (delete-file path))))) - (define-test trac.58 (:tag :trac) (assert-false @@ -318,26 +244,6 @@ (assert-equal "A1234AAAA" (subseq (trac.70-test *trac.70* "a12345") 0 9))) -#+nil -(define-test trac.79 - (:tag :trac) - ;; Create a temp file full of latin1 characters. - (assert-equal - '(0 1) - (let ((path "/tmp/trac.70.txt")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (dotimes (k 255) - (write-char (code-char k) s))) - (with-open-file (s path :direction :input :external-format :latin1) - (list (file-position s) - (progn - (read-char s) - (file-position s))))) - (delete-file path))))) - (define-test trac.79 (:tag :trac) ;; Create a temp file full of latin1 characters. @@ -360,30 +266,6 @@ (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) -#+nil -(define-test trac.87.output - (:tag :trac) - ;; Test that run-program accepts :element-type and produces the - ;; correct output. - (let ((path "/tmp/trac.87.output") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (write-string string s)) - (let* ((expected (stream:string-to-octets string :external-format :latin1)) - (octets (make-array (length expected) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :output :stream - :element-type '(unsigned-byte 8)))) - (read-sequence octets (ext:process-output proc)) - (assert-equalp - expected - octets))) - (delete-file path)))) - (define-test trac.87.output (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -404,32 +286,6 @@ expected octets))))) -#+nil -(define-test trac.87.input - (:tag :trac) - ;; Test that run-program accepts :element-type and produces the - ;; correct input (and output). - (let ((path "/tmp/trac.87.input") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (write-string string s)) - (let ((octets (stream:string-to-octets string :external-format :latin1)) - (output (make-array (length string) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :input :stream - :output :stream - :element-type '(unsigned-byte 8)))) - (write-sequence octets (ext:process-input proc)) - (read-sequence output (ext:process-output proc)) - (assert-equalp - octets - output))) - (delete-file path)))) - (define-test trac.87.input (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -510,24 +366,6 @@ ;; Not quite what ticket 101 is about, but it came up in investigating ;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually ;; does. Previously, it did nothing. -#+nil -(define-test trac.101 - (:tag :trac) - (assert-eql - 0 - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - (unwind-protect - (progn - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (close s) - (delete-file *test-file*))))) - (define-test trac.101 (:tag :trac) (assert-eql View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fef970d55aac584f24ed2c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fef970d55aac584f24ed2c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Remove nil'ed out test code.
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: fef970d5 by Raymond Toy at 2025-11-10T10:14:36-08:00 Remove nil'ed out test code. The original clear-output-1 test has been replaced with a version that uses with-temporary-file. - - - - - 1 changed file: - tests/fd-streams.lisp Changes: ===================================== tests/fd-streams.lisp ===================================== @@ -17,25 +17,6 @@ (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) -#+nil -(define-test clear-output-1 - (:tag :trac) - (assert-eql - 0 - (unwind-protect - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - ;; Write a character to the (fully buffered) output - ;; stream. Clear the output and close the file. Nothing - ;; should have been written to the file. - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (delete-file *test-file*)))) - (define-test clear-output-1 (:tag :trac) (assert-eql View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fef970d55aac584f24ed2cc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fef970d55aac584f24ed2cc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Allow specifying a directory for the temp file or directory
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 32f4adb8 by Raymond Toy at 2025-11-10T09:32:05-08:00 Allow specifying a directory for the temp file or directory Add a new keyword arg :directory that specifies a directory where the temporary file or directory is. If not provided an OS-dependent directory is used. This applies to both `with-temporary-file` and `with-temporary-directory`. - - - - - 14902acd by Raymond Toy at 2025-11-10T10:09:12-08:00 Implement "rm -r" in Lisp Instead of using "rm -rf" to delete the temporary directory produced by `with-temporary-directory`, do the deletion in lisp so we don't have to fork/exec. The new function `recursively-delete-directory` recursively deletes a directory and all its contents. - - - - - 2 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/extensions.lisp ===================================== @@ -632,30 +632,31 @@ (unless (alien:null-alien path) (alien:free-alien path))))) -;; Create a template suitable for mkstemp and mkdtemp. PREFIX is -;; string (or NIL) provided by the macros and is used as is as the -;; template prefix. If PREFIX is NIL, the prefix is obtained by -;; appending DEFAULT-NAME to the OS-dependent temporary path. In all -;; cases, we append exactly 6 X's to create the finale template. -(defun create-template (prefix default-name) +;; Create a template suitable for mkstemp and mkdtemp. DIRECTORY is +;; the directory for the template. If DIRECTORY is NIL, an +;; OS-dependent location is used. PREFIX is string that is the prefix +;; for the filename for the template. In all cases, we append exactly +;; 6 X's to create the finale template. +(defun create-template (directory prefix) (concatenate 'string - (or prefix - (concatenate 'string - (get-os-temp-path) - default-name)) + (or directory + (get-os-temp-path)) + "/" + prefix "XXXXXX")) ;;; WITH-TEMPORARY-FILE -- Public -(defmacro with-temporary-file ((filename &key prefix) +(defmacro with-temporary-file ((filename &key directory (prefix "cmucl-temp-file-")) &parse-body (forms decls)) _N"Creates a temporary file with a name bound to Filename which a - namestring. If Prefix is not provided, the temporary file is created - in a OS-dependent location. Otherwise the prefix is used as a prefix - for the name. On completion, the file is automatically removed." + namestring. If Directory is not provided, the temporary file is created + in a OS-dependent location. The Prefix is a prefix to the file name + to be created. If not provided a default prefix is used. + On completion, the file is automatically removed." (let ((fd (gensym "FD-")) (file-template (gensym "TEMP-PATH-")) (unique-filename (gensym "UNIQUE-FILENAME-"))) - `(let ((,file-template (create-template ,prefix "cmucl-temp-file-")) + `(let ((,file-template (create-template ,directory ,prefix)) ,unique-filename) (unwind-protect (let (,fd) @@ -673,17 +674,34 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +(defun recursive-delete-directory (dir) + _N"Recursively delete the directory DIR. All files and subdirectories of + DIR are removed. DIR must be a pathname to a directory. Any NAME + or TYPE components in DIR are ignored." + (declare (type pathname dir)) + ;; Find all the files or directories in DIR. + (dolist (path (directory (merge-pathnames "*.*" dir))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (recursive-delete-directory path) + (delete-file path))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + ;;; WITH-TEMPORARY-DIRECTORY -- Public -(defmacro with-temporary-directory ((dirname &key prefix) +(defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) - _N"Return a namestring to a temporary directory. If Prefix is not - provided, the directory is created in an OS-dependent location. - Otherwise, the Prefix is a string that is used as a prefix for the - name of the temporary directory. The directory and all its contents - are automatically removed afterward." + _N"Return a namestring to a temporary directory. If Directory is not + provided, the directory is created in an OS-dependent location. The + Prefix is a string that is used as a prefix for the name of the + temporary directory. If Prefix is not given, a default prefix is + used. The directory and all its contents are automatically removed + afterward." (let ((err (gensym "ERR-")) (dir-template (gensym "DIR-TEMPLATE-"))) - `(let ((,dir-template (create-template ,prefix "cmucl-temp-dir-")) + `(let ((,dir-template (create-template ,directory ,prefix)) ,dirname ,err) (unwind-protect (progn @@ -699,4 +717,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (ext:run-program "/bin/rm" (list "-rf" (namestring ,dirname)))))))) + (recursive-delete-directory (namestring ,dirname))))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5998,25 +5998,23 @@ msgid "" " is returned to that path. The path ends with a \"/\" character." msgstr "" -#: src/code/extensions.lisp -msgid "Return a stream to a temporary file that is automatically created." -msgstr "" - #: src/code/extensions.lisp msgid "" "Creates a temporary file with a name bound to Filename which a\n" -" namestring. If Prefix is not provided, the temporary file is created\n" -" in a OS-dependent location. Otherwise the prefix is used as a prefix\n" -" for the name. On completion, the file is automatically removed." +" namestring. If Directory is not provided, the temporary file is created\n" +" in a OS-dependent location. The Prefix is a prefix to the file name\n" +" to be created. If not provided a default prefix is used.\n" +" On completion, the file is automatically removed." msgstr "" #: src/code/extensions.lisp msgid "" -"Return a namestring to a temporary directory. If Prefix is not\n" -" provided, the directory is created in an OS-dependent location.\n" -" Otherwise, the Prefix is a string that is used as a prefix for the\n" -" name of the temporary directory. The directory and all its contents\n" -" are automatically removed afterward." +"Return a namestring to a temporary directory. If Directory is not\n" +" provided, the directory is created in an OS-dependent location. The\n" +" Prefix is a string that is used as a prefix for the name of the\n" +" temporary directory. If Prefix is not given, a default prefix is\n" +" used. The directory and all its contents are automatically removed\n" +" afterward." msgstr "" #: src/code/commandline.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] Address more review comments
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: ee5676a5 by Raymond Toy at 2025-11-10T08:53:26-08:00 Address more review comments Rename `os_get_username` to `os_get_user_name`. Remove on extraneous newline at the ned of os-common.c - - - - - 2 changed files: - src/code/unix.lisp - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -2552,7 +2552,7 @@ (progn (setf result (alien-funcall - (extern-alien "os_get_username" + (extern-alien "os_get_user_name" (function (* c-call:c-string) uid-t (* c-call:int))) ===================================== src/lisp/os-common.c ===================================== @@ -779,7 +779,7 @@ again: * returned. */ char * -os_get_username(uid_t uid, int *status) +os_get_user_name(uid_t uid, int *status) { char *buf; char *name; @@ -821,7 +821,7 @@ os_file_author(const char *path) return NULL; } - return os_get_username(sb.st_uid, &status); + return os_get_user_name(sb.st_uid, &status); } int @@ -1037,4 +1037,3 @@ os_getcwd(void) { return getcwd(NULL, 0); } - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee5676a5bfbaec3699fd353… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee5676a5bfbaec3699fd353… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] 5 commits: Implement os_getpwuid per review comments
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: e6e80bd0 by Raymond Toy at 2025-11-10T07:02:47-08:00 Implement os_getpwuid per review comments We implement os_getpwuid and use it as needed to get the user name and/or user directory. This requires updating os_get_username and get_homedir_from_uid and their callers of course. unix::unix-get-username needs updating too. - - - - - 1b2bbe7b by Raymond Toy at 2025-11-10T07:07:13-08:00 Remove old code that we've replaced. - - - - - ec1a3722 by Raymond Toy at 2025-11-10T07:13:11-08:00 Slightly simplify logic in get_homedir_from_uid - - - - - 9d281610 by Raymond Toy at 2025-11-10T08:31:29-08:00 Change API of os_get_username look like other functions Make os_get_username use the same API as used by get_homedir_from_name, get_homedir_from_uid, and os_get_user_homedir. Update unix-get-username implementation appropriately. - - - - - d076e577 by Raymond Toy at 2025-11-10T08:34:44-08:00 Remove old version of unix-get-username - - - - - 3 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -2543,15 +2543,26 @@ (string-decode (cast result c-string) :default))) (defun unix-get-username (uid) - (let (name) - (unwind-protect - (progn - (setf name - (alien-funcall - (extern-alien "os_get_username" - (function (* char) uid-t)) - uid)) - (unless (null-alien name) - (cast name c-call:c-string))) - (unless (null-alien name) + _N"Returns a string that is the user name corresponding to the given UID. + If no such uid exists or if the user name does not exist, NIL is + returned." + (with-alien ((status c-call:int)) + (let (result) + (unwind-protect + (progn + (setf result + (alien-funcall + (extern-alien "os_get_username" + (function (* c-call:c-string) + uid-t + (* c-call:int))) + uid + (addr status))) + (values + (if (and (zerop status) + (not (null-alien result))) + (cast result c-call:c-string) + nil) + status)) (free-alien name))))) + ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -810,3 +810,10 @@ msgstr "" msgid "Returns a string that describes the error code Errno" msgstr "" +#: src/code/unix.lisp +msgid "" +"Returns a string that is the user name corresponding to the given UID.\n" +" If no such uid exists or if the user name does not exist, NIL is\n" +" returned." +msgstr "" + ===================================== src/lisp/os-common.c ===================================== @@ -731,56 +731,37 @@ os_lstat(const char* path, uint64_t *dev, uint64_t *ino, unsigned int *mode, uin } /* - * From the given UID, find the corresponding user name and home - * directory. - * - * NAME and DIR are set to the user name and home directory. The - * caller must free these. If no such uid exists, NAME and DIR are - * set to NULL. - * - * Returns the status of getpwuid. Zero indicates success. Otherwise - * the errno is returned. + * Basic interface to getpwuid, except we will automatically retry if + * the given buffer is too small. To support this |buffer| is a + * pointer to a char buffer. This will be updated with a new buffer + * if we needed to retry getpwuid with a larger buffer. The remaining + * parameters are the same as for getpwuid. */ int -os_get_user_info(uid_t uid, char **name, char **dir) +os_getpwuid(uid_t uid, struct passwd *pwd, char **buffer, size_t buflen, struct passwd **result) { - char initial[1024]; - char *buffer, *obuffer; - size_t size; - struct passwd pwd; - struct passwd *ppwd; int status; - - *name = NULL; - *dir = NULL; - - buffer = initial; - obuffer = NULL; - size = sizeof(initial) / sizeof(initial[0]); + char *obuffer = NULL; /* * Keep trying with larger buffers until a maximum is reached. We * assume (1 << 20) is large enough for any OS. */ again: - switch (status = getpwuid_r(uid, &pwd, buffer, size, &ppwd)) { + switch (status = getpwuid_r(uid, pwd, *buffer, buflen, result)) { case 0: /* Success, though we might not have a matching entry */ - if (ppwd) { - *name = strdup(pwd.pw_name); - *dir = strdup(pwd.pw_dir); - } break; case ERANGE: /* Buffer is too small, double its size and try again */ - size *= 2; - if (size > (1 << 20)) { + buflen *= 2; + if (buflen > (1 << 20)) { break; } - if ((buffer = realloc(obuffer, size)) == NULL) { + if ((*buffer = realloc(obuffer, buflen)) == NULL) { break; } - obuffer = buffer; + obuffer = *buffer; goto again; default: /* All other errors */ @@ -791,23 +772,38 @@ again: return status; } + /* * Given the UID, return the user name. If the uid does not exist, * returns NULL. The caller must call free on the string that is * returned. */ char * -os_get_username(uid_t uid) +os_get_username(uid_t uid, int *status) { - int status; + char *buf; char *name; - char *dir; + struct passwd pwd; + struct passwd *result; + char buffer[1024]; - status = os_get_user_info(uid, &name, &dir); + buf = buffer; - free(dir); + *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); - return (status == 0) ? name : NULL; + if (*status != 0 || result == NULL || result->pw_name == NULL) { + name = NULL; + } else { + name = strdup(result->pw_name); + if (name == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return name; } /* @@ -818,13 +814,14 @@ os_get_username(uid_t uid) char * os_file_author(const char *path) { + int status; struct stat sb; if (stat(path, &sb) != 0) { return NULL; } - return os_get_username(sb.st_uid); + return os_get_username(sb.st_uid, &status); } int @@ -986,16 +983,29 @@ get_homedir_from_name(const char* name, int *status) static char * get_homedir_from_uid(uid_t uid, int *status) { - char *name; + char buffer[1024]; + char *buf; char *dir; - - *status = os_get_user_info(uid, &name, &dir); + struct passwd pwd; + struct passwd *result; - free(name); - - return (*status == 0) ? dir : NULL; -} + buf = buffer; + dir = NULL; + *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); + + if (*status == 0 && result != NULL && result->pw_dir != NULL) { + dir = strdup(result->pw_dir); + if (dir == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return dir; +} /* * Return the home directory of the user named NAME. If NAME is the View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5da6959fd78d7c663dc188… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5da6959fd78d7c663dc188… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #453: Use correct flags when running the analyzer
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 2072ca19 by Raymond Toy at 2025-11-10T05:07:47-08:00 Fix #453: Use correct flags when running the analyzer - - - - - 671d8973 by Raymond Toy at 2025-11-10T05:07:47-08:00 Merge branch 'issue-453-update-make-options-for-analyzer' into 'master' Fix #453: Use correct flags when running the analyzer Closes #453 See merge request cmucl/cmucl!332 - - - - - 2 changed files: - .gitlab-ci.yml - src/lisp/Config.x86_linux Changes: ===================================== .gitlab-ci.yml ===================================== @@ -301,6 +301,7 @@ linux:static-analyzer: tags: - linux artifacts: + when: always paths: - analyzer.log needs: @@ -312,15 +313,7 @@ linux:static-analyzer: # console. If someday there's less or no output, we can consider # having the logs go to the console too. - make -C build-4/lisp clean - # From - # https://docs.gitlab.com/ci/yaml/script/#ignore-non-zero-exit-codes - # - # If the analyzer fails, we still want the logs to be saved. So - # ignore the failure, but also print a message so we know - # something happened. - - exit_code=0 - - make -C build-4/lisp CFLAGS=-fanalyzer > analyzer.log 2>&1 || exit_code=$? - - if [ $exit_code -ne 0 ]; then echo "Analyzer failed with code $exit_code"; fi; + - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1 #### OpenSUSE jobs #### opensuse:install: ===================================== src/lisp/Config.x86_linux ===================================== @@ -4,7 +4,9 @@ include Config.x86_common CFLAGS += $(COPT) CPPFLAGS += -m32 CFLAGS += -rdynamic -march=pentium4 -mfpmath=sse -mtune=generic -CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 +# ANALYZER flag should be set to -fanalyzer when doing the CI builds +# for the C static analyzer. +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 $(ANALYZER) UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/23ef5ca72e86eaf148cdb5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/23ef5ca72e86eaf148cdb5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-453-update-make-options-for-analyzer] Always save analyzer artifacts
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-453-update-make-options-for-analyzer at cmucl / cmucl Commits: c937739e by Raymond Toy at 2025-11-09T16:21:59-08:00 Always save analyzer artifacts Instead of using the exit code (as done previously), modify the artifacts rule to include "when: always". This is simpler and more obvious about what we want. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -301,6 +301,7 @@ linux:static-analyzer: tags: - linux artifacts: + when: always paths: - analyzer.log needs: @@ -312,15 +313,7 @@ linux:static-analyzer: # console. If someday there's less or no output, we can consider # having the logs go to the console too. - make -C build-4/lisp clean - # From - # https://docs.gitlab.com/ci/yaml/script/#ignore-non-zero-exit-codes - # - # If the analyzer fails, we still want the logs to be saved. So - # ignore the failure, but also print a message so we know - # something happened. - - exit_code=0 - - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1 || exit_code=$? - - if [ $exit_code -ne 0 ]; then echo "Analyzer failed with code $exit_code"; fi; + - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1 #### OpenSUSE jobs #### opensuse:install: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c937739e1c717d99cfcfcea… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c937739e1c717d99cfcfcea… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-453-update-make-options-for-analyzer
by Raymond Toy (＠rtoy) 09 Nov '25

09 Nov '25

Raymond Toy pushed new branch issue-453-update-make-options-for-analyzer at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-453-update-make-opt… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Address #453: Save analyzer logs even if analyzer fails
by Raymond Toy (＠rtoy) 09 Nov '25

09 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ec60199f by Raymond Toy at 2025-11-09T11:30:40-08:00 Address #453: Save analyzer logs even if analyzer fails - - - - - 23ef5ca7 by Raymond Toy at 2025-11-09T11:30:40-08:00 Merge branch 'issue-453-save-analyzer-results' into 'master' Address #453: Save analyzer logs even if analyzer fails See merge request cmucl/cmucl!331 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -312,7 +312,15 @@ linux:static-analyzer: # console. If someday there's less or no output, we can consider # having the logs go to the console too. - make -C build-4/lisp clean - - make -C build-4/lisp CFLAGS=-fanalyzer > analyzer.log 2>&1 + # From + # https://docs.gitlab.com/ci/yaml/script/#ignore-non-zero-exit-codes + # + # If the analyzer fails, we still want the logs to be saved. So + # ignore the failure, but also print a message so we know + # something happened. + - exit_code=0 + - make -C build-4/lisp CFLAGS=-fanalyzer > analyzer.log 2>&1 || exit_code=$? + - if [ $exit_code -ne 0 ]; then echo "Analyzer failed with code $exit_code"; fi; #### OpenSUSE jobs #### opensuse:install: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8508d11e81ed0e1ff7887c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8508d11e81ed0e1ff7887c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-453-save-analyzer-results
by Raymond Toy (＠rtoy) 09 Nov '25

09 Nov '25

Raymond Toy pushed new branch issue-453-save-analyzer-results at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-453-save-analyzer-r… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Really remove WITH-TEMPORARY-STREAM
by Raymond Toy (＠rtoy) 07 Nov '25

07 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: cc969535 by Raymond Toy at 2025-11-07T10:53:07-08:00 Really remove WITH-TEMPORARY-STREAM Forgot to remove `with-temporary-stream` from exports.lisp an pprint.lisp. Remove the test from trac.lisp and use the `with-temporary-file` version instead. - - - - - 3 changed files: - src/code/exports.lisp - src/code/pprint.lisp - tests/trac.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1213,8 +1213,7 @@ "INVALID-FASL" "WITH-TEMPORARY-DIRECTORY" - "WITH-TEMPORARY-FILE" - "WITH-TEMPORARY-STREAM") + "WITH-TEMPORARY-FILE") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/pprint.lisp ===================================== @@ -2093,7 +2093,6 @@ When annotations are present, invoke them at the right positions." (c:defoptimizer pprint-defun) (ext:with-float-traps-masked pprint-with-like) (ext:with-float-traps-enabled pprint-with-like) - (ext::with-temporary-stream pprint-with-like) (ext::with-temporary-directory pprint-with-like))) (defun pprint-init () ===================================== tests/trac.lisp ===================================== @@ -175,7 +175,6 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))))) -#+nil (define-test trac.43 (:tag :trac) (assert-true @@ -193,19 +192,6 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))) -(define-test trac.43 - (:tag :trac) - (assert-true - (ext:with-temporary-stream (stream :direction :io :external-format :utf-8) - (dotimes (i 1000) - (write-char (code-char #x1234) stream)) - (file-position stream 0) - (let ((p0 (file-position stream)) - (ch (read-char stream))) - (unread-char ch stream) - (let ((p0* (file-position stream))) - (eql p0* p0)))))) - (define-test trac.50 (:tag :trac) (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/cc969535d9f546a5ab79b77… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/cc969535d9f546a5ab79b77… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0