Raymond Toy pushed to branch issue-139-default-external-format-utf8 at cmucl / cmucl

Commits: 4a7207b6 by Raymond Toy at 2022-10-17T18:58:45+00:00 Fix #130: Implement file_author in C

- - - - - ba5c5d2a by Raymond Toy at 2022-10-17T18:58:45+00:00 Merge branch 'issue-130-file-author-in-c' into 'master'

Fix #130: Implement file_author in C

Closes #130

See merge request cmucl/cmucl!88 - - - - - ab9b27f9 by Raymond Toy at 2022-10-30T12:42:13-07:00 Merge branch 'master' into issue-139-default-external-format-utf8

- - - - -

4 changed files:

- src/code/filesys.lisp - src/lisp/os-common.c - tests/issues.lisp - + tests/안녕하십니까.txt

Changes:

===================================== src/code/filesys.lisp ===================================== @@ -1079,13 +1079,21 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (unix:unix-stat name) - (declare (ignore dev ino mode nlink)) - (when winp - (let ((user-info (unix:unix-getpwuid uid))) - (when user-info - (unix:user-info-name user-info)))))))) + ;; unix-namestring converts "." to "". Convert it back to + ;; "." so we can stat the current directory. (Perhaps + ;; that's a bug in unix-namestring?) + (when (zerop (length name)) + (setf name ".")) + (let (author) + (unwind-protect + (progn + (setf author (alien:alien-funcall + (alien:extern-alien "os_file_author" + (function (alien:* c-call:c-string) c-call:c-string)) + (unix::%name->file name))) + (unless (alien:null-alien author) + (alien:cast author c-call:c-string))) + (alien:free-alien author))))))

;;;; DIRECTORY.

===================================== src/lisp/os-common.c ===================================== @@ -5,12 +5,16 @@

*/

+#include <assert.h> #include <errno.h> #include <math.h> #include <netdb.h> +#include <pwd.h> #include <stdio.h> +#include <stdlib.h> #include <string.h> #include <sys/stat.h> +#include <unistd.h> #include <time.h>

#include "os.h" @@ -715,3 +719,57 @@ os_lstat(const char* path, u_int64_t *dev, u_int64_t *ino, unsigned int *mode, u

return rc; } + +/* + * 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) +{ + 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]); + + /* + * Keep trying with larger buffers until a maximum is reached. We + * assume (1 << 20) is large enough for any OS. + */ + while (size <= (1 << 20)) { + switch (getpwuid_r(sb.st_uid, &pwd, buffer, size, &ppwd)) { + case 0: + /* Success, though we might not have a matching entry */ + result = (ppwd == NULL) ? NULL : strdup(pwd.pw_name); + goto exit; + case ERANGE: + /* Buffer is too small, double its size and try again */ + size *= 2; + obuffer = (buffer == initial) ? NULL : buffer; + if ((buffer = realloc(obuffer, size)) == NULL) { + goto exit; + } + continue; + default: + /* All other errors */ + goto exit; + } + } +exit: + free(obuffer); + + return result; +}

===================================== tests/issues.lisp ===================================== @@ -676,6 +676,14 @@ (err (relerr value answer))) (assert-true (<= err eps) base err eps)))))))

+(define-test issue.130 + (:tag :issues) + ;; Just verify that file-author works. In particular "." should + ;; work and not return NIL. + (assert-true (file-author ".")) + (assert-true (file-author "bin/build.sh")) + (assert-true (file-author "tests/안녕하십니까.txt"))) + (define-test issue.139-default-external-format (:tag :issues) (assert-eq :utf-8 stream:*default-external-format*))

===================================== tests/안녕하십니까.txt ===================================== @@ -0,0 +1,3 @@ +The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.) + +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3717f16569510d166630f00...