X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=ec2c6387dc5ece99d06c08bcebab2c093e0e9d4f;hb=21bb73db9c3f333ead8a848f863b957a6db5a5c9;hp=eace65c5706dc1ccbe6c85322e52c9c56233a631;hpb=aa61c7571b33b86981301f34d3acdb66666f53a3;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index eace65c..ec2c638 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -90,7 +90,7 @@
 
 ;;;; hacking the Unix environment
 
-(def-alien-routine ("getenv" posix-getenv) c-string
+(define-alien-routine ("getenv" posix-getenv) c-string
   "Return the \"value\" part of the environment string \"name=value\" which
    corresponds to NAME, or NIL if there is none."
   (name c-string))
@@ -112,12 +112,12 @@
 ;;; is not extreme enough, since it doesn't need to be blindingly
 ;;; fast: we can just implement those functions in C as a wrapper
 ;;; layer.
-(def-alien-type fd-mask unsigned-long)
+(define-alien-type fd-mask unsigned-long)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant fd-setsize 1024))
 
-(def-alien-type nil
+(define-alien-type nil
   (struct fd-set
 	  (fds-bits (array fd-mask #.(/ fd-setsize 32)))))
 
@@ -152,7 +152,7 @@
 
 ;; A time value that is accurate to the nearest
 ;; microsecond but also has a range of years.
-(def-alien-type nil
+(define-alien-type nil
   (struct timeval
 	  (tv-sec time-t)		; seconds
 	  (tv-usec time-t)))		; and microseconds
@@ -163,7 +163,7 @@
 (defconstant rusage_children -1) ; terminated child processes
 (defconstant rusage_both -2)
 
-(def-alien-type nil
+(define-alien-type nil
   (struct rusage
     (ru-utime (struct timeval))	    ; user time used
     (ru-stime (struct timeval))	    ; system time used.
@@ -264,6 +264,16 @@
 	   (type unix-file-mode mode))
   (void-syscall ("mkdir" c-string int) name mode))
 
+;;; Given a C char* pointer allocated by malloc(), free it and return a
+;;; corresponding Lisp string (or return NIL if the pointer is a C NULL).
+(defun newcharstar-string (newcharstar)
+  (declare (type (alien (* char)) newcharstar))
+  (if (null-alien newcharstar)
+      nil
+      (prog1
+	  (cast newcharstar c-string)
+	(free-alien newcharstar))))
+
 ;;; Return the Unix current directory as a SIMPLE-STRING, in the
 ;;; style returned by getcwd() (no trailing slash character). 
 (defun posix-getcwd ()
@@ -272,15 +282,12 @@
   ;; pointer is used. On a system which doesn't support that
   ;; extension, it'll have to be rewritten somehow.
   #!-(or linux openbsd freebsd) (,stub,)
-  (let* ((raw-char-ptr (alien-funcall (extern-alien "getcwd"
-						    (function (* char)
-							      (* char) size-t))
-				      nil 0)))
-    (if (null-alien raw-char-ptr)
-	(simple-perror "getcwd")
-	(prog1
-	    (cast raw-char-ptr c-string)
-	  (free-alien raw-char-ptr)))))
+  (or (newcharstar-string (alien-funcall (extern-alien "getcwd"
+						       (function (* char)
+								 (* char)
+								 size-t))
+					 nil 0))
+      (simple-perror "getcwd")))
 
 ;;; Return the Unix current directory as a SIMPLE-STRING terminated
 ;;; by a slash character.
@@ -318,10 +325,17 @@
   (void-syscall ("exit" int) code))
 
 ;;; Return the process id of the current process.
-(def-alien-routine ("getpid" unix-getpid) int)
+(define-alien-routine ("getpid" unix-getpid) int)
+
+;;; Return the real user id associated with the current process.
+(define-alien-routine ("getuid" unix-getuid) int)
 
-;;; Return the real user-id associated with the current process.
-(def-alien-routine ("getuid" unix-getuid) int)
+;;; Translate a user id into a login name.
+(defun uid-username (uid)
+  (or (newcharstar-string (alien-funcall (extern-alien "uid_username"
+						       (function (* char) int))
+					 uid))
+      (error "found no match for Unix uid=~S" uid)))
 
 ;;; Invoke readlink(2) on the file name specified by PATH. Return
 ;;; (VALUES LINKSTRING NIL) on success, or (VALUES NIL ERRNO) on
@@ -512,7 +526,7 @@
 ;;; st_size is a long, not an off-t, because off-t is a 64-bit
 ;;; quantity on Alpha. And FIXME: "No one would want a file length
 ;;; longer than 32 bits anyway, right?":-|
-(def-alien-type nil
+(define-alien-type nil
   (struct wrapped_stat
     (st-dev unsigned-long)              ; would be dev-t in a real stat
     (st-ino ino-t)
@@ -587,13 +601,13 @@
 
 ;; the POSIX.4 structure for a time value. This is like a "struct
 ;; timeval" but has nanoseconds instead of microseconds.
-(def-alien-type nil
+(define-alien-type nil
     (struct timespec
 	    (tv-sec long)   ; seconds
 	    (tv-nsec long))) ; nanoseconds
 
 ;; used by other time functions
-(def-alien-type nil
+(define-alien-type nil
     (struct tm
 	    (tm-sec int)   ; Seconds.	[0-60] (1 leap second)
 	    (tm-min int)   ; Minutes.	[0-59]
@@ -607,7 +621,7 @@
 	    (tm-gmtoff long) ;  Seconds east of UTC.
 	    (tm-zone c-string))) ; Timezone abbreviation.
 
-(def-alien-routine get-timezone sb!c-call:void
+(define-alien-routine get-timezone sb!c-call:void
   (when sb!c-call:long :in)
   (minutes-west sb!c-call:int :out)
   (daylight-savings-p sb!alien:boolean :out))
@@ -627,7 +641,7 @@
 
 ;;; Structure crudely representing a timezone. KLUDGE: This is
 ;;; obsolete and should never be used.
-(def-alien-type nil
+(define-alien-type nil
   (struct timezone
     (tz-minuteswest int)		; minutes west of Greenwich
     (tz-dsttime	int)))			; type of dst correction