GitLab

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.

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.

 	   "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"

   (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))))

   (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)

 	       (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

                     (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)))))

Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl

Commits:

3 changed files:

Changes: