Newer
Older
(sockaddr (* t))
(len (* unsigned)))
(def-alien-routine ("getsockname" unix-getsockname) int
(socket int)
(sockaddr (* t))
(len (* unsigned)))
(def-alien-routine ("getsockopt" unix-getsockopt) int
(socket int)
(level int)
(optname int)
(optval (* t))
(optlen unsigned :in-out))
(def-alien-routine ("setsockopt" unix-setsockopt) int
(socket int)
(level int)
(optname int)
(optval (* t))
(optlen unsigned))
;; Datagram support
(defun unix-recvfrom (fd buffer length flags sockaddr len)
(with-alien ((l c-call:int len))
(values
(alien-funcall (extern-alien "recvfrom"
(function c-call:int
c-call:int
system-area-pointer
c-call:int
c-call:int
(* t)
(* c-call:int)))
fd
(system:vector-sap buffer)
length
flags
sockaddr
(addr l))
l)))
#-unicode
(def-alien-routine ("sendto" unix-sendto) int
(fd int)
(buffer c-string)
(length int)
(flags int)
(sockaddr (* t))
(len int))
(defun unix-sendto (fd buffer length flags sockaddr len)
(alien-funcall (extern-alien "sendto"
(function c-call:int
c-call:int
system-area-pointer
c-call:int
c-call:int
(* t)
c-call:int))
fd
(system:vector-sap buffer)
length
flags
sockaddr
len))
(def-alien-routine ("shutdown" unix-shutdown) int
(socket int)
(level int))
;;;
;;; Support for the Interval Timer (experimental)
;;;
(defconstant ITIMER-REAL 0)
(defconstant ITIMER-VIRTUAL 1)
(defconstant ITIMER-PROF 2)
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
"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)
3106
3107
3108
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
" 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))))))
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
;;;; 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)))))))
(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)
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
: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)))))))
(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))))))))
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
(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 ()
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
#+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))
:shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
(def-alien-type nil
(struct utsname
(sysname (array char #+svr4 257 #+bsd 256))
(nodename (array char #+svr4 257 #+bsd 256))
(release (array char #+svr4 257 #+bsd 256))
(version (array char #+svr4 257 #+bsd 256))
(machine (array char #+svr4 257 #+bsd 256))))
(defun unix-uname ()
(with-alien ((names (struct utsname)))
(syscall* (#-freebsd "uname"
#+freebsd "__xuname" #+freebsd int
(* (struct utsname)))
(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))
#+freebsd 256
(addr names))))
#+(and solaris svr4)
(export '(unix-sysinfo
si-sysname si-hostname si-release si-version si-machine
si-architecture si-hw-serial si-hw-provider si-srpc-domain
si-platform si-isalist si-dhcp-cache))
#+(and solaris svr4)
(progn
;; From sys/systeminfo.h. We don't list the set values here.
(def-enum + 1
si-sysname si-hostname si-release si-version si-machine
si-architecture si-hw-serial si-hw-provider si-srpc-domain)
(def-enum + 513
si-platform si-isalist si-dhcp-cache)
;; Hope a buffer of length 2048 is long enough.
(with-alien ((buf (array c-call:unsigned-char 2048)))
(let ((result
(alien-funcall
(extern-alien "sysinfo"
(function c-call:int
c-call:int
c-call:c-string
c-call:int))
command
(cast buf (* c-call:char))
2048)))
(when (>= result 0)
(cast buf c-call:c-string)))))
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
#+solaris
(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core rlimit_nofile
rlimit_vmem rlimit_as))
#+solaris
(progn
(defconstant rlimit_cpu 0
"CPU time per process (in milliseconds)")
(defconstant rlimit_fsize 1
"Maximum file size")
(defconstant rlimit_data 2
"Data segment size")
(defconstant rlimit_stack 3
"Stack size")
(defconstant rlimit_core 4
"Core file size")
(defconstant rlimit_nofile 5
"Number of open files")
(defconstant rlimit_vmem 6
"Maximum mapped memory")
(defconstant rlimit_as rlimit_vmem)
)
#+(and darwin x86)
(export '(rlimit_cpu rlimit_fsize rlimit_data rlimit_stack rlimit_core
rlimit_as rlimit_rss rlimit_memlock rlimit_nproc rlimit_nofile))
#+(and darwin x86)
(progn
(defconstant rlimit_cpu 0
"CPU time per process")
(defconstant rlimit_fsize 1
"File size")
(defconstant rlimit_data 2
"Data segment size")
(defconstant rlimit_stack 3
"Stack size")
(defconstant rlimit_core 4
"Core file size")
(defconstant rlimit_as 5
"Addess space (resident set size)")
(defconstant rlimit_rss rlimit_as)
(defconstant rlimit_memlock 6
"Locked-in-memory address space")
(defconstant rlimit_nproc 7
"Number of processes")
(defconstant rlimit_nofile 8
"Number of open files")
)
#+(or solaris (and darwin x86))
(export '(unix-getrlimit))
#+(or solaris (and darwin x86))
(defun unix-getrlimit (resource)
"Get the limits on the consumption of system resouce specified by
Resource. If successful, return three values: T, the current (soft)
limit, and the maximum (hard) limit."
(with-alien ((rlimit (struct rlimit)))
(syscall ("getrlimit" c-call:int (* (struct rlimit)))
(values t
(slot rlimit 'rlim-cur)
(slot rlimit 'rlim-max))
resource (addr rlimit))))