December 2023 - 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