GitLab

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.

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

            :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.

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

 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"

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

Commits:

3 changed files:

Changes: