Newer
Older
(defconstant ITIMER-VIRTUAL 1)
(defconstant ITIMER-PROF 2)
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
"Unix-getitimer returns the INTERVAL and VALUE slots of one of
three system timers (:real :virtual or :profile). On success,
unix-getitimer returns 5 values,
T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
(declare (type (member :real :virtual :profile) which)
(values t
(unsigned-byte 29)(mod 1000000)
(unsigned-byte 29)(mod 1000000)))
(let ((which (ecase which
(:real ITIMER-REAL)
(:virtual ITIMER-VIRTUAL)
(:profile ITIMER-PROF))))
(with-alien ((itv (struct itimerval)))
(syscall* ("getitimer" int (* (struct itimerval)))
(values T
(slot (slot itv 'it-interval) 'tv-sec)
(slot (slot itv 'it-interval) 'tv-usec)
(slot (slot itv 'it-value) 'tv-sec)
(slot (slot itv 'it-value) 'tv-usec))
which (alien-sap (addr itv))))))
(defun unix-setitimer (which int-secs int-usec val-secs val-usec)
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
" Unix-setitimer sets the INTERVAL and VALUE slots of one of
three system timers (:real :virtual or :profile). A SIGALRM signal
will be delivered VALUE <seconds+microseconds> from now. INTERVAL,
when non-zero, is <seconds+microseconds> to be loaded each time
the timer expires. Setting INTERVAL and VALUE to zero disables
the timer. See the Unix man page for more details. On success,
unix-setitimer returns the old contents of the INTERVAL and VALUE
slots as in unix-getitimer."
(declare (type (member :real :virtual :profile) which)
(type (unsigned-byte 29) int-secs val-secs)
(type (integer 0 (1000000)) int-usec val-usec)
(values t
(unsigned-byte 29)(mod 1000000)
(unsigned-byte 29)(mod 1000000)))
(let ((which (ecase which
(:real ITIMER-REAL)
(:virtual ITIMER-VIRTUAL)
(:profile ITIMER-PROF))))
(with-alien ((itvn (struct itimerval))
(itvo (struct itimerval)))
(setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs
(slot (slot itvn 'it-interval) 'tv-usec) int-usec
(slot (slot itvn 'it-value ) 'tv-sec ) val-secs
(slot (slot itvn 'it-value ) 'tv-usec) val-usec)
(syscall* ("setitimer" int (* (struct timeval))(* (struct timeval)))
(values T
(slot (slot itvo 'it-interval) 'tv-sec)
(slot (slot itvo 'it-interval) 'tv-usec)
(slot (slot itvo 'it-value) 'tv-sec)
(slot (slot itvo 'it-value) 'tv-usec))
which (alien-sap (addr itvn))(alien-sap (addr itvo))))))
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
;;;; User and group database access, POSIX Standard 9.2.2
#+solaris
(defun unix-getpwnam (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)))
(let ((result
(alien-funcall
(extern-alien "getpwnam_r"
(function (* (struct passwd))
c-call:c-string
(* (struct passwd))
(* c-call:char)
c-call:unsigned-int))
login
(addr user-info)
(cast buf (* c-call:char))
1024)))
(when (not (zerop (sap-int (alien-sap result))))
(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)
:age (string (cast (slot result 'pw-age) c-call:c-string))
:comment (string (cast (slot result 'pw-comment) c-call:c-string))
: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)))))))
#+(or FreeBSD NetBSD darwin)
(defun unix-getpwnam (login)
"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
(declare (type simple-string login))
(let ((result
(alien-funcall
(extern-alien "getpwnam"
(function (* (struct passwd))
c-call:c-string))
login)))
(when (not (zerop (sap-int (alien-sap result))))
(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)
#-darwin :change #-darwin (slot result 'pw-change)
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
: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))))))
#+solaris
(defun unix-getpwuid (uid)
"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
(declare (type unix-uid uid))
(with-alien ((buf (array c-call:char 1024))
(user-info (struct passwd)))
(let ((result
(alien-funcall
(extern-alien "getpwuid_r"
(function (* (struct passwd))
c-call:unsigned-int
(* (struct passwd))
(* c-call:char)
c-call:unsigned-int))
uid
(addr user-info)
(cast buf (* c-call:char))
1024)))
(when (not (zerop (sap-int (alien-sap result))))
(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)
:age (string (cast (slot result 'pw-age) c-call:c-string))
:comment (string (cast (slot result 'pw-comment) c-call:c-string))
: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)))))))
#+(or FreeBSD NetBSD darwin)
(defun unix-getpwuid (uid)
"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
(declare (type unix-uid uid))
(let ((result
(alien-funcall
(extern-alien "getpwuid"
(function (* (struct passwd))
c-call:unsigned-int))
uid)))
(when (not (zerop (sap-int (alien-sap result))))
(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))))))
#+solaris
(eval-when (:compile-toplevel :load-toplevel :execute)
;; sysconf(_SC_GETGR_R_SIZE_MAX)
(defconstant +sc-getgr-r-size-max+ 7296
"The maximum size of the group entry buffer"))
#+solaris
(defun unix-getgrnam (name)
"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
(declare (type simple-string name))
(with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
(group-info (struct group)))
(let ((result
(alien-funcall
(extern-alien "getgrnam_r"
(function (* (struct group))
c-call:c-string
(* (struct group))
(* c-call:char)
c-call:unsigned-int))
name
(addr group-info)
(cast buf (* c-call:char))
#.+sc-getgr-r-size-max+)))
(unless (zerop (sap-int (alien-sap result)))
(make-group-info
:name (string (cast (slot result 'gr-name) c-call:c-string))
:password (string (cast (slot result 'gr-passwd) c-call:c-string))
:gid (slot result 'gr-gid)
:members (loop :with members = (slot result 'gr-mem)
:for i :from 0
:for member = (deref members i)
:until (zerop (sap-int (alien-sap member)))
:collect (string (cast member c-call:c-string))))))))
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
(defun unix-getgrnam (name)
"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
(declare (type simple-string name))
(let ((result
(alien-funcall
(extern-alien "getgrnam"
(function (* (struct group))
c-call:c-string))
name)))
(unless (zerop (sap-int (alien-sap result)))
(make-group-info
:name (string (cast (slot result 'gr-name) c-call:c-string))
:password (string (cast (slot result 'gr-passwd) c-call:c-string))
:gid (slot result 'gr-gid)
:members (loop :with members = (slot result 'gr-mem)
:for i :from 0
:for member = (deref members i)
:until (zerop (sap-int (alien-sap member)))
:collect (string (cast member c-call:c-string)))))))
#+solaris
(defun unix-getgrgid (gid)
"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
(declare (type unix-gid gid))
(with-alien ((buf (array c-call:char #.+sc-getgr-r-size-max+))
(group-info (struct group)))
(let ((result
(alien-funcall
(extern-alien "getgrgid_r"
(function (* (struct group))
c-call:unsigned-int
(* (struct group))
(* c-call:char)
c-call:unsigned-int))
#.+sc-getgr-r-size-max+)))
(unless (zerop (sap-int (alien-sap result)))
(make-group-info
:name (string (cast (slot result 'gr-name) c-call:c-string))
:password (string (cast (slot result 'gr-passwd) c-call:c-string))
:gid (slot result 'gr-gid)
:members (loop :with members = (slot result 'gr-mem)
:for i :from 0
:for member = (deref members i)
:until (zerop (sap-int (alien-sap member)))
:collect (string (cast member c-call:c-string))))))))
(defun unix-getgrgid (gid)
"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
(declare (type unix-gid gid))
(let ((result
(alien-funcall
(extern-alien "getgrgid"
(function (* (struct group))
c-call:unsigned-int))
gid)))
(unless (zerop (sap-int (alien-sap result)))
(make-group-info
:name (string (cast (slot result 'gr-name) c-call:c-string))
:password (string (cast (slot result 'gr-passwd) c-call:c-string))
:gid (slot result 'gr-gid)
:members (loop :with members = (slot result 'gr-mem)
:for i :from 0
:for member = (deref members i)
:until (zerop (sap-int (alien-sap member)))
:collect (string (cast member c-call:c-string)))))))
#+solaris
(defun unix-setpwent ()
(void-syscall ("setpwent")))
#+solaris
(defun unix-endpwent ()
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
#+solaris
(defun unix-getpwent ()
(with-alien ((buf (array c-call:char 1024))
(user-info (struct passwd)))
(let ((result
(alien-funcall
(extern-alien "getpwent_r"
(function (* (struct passwd))
(* (struct passwd))
(* c-call:char)
c-call:unsigned-int))
(addr user-info)
(cast buf (* c-call:char))
1024)))
(when (not (zerop (sap-int (alien-sap result))))
(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)
:age (string (cast (slot result 'pw-age) c-call:c-string))
:comment (string (cast (slot result 'pw-comment) c-call:c-string))
:gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
:dir (string (cast (slot result 'pw-dir) c-call:c-string))
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
:shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
;; From sys/utsname.h
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +sys-namelen+
#+solaris 257
#+darwin 256))
(def-alien-type nil
(struct utsname
(sysname (array char #.+sys-namelen+))
(nodename (array char #.+sys-namelen+))
(release (array char #.+sys-namelen+))
(version (array char #.+sys-namelen+))
(machine (array char #.+sys-namelen+))))
(defun unix-uname ()
(with-alien ((names (struct utsname)))
(let ((result
(alien-funcall
(extern-alien "uname"
(function int
(* (struct utsname))))
(addr names))))
(when (>= result 0)
(values (cast (slot names 'sysname) c-string)
(cast (slot names 'nodename) c-string)
(cast (slot names 'release) c-string)
(cast (slot names 'version) c-string)
(cast (slot names 'machine) c-string))))))