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

[Git][cmucl/cmucl][issue-266-b-tilde-pathname-support] 2 commits: Address review comments.
by Raymond Toy (＠rtoy) 07 Dec '23

07 Dec '23

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: 9817f1e9 by Raymond Toy at 2023-12-07T14:11:13-08:00 Address review comments. Rename `replace-tilde-user` to `expand-tilde-user-name` Update `system:get-user-homedir-namestring` to handle a user name of "" which means the current user. - - - - - 1cd91a3d by Raymond Toy at 2023-12-07T14:12:21-08:00 Update pot file for changed comment - - - - - 3 changed files: - src/code/filesys.lisp - src/code/os.lisp - src/i18n/locale/cmucl-os.pot Changes: ===================================== src/code/filesys.lisp ===================================== @@ -301,26 +301,20 @@ (return (values (remove-backslashes namestr start index) (1+ index))))))))) -(defun user-homedir-namestring (name) - (cond ((zerop (length name)) - (unix:user-info-dir (unix:unix-getpwuid (unix:unix-getuid)))) - (t - (system:get-user-homedir-namestring name)))) - -(defun replace-tilde-user (str start end) +(defun expand-tilde-user-name (str start end) ;; Quick exit if STR doesn't start with ~ or we have an empty string. (when (or (= start end) (char/= (schar str start) #\~)) - (return-from replace-tilde-user + (return-from expand-tilde-user-name (values str start end))) (let ((end-user (position #\/ str :start start :end end))) ;; Quick exit if we can't find a "/" to terminate the user name. (unless end-user - (return-from replace-tilde-user + (return-from expand-tilde-user-name (values str start end))) (let* ((user-name (subseq str (1+ start) end-user)) - (homedir (user-homedir-namestring user-name))) + (homedir (get-user-homedir-namestring user-name))) (unless homedir (error "Unknown user ~S in namestring ~S" user-name (subseq str start end))) ;; Replace the ~user part with the home directory, adjusting END @@ -340,7 +334,7 @@ ;; Look for "~user/" (or "~/"). If found replace it with the user's ;; home directory (multiple-value-bind (namestr start end) - (replace-tilde-user namestr start end) + (expand-tilde-user-name namestr start end) (multiple-value-bind (absolute pieces) (split-at-slashes namestr start end) ===================================== src/code/os.lisp ===================================== @@ -61,26 +61,36 @@ ;;; GET-USER-HOMEDIR-NAMESTRING -- Public ;;; (defun get-user-homedir-namestring (name) - _N"Get the user home directory for user named NAME. Two values are - returned: the pathname of the home directory and a status code. If - the home directory does not exist NIL is returned. The status is 0 - if no errors occurred. Otherwise a non-zero value is returned. - Examining errno may give information about what failed." - (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))))) + _N"Get the user home directory for user named NAME. If NAME is the empty + string, the home directory of the current user is returned. + + Two values are returned: the pathname of the home directory and a + status code. If the home directory does not exist NIL is returned. + The status is 0 if no errors occurred. Otherwise a non-zero value + is returned. Examining errno may give information about what failed." + (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))))))) ===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -35,10 +35,12 @@ msgstr "" #: src/code/os.lisp msgid "" -"Get the user home directory for user named NAME. Two values are\n" -" returned: the pathname of the home directory and a status code. If\n" -" the home directory does not exist NIL is returned. The status is 0\n" -" if no errors occurred. Otherwise a non-zero value is returned.\n" -" Examining errno may give information about what failed." +"Get the user home directory for user named NAME. If NAME is the empty\n" +" string, the home directory of the current user is returned.\n" +"\n" +" Two values are returned: the pathname of the home directory and a\n" +" status code. If the home directory does not exist NIL is returned.\n" +" The status is 0 if no errors occurred. Otherwise a non-zero value\n" +" is returned. Examining errno may give information about what failed." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/59d589645f9fbdc81dd462… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/59d589645f9fbdc81dd462… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-b-tilde-pathname-support] Simplify code.
by Raymond Toy (＠rtoy) 06 Dec '23

06 Dec '23

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: 59d58964 by Raymond Toy at 2023-12-06T13:59:14-08:00 Simplify code. `user-homedir-namestring` did too much unneeded stuff. And don't signal an error here. Signal an error in `replace-tilde-user` if the user can't be found. - - - - - 1 changed file: - src/code/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -303,14 +303,9 @@ (defun user-homedir-namestring (name) (cond ((zerop (length name)) - (let ((user (unix:unix-getpwuid (unix:unix-getuid)))) - (concatenate 'simple-base-string - (unix:user-info-dir user)))) + (unix:user-info-dir (unix:unix-getpwuid (unix:unix-getuid)))) (t - (let ((path (system:get-user-homedir-namestring name))) - (unless path - (error "Unknown user: ~S" name)) - path)))) + (system:get-user-homedir-namestring name)))) (defun replace-tilde-user (str start end) ;; Quick exit if STR doesn't start with ~ or we have an empty string. @@ -326,6 +321,8 @@ (values str start end))) (let* ((user-name (subseq str (1+ start) end-user)) (homedir (user-homedir-namestring user-name))) + (unless homedir + (error "Unknown user ~S in namestring ~S" user-name (subseq str start end))) ;; Replace the ~user part with the home directory, adjusting END ;; because of the replacement. (values (concatenate 'simple-base-string View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/59d589645f9fbdc81dd4623… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/59d589645f9fbdc81dd4623… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-b-tilde-pathname-support] Remove debugging prints
by Raymond Toy (＠rtoy) 06 Dec '23

06 Dec '23

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: 723474d6 by Raymond Toy at 2023-12-06T13:53:17-08:00 Remove debugging prints - - - - - 1 changed file: - src/code/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -313,9 +313,6 @@ path)))) (defun replace-tilde-user (str start end) - #+nil - (return-from replace-tilde-user - (values str start end)) ;; Quick exit if STR doesn't start with ~ or we have an empty string. (when (or (= start end) (char/= (schar str start) #\~)) @@ -323,18 +320,14 @@ (values str start end))) (let ((end-user (position #\/ str :start start :end end))) - #+nil - (format t "user ~D:~D: ~A~%" (1+ start) end-user (subseq str (1+ start) end-user)) ;; Quick exit if we can't find a "/" to terminate the user name. (unless end-user (return-from replace-tilde-user (values str start end))) (let* ((user-name (subseq str (1+ start) end-user)) (homedir (user-homedir-namestring user-name))) - #+nil - (format t "user-name: ~S; homedir: ~S~%" - user-name homedir) - ;; Replace the ~user part with the home directory, adjusting END because of the replacement. + ;; Replace the ~user part with the home directory, adjusting END + ;; because of the replacement. (values (concatenate 'simple-base-string (subseq str 0 start) homedir @@ -351,8 +344,6 @@ ;; home directory (multiple-value-bind (namestr start end) (replace-tilde-user namestr start end) - #+nil - (format t "~S: ~D ~D~%" namestr start end) (multiple-value-bind (absolute pieces) (split-at-slashes namestr start end) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/723474d6587dbfe474e5cba… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/723474d6587dbfe474e5cba… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-b-tilde-pathname-support] 2 commits: More cleanups.
by Raymond Toy (＠rtoy) 06 Dec '23

06 Dec '23

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: 31ebd79e by Raymond Toy at 2023-12-06T13:29:10-08:00 More cleanups. In `get-user-homedir-pathname` Don't append a "/" to the namestring. Simplify `replace-tilde-user` by doing a quick exit when we can't find the trailing "/" for the user name. - - - - - fa8607b1 by Raymond Toy at 2023-12-06T13:38:59-08:00 Rename to get-user-homedir-namestring. We don't return a pathname anymore, so rename the function to indicate better that we're returning a namestring now. - - - - - 3 changed files: - src/code/exports.lisp - src/code/filesys.lisp - src/code/os.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -2074,7 +2074,7 @@ "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" - "GET-USER-HOMEDIR-PATHNAME" + "GET-USER-HOMEDIR-NAMESTRING" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS" ===================================== src/code/filesys.lisp ===================================== @@ -305,10 +305,9 @@ (cond ((zerop (length name)) (let ((user (unix:unix-getpwuid (unix:unix-getuid)))) (concatenate 'simple-base-string - (unix:user-info-dir user) - "/"))) + (unix:user-info-dir user)))) (t - (let ((path (system:get-user-homedir-pathname name))) + (let ((path (system:get-user-homedir-namestring name))) (unless path (error "Unknown user: ~S" name)) path)))) @@ -326,22 +325,24 @@ (let ((end-user (position #\/ str :start start :end end))) #+nil (format t "user ~D:~D: ~A~%" (1+ start) end-user (subseq str (1+ start) end-user)) - (cond (end-user - (let* ((user-name (subseq str (1+ start) end-user)) - (homedir (user-homedir-namestring user-name))) - #+nil - (format t "user-name: ~S; homedir: ~S~%" - user-name homedir) - (values (concatenate 'simple-base-string - (subseq str 0 start) - homedir - (subseq str (1+ end-user))) - start - (+ end (- (length homedir) - (length user-name) - 2))))) - (t - (values str start end))))) + ;; Quick exit if we can't find a "/" to terminate the user name. + (unless end-user + (return-from replace-tilde-user + (values str start end))) + (let* ((user-name (subseq str (1+ start) end-user)) + (homedir (user-homedir-namestring user-name))) + #+nil + (format t "user-name: ~S; homedir: ~S~%" + user-name homedir) + ;; Replace the ~user part with the home directory, adjusting END because of the replacement. + (values (concatenate 'simple-base-string + (subseq str 0 start) + homedir + (subseq str end-user)) + start + (+ end (- (length homedir) + (length user-name) + 1)))))) (defun parse-unix-namestring (namestr start end) (declare (type simple-base-string namestr) ===================================== src/code/os.lisp ===================================== @@ -58,9 +58,9 @@ (unix:get-unix-error-msg utime))) (values utime stime major-fault)))) -;;; GET-USER-HOMEDIR-PATHNAME -- Public +;;; GET-USER-HOMEDIR-NAMESTRING -- Public ;;; -(defun get-user-homedir-pathname (name) +(defun get-user-homedir-namestring (name) _N"Get the user home directory for user named NAME. Two values are returned: the pathname of the home directory and a status code. If the home directory does not exist NIL is returned. The status is 0 @@ -80,9 +80,7 @@ (alien:addr status))) (if (and (zerop status) (not (alien:null-alien result))) - (values (concatenate 'string - (alien:cast result c-call:c-string) - "/") + (values (alien:cast result c-call:c-string) status) (values nil status))) (alien:free-alien result))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/08222e493e4d0ec039b219… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/08222e493e4d0ec039b219… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-266-b-tilde-pathname-support
by Raymond Toy (＠rtoy) 06 Dec '23

06 Dec '23

Raymond Toy pushed new branch issue-266-b-tilde-pathname-support at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-266-b-tilde-pathnam… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] 2 commits: Update release notes
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl Commits: 2575887d by Raymond Toy at 2023-11-30T15:16:43-08:00 Update release notes - - - - - 3561af64 by Raymond Toy at 2023-11-30T15:16:52-08:00 Add test for ~ in pathnames. Just get the directory list for #P"~/*.*" and #P"home:". They should be identical. - - - - - 2 changed files: - src/general-info/release-21f.md - tests/pathname.lisp Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -39,6 +39,7 @@ public domain. * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory + * ~~#266~~ Support ~ in pathnames like a shell * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/pathname.lisp ===================================== @@ -111,3 +111,12 @@ test (assert-equal printed-value (output pathname)) (assert-equal namestring (namestring pathname)))))) + +(define-test issue.266.pathname-tilde + (:tag :issues) + ;; Simple test for ~ in pathnames. Get the directory list using + ;; #P"~/*.*". This should be equal to the directory using the + ;; search-list #P"home:*.*". + (let ((dir-home (directory #P"home:*.*")) + (dir-tilde (directory #P"~/*.*"))) + (assert-equal dir-tilde dir-home))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/efc75c10eb0e38f38b997f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/efc75c10eb0e38f38b997f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] Use new system:get-user-homedir-pathname
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl Commits: efc75c10 by Raymond Toy at 2023-11-30T06:38:57-08:00 Use new system:get-user-homedir-pathname Update `user-homedir-namestring` to use `system:get-user-homedir-pathname`. This also means removing `unix:unix-getpwnam-tmp` from filesys.lisp. - - - - - 3 changed files: - src/code/filesys.lisp - src/code/unix.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1085,12 +1085,16 @@ optionally keeping some of the most recent old versions." hash)))) (defun user-homedir-namestring (&optional username) + "Returns the namestring for the user's home directory. If Username is + not specified, then use the current user." (flet ((unix-user-homedir (username) - (let ((user-info (unix::unix-getpwnam-tmp username))) - (if user-info (unix:user-info-dir user-info)))) + (let ((user-homedir (system:get-user-homedir-pathname username))) + (when user-homedir + (namestring user-homedir)))) (unix-uid-homedir (uid) (let ((user-info (unix::unix-getpwuid uid))) - (if user-info (unix:user-info-dir user-info))))) + (when user-info + (unix:user-info-dir user-info))))) (if username (unix-user-homedir username) (let ((env-home (unix:unix-getenv "HOME"))) ===================================== src/code/unix.lisp ===================================== @@ -2644,37 +2644,6 @@ :shell (string (cast (slot result 'pw-shell) c-call:c-string))) (values nil returned))))) -#+linux -(defun unix-getpwnam-tmp (login) - "Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." - (declare (type simple-string login)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd)) - (result (* (struct passwd)))) - (let ((returned - (alien-funcall - (extern-alien "getpwnam_r" - (function c-call:int - c-call:c-string - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct passwd))))) - login - (addr user-info) - (cast buf (* c-call:char)) - 1024 - (addr result)))) - (when (zerop returned) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - ;;; Getrusage is not provided in the C library on Solaris 2.4, and is ;;; rather slow on later versions so the "times" system call is ;;; provided. ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -10120,6 +10120,12 @@ msgid "" "optionally keeping some of the most recent old versions." msgstr "" +#: src/code/filesys.lisp +msgid "" +"Returns the namestring for the user's home directory. If Username is\n" +" not specified, then use the current user." +msgstr "" + #: src/code/filesys.lisp msgid "" "Returns the home directory of the logged in user as a pathname.\n" @@ -21329,6 +21335,10 @@ msgstr "" msgid "Implements FILE-POSITION for the stream for setting the position." msgstr "" +#: src/pcl/gray-streams.lisp +msgid "Implements FILE-LENGTH for the stream." +msgstr "" + #: src/pcl/gray-streams.lisp msgid "" "Used by READ-BYTE; returns either an integer, or the symbol :EOF\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] 3 commits: Fix #269: Add function to get user's home directory
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl Commits: a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00 Fix #269: Add function to get user's home directory - - - - - 8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00 Merge branch 'issue-269-unix-get-user-homedir' into 'master' Fix #269: Add function to get user's home directory Closes #269 See merge request cmucl/cmucl!178 - - - - - 8fe17e76 by Raymond Toy at 2023-11-30T05:48:49-08:00 Merge branch 'master' into issue-266-tilde-pathname-support - - - - - 6 changed files: - src/code/exports.lisp - src/code/os.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-os.pot - src/lisp/os-common.c - + tests/os.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -2074,6 +2074,7 @@ "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" + "GET-USER-HOMEDIR-PATHNAME" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS" ===================================== src/code/os.lisp ===================================== @@ -57,3 +57,33 @@ (error (intl:gettext "Unix system call getrusage failed: ~A.") (unix:get-unix-error-msg utime))) (values utime stime major-fault)))) + +;;; GET-USER-HOMEDIR-PATHNAME -- Public +;;; +(defun get-user-homedir-pathname (name) + _N"Get the user home directory for user named NAME. Two values are + returned: the pathname of the home directory and a status code. If + the home directory does not exist NIL is returned. The status is 0 + if no errors occurred. Otherwise a non-zero value is returned. + Examining errno may give information about what failed." + (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 (pathname + (concatenate 'string + (alien:cast result c-call:c-string) + "/")) + status) + (values nil status))) + (alien:free-alien result))))) ===================================== src/general-info/release-21f.md ===================================== @@ -38,6 +38,7 @@ public domain. * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86 * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp + * ~~#269~~ Add function to get user's home directory * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -33,3 +33,12 @@ msgstr "" msgid "Unix system call getrusage failed: ~A." msgstr "" +#: src/code/os.lisp +msgid "" +"Get the user home directory for user named NAME. Two values are\n" +" returned: the pathname of the home directory and a status code. If\n" +" the home directory does not exist NIL is returned. The status is 0\n" +" if no errors occurred. Otherwise a non-zero value is returned.\n" +" Examining errno may give information about what failed." +msgstr "" + ===================================== src/lisp/os-common.c ===================================== @@ -863,3 +863,74 @@ 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) +{ + int buflen; + char *buf = NULL; + struct passwd pwd; + struct passwd *result; + + buflen = sysconf(_SC_GETPW_R_SIZE_MAX); + /* + * If sysconf failed, just try some possibly large enough value. + */ + if (buflen == -1) { + buflen = 1024; + } + + /* + * sysconf may return a value that is not large enough, so start + * with the given value and keep increasing it until we reach some + * upper limit and give up. + */ + while (buflen <= (1 << 20)) { + buf = realloc(buf, buflen); + + if (buf == NULL) { + *status = -1; + return NULL; + } + + *status = getpwnam_r(name, &pwd, buf, buflen, &result); + + if (*status == 0) { + /* + * Success, or entry was not found. If found, the result + * is not NULL. Return the result or NULL + */ + char* path = result ? strdup(pwd.pw_dir) : NULL; + free(buf); + return path; + } + + /* + * Check errno for ERANGE. If so, the buffer was too small, so grow it. + */ + if (errno == ERANGE) { + buflen *= 2; + } else { + /* + * Some other error. Just return NULL + */ + free(buf); + return NULL; + } + } + + /* + * Ran out of space. Just return NULL and set status to -1. + */ + free(buf); + *status = -1; + return NULL; +} + ===================================== tests/os.lisp ===================================== @@ -0,0 +1,38 @@ +(defpackage :os-tests + (:use :cl :lisp-unit)) + +(in-package "OS-TESTS") + + +(define-test user-homedir.1 + "Test user-homedir" + (:tag :issues) + ;; Simple test to see if get-user-homedir-pathname returns the + ;; expected value. Use getuid and getpwuid to figure out what the + ;; name and home directory should be. + (let* ((uid (unix:unix-getuid)) + (user-info (unix:unix-getpwuid uid))) + (assert-true uid) + (assert-true user-info) + (let* ((info-dir (unix:user-info-dir user-info)) + (info-name (unix:user-info-name user-info)) + (expected-home-pathname (pathname + (concatenate 'string info-dir "/")))) + (multiple-value-bind (home-pathname status) + (system:get-user-homedir-pathname info-name) + (assert-true info-dir) + (assert-true info-name) + + (assert-equal home-pathname expected-home-pathname) + (assert-eql status 0))))) + +(define-test user-homedir.2 + "Test user-homedir" + (:tag :issues) + ;; Simple test to see if get-user-homedir-pathname returns the expected + ;; value for a user that does not exist. Well, we assume such a + ;; user doesn't exist. + (multiple-value-bind (home-pathname status) + (system:get-user-homedir-pathname "zotuserunknown") + (assert-eql home-pathname nil) + (assert-eql status 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9536863458f79ca9d12810… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9536863458f79ca9d12810… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #269: Add function to get user's home directory
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00 Fix #269: Add function to get user's home directory - - - - - 8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00 Merge branch 'issue-269-unix-get-user-homedir' into 'master' Fix #269: Add function to get user's home directory Closes #269 See merge request cmucl/cmucl!178 - - - - - 6 changed files: - src/code/exports.lisp - src/code/os.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-os.pot - src/lisp/os-common.c - + tests/os.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -2074,6 +2074,7 @@ "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" + "GET-USER-HOMEDIR-PATHNAME" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS" ===================================== src/code/os.lisp ===================================== @@ -57,3 +57,33 @@ (error (intl:gettext "Unix system call getrusage failed: ~A.") (unix:get-unix-error-msg utime))) (values utime stime major-fault)))) + +;;; GET-USER-HOMEDIR-PATHNAME -- Public +;;; +(defun get-user-homedir-pathname (name) + _N"Get the user home directory for user named NAME. Two values are + returned: the pathname of the home directory and a status code. If + the home directory does not exist NIL is returned. The status is 0 + if no errors occurred. Otherwise a non-zero value is returned. + Examining errno may give information about what failed." + (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 (pathname + (concatenate 'string + (alien:cast result c-call:c-string) + "/")) + status) + (values nil status))) + (alien:free-alien result))))) ===================================== src/general-info/release-21f.md ===================================== @@ -38,6 +38,7 @@ public domain. * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86 * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp + * ~~#269~~ Add function to get user's home directory * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -33,3 +33,12 @@ msgstr "" msgid "Unix system call getrusage failed: ~A." msgstr "" +#: src/code/os.lisp +msgid "" +"Get the user home directory for user named NAME. Two values are\n" +" returned: the pathname of the home directory and a status code. If\n" +" the home directory does not exist NIL is returned. The status is 0\n" +" if no errors occurred. Otherwise a non-zero value is returned.\n" +" Examining errno may give information about what failed." +msgstr "" + ===================================== src/lisp/os-common.c ===================================== @@ -863,3 +863,74 @@ 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) +{ + int buflen; + char *buf = NULL; + struct passwd pwd; + struct passwd *result; + + buflen = sysconf(_SC_GETPW_R_SIZE_MAX); + /* + * If sysconf failed, just try some possibly large enough value. + */ + if (buflen == -1) { + buflen = 1024; + } + + /* + * sysconf may return a value that is not large enough, so start + * with the given value and keep increasing it until we reach some + * upper limit and give up. + */ + while (buflen <= (1 << 20)) { + buf = realloc(buf, buflen); + + if (buf == NULL) { + *status = -1; + return NULL; + } + + *status = getpwnam_r(name, &pwd, buf, buflen, &result); + + if (*status == 0) { + /* + * Success, or entry was not found. If found, the result + * is not NULL. Return the result or NULL + */ + char* path = result ? strdup(pwd.pw_dir) : NULL; + free(buf); + return path; + } + + /* + * Check errno for ERANGE. If so, the buffer was too small, so grow it. + */ + if (errno == ERANGE) { + buflen *= 2; + } else { + /* + * Some other error. Just return NULL + */ + free(buf); + return NULL; + } + } + + /* + * Ran out of space. Just return NULL and set status to -1. + */ + free(buf); + *status = -1; + return NULL; +} + ===================================== tests/os.lisp ===================================== @@ -0,0 +1,38 @@ +(defpackage :os-tests + (:use :cl :lisp-unit)) + +(in-package "OS-TESTS") + + +(define-test user-homedir.1 + "Test user-homedir" + (:tag :issues) + ;; Simple test to see if get-user-homedir-pathname returns the + ;; expected value. Use getuid and getpwuid to figure out what the + ;; name and home directory should be. + (let* ((uid (unix:unix-getuid)) + (user-info (unix:unix-getpwuid uid))) + (assert-true uid) + (assert-true user-info) + (let* ((info-dir (unix:user-info-dir user-info)) + (info-name (unix:user-info-name user-info)) + (expected-home-pathname (pathname + (concatenate 'string info-dir "/")))) + (multiple-value-bind (home-pathname status) + (system:get-user-homedir-pathname info-name) + (assert-true info-dir) + (assert-true info-name) + + (assert-equal home-pathname expected-home-pathname) + (assert-eql status 0))))) + +(define-test user-homedir.2 + "Test user-homedir" + (:tag :issues) + ;; Simple test to see if get-user-homedir-pathname returns the expected + ;; value for a user that does not exist. Well, we assume such a + ;; user doesn't exist. + (multiple-value-bind (home-pathname status) + (system:get-user-homedir-pathname "zotuserunknown") + (assert-eql home-pathname nil) + (assert-eql status 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b218d29ce4fdc4529f2dbe… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b218d29ce4fdc4529f2dbe… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] 2 commits: Revert changes to match master branch
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 121966b8 by Raymond Toy at 2023-11-30T05:26:11-08:00 Revert changes to match master branch - - - - - e295afde by Raymond Toy at 2023-11-30T05:26:28-08:00 Address review comments Remove incorrect export symbol because it's not in EXTENSIONS anymore. - - - - - 2 changed files: - src/code/filesys.lisp - tests/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -27,8 +27,7 @@ (in-package "EXTENSIONS") (export '(print-directory complete-file ambiguous-files default-directory - purge-backup-files file-writable unix-namestring - get-user-homedir-pathname)) + purge-backup-files file-writable unix-namestring)) (in-package "LISP") ===================================== tests/filesys.lisp ===================================== @@ -54,3 +54,7 @@ (assert-equal "/tmp/foo/bar/symlink" (ext:unix-namestring "/tmp/foo/bar/symlink" nil))) (unix:unix-unlink "/tmp/foo/bar/symlink"))) + + + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a24b478ffed5ec6585bc6b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a24b478ffed5ec6585bc6b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0