\f
;;;; 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))
;;; 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)))))
;; 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
(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.
(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 ()
;; 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.
(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
;;; 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)
;; 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]
(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))
;;; 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
(defun unix-resolve-links (pathname)
(declare (type simple-string pathname))
(aver (not (relative-unix-pathname? pathname)))
- (/show "entering UNIX-RESOLVE-LINKS")
+ (/noshow "entering UNIX-RESOLVE-LINKS")
(loop with previous-pathnames = nil do
- (/show pathname previous-pathnames)
+ (/noshow pathname previous-pathnames)
(let ((link (unix-readlink pathname)))
- (/show link)
+ (/noshow link)
;; Unlike the old CMU CL code, we handle a broken symlink by
;; returning the link itself. That way, CL:TRUENAME on a
;; broken link returns the link itself, so that CL:DIRECTORY
pathname
:from-end t)))
(dir (subseq pathname 0 dir-len)))
- (/show dir)
+ (/noshow dir)
(concatenate 'string dir link))
link))))
(if (unix-file-kind new-pathname)