src/syscalls/ffi-functions-unix.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- *UNIX foreign function definitions.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 (eval-when (:compile-toplevel)
   9   (declaim (optimize (speed 3) (safety 1) (debug 1))))
  10
  11 ;; FIXME: move this into an ASDF operation
  12 (eval-when (:compile-toplevel :load-toplevel :execute)
  13   (define-foreign-library libfixposix
  14     (t (:default "libfixposix")))
  15   (use-foreign-library libfixposix))
  16
  17 \f
  18
  19 ;;;-------------------------------------------------------------------------
  20 ;;; ERRNO-related functions
  21 ;;;-------------------------------------------------------------------------
  22
  23 (defcfun (errno "lfp_errno") :int)
  24
  25 (defun (setf errno) (value)
  26   (foreign-funcall "lfp_set_errno" :int value :int))
  27
  28 (defsyscall (%strerror "lfp_strerror")
  29     :int
  30   (errnum :int)
  31   (buf    :pointer)
  32   (buflen size-t))
  33
  34 (defentrypoint strerror (&optional (err (errno)))
  35   "Look up the error message string for ERRNO (reentrant)."
  36   (let ((errno
  37          (if (keywordp err)
  38              (foreign-enum-value 'errno-values err)
  39              err)))
  40     (with-foreign-pointer-as-string ((buf bufsiz) 1024)
  41       (%strerror errno buf bufsiz))))
  42
  43 (defmethod print-object ((e syscall-error) s)
  44   (with-slots (syscall code identifier message handle handle2) e
  45     (print-unreadable-object (e s :type nil :identity nil)
  46       (cond
  47         (message
  48          (format s "~A" message))
  49         (t
  50          (format s "Syscall ~S signalled error ~A(~S) ~S"
  51                  syscall identifier (or code "[No code]")
  52                  (or (strerror code) "[Can't get error string.]"))
  53          (when handle (format s " FD=~A" handle))
  54          (when handle2 (format s " FD2=~A" handle2)))))))
  55 \f
  56
  57 ;;;-------------------------------------------------------------------------
  58 ;;; Memory manipulation
  59 ;;;-------------------------------------------------------------------------
  60
  61 (defcfun (memset "memset") :pointer
  62   "Fill the first COUNT bytes of BUFFER with the constant VALUE."
  63   (buffer :pointer)
  64   (value  :int)
  65   (count  size-t))
  66
  67 (defentrypoint bzero (buffer count)
  68   "Fill the first COUNT bytes of BUFFER with zeros."
  69   (memset buffer 0 count))
  70
  71 (defcfun (memcpy "memcpy") :pointer
  72   "Copy COUNT octets from SRC to DEST.
  73 The two memory areas must not overlap."
  74   (dest :pointer)
  75   (src  :pointer)
  76   (count size-t))
  77
  78 (defcfun (memmove "memmove") :pointer
  79   "Copy COUNT octets from SRC to DEST.
  80 The two memory areas may overlap."
  81   (dest :pointer)
  82   (src  :pointer)
  83   (count size-t))
  84 \f
  85
  86 ;;;-------------------------------------------------------------------------
  87 ;;; Files
  88 ;;;-------------------------------------------------------------------------
  89
  90 (defsyscall (%open "lfp_open")
  91     (:int :restart t)
  92   (path  sstring)
  93   (flags :uint64)
  94   (mode  mode-t))
  95
  96 (defentrypoint open (path flags &optional (mode #o666))
  97   "Open a file descriptor for PATH using FLAGS and permissions MODE(#o666 by default)."
  98   (%open path flags mode))
  99
 100 (defsyscall (creat "lfp_creat")
 101     (:int :restart t)
 102   "Create file PATH with permissions MODE and return the new FD."
 103   (path sstring)
 104   (mode mode-t))
 105
 106 (defsyscall (%pipe "pipe") :int
 107   (fds :pointer))
 108
 109 (defentrypoint pipe ()
 110   "Create pipe, returns two values with the new FDs."
 111   (with-foreign-object (fds :int 2)
 112     (%pipe fds)
 113     (values (mem-aref fds :int 0)
 114             (mem-aref fds :int 1))))
 115
 116 (defsyscall (mkfifo "mkfifo") :int
 117   "Create a FIFO (named pipe) with name PATH and permissions MODE."
 118   (path sstring)
 119   (mode mode-t))
 120
 121 (defsyscall (umask "umask") mode-t
 122   "Sets the umask to NEW-MODE and returns the old one."
 123   (new-mode mode-t))
 124
 125 (defsyscall (lseek "lfp_lseek")
 126     (off-t :handle fd)
 127   "Reposition the offset of the open file associated with the file descriptor FD
 128 to the argument OFFSET according to the directive WHENCE."
 129   (fd     :int)
 130   (offset off-t)
 131   (whence :int))
 132
 133 (defsyscall (access "access") :int
 134   "Check whether the file PATH can be accessed using mode MODE."
 135   (path sstring)
 136   (mode :int))
 137
 138 (defsyscall (truncate "lfp_truncate")
 139     (:int :restart t)
 140   "Truncate the file PATH to a size of precisely LENGTH octets."
 141   (path   sstring)
 142   (length off-t))
 143
 144 (defsyscall (ftruncate "lfp_ftruncate")
 145     (:int :restart t :handle fd)
 146   "Truncate the file referenced by FD to a size of precisely LENGTH octets."
 147   (fd     :int)
 148   (length off-t))
 149
 150 (defsyscall (rename "rename") :int
 151   "Rename file named by OLDPATH to NEWPATH."
 152   (oldpath sstring)
 153   (newpath sstring))
 154
 155 (defsyscall (link "link") :int
 156   "Create a hard link from file OLDPATH to NEWPATH."
 157   (oldpath sstring)
 158   (newpath sstring))
 159
 160 (defsyscall (symlink "symlink") :int
 161   "Create a symbolic link from file OLDPATH to NEWPATH."
 162   (oldpath sstring)
 163   (newpath sstring))
 164
 165 (defsyscall (%readlink "readlink") ssize-t
 166   (path    sstring)
 167   (buf     :pointer)
 168   (bufsize size-t))
 169
 170 (defentrypoint readlink (path)
 171   "Read the file name pointed by the symbolic link PATH."
 172   (with-foreign-pointer (buf +cstring-path-max+ bufsize)
 173     (let ((count (%readlink path buf bufsize)))
 174       (cstring-to-sstring buf count))))
 175
 176 (defsyscall (%realpath "realpath") sstring
 177   (path          sstring)
 178   (resolved-path :pointer))
 179
 180 (defentrypoint realpath (path)
 181   "Read the file name pointed by the symbolic link PATH."
 182   (with-foreign-pointer (buf +cstring-path-max+)
 183     (%realpath path buf)))
 184
 185 (defsyscall (unlink "unlink") :int
 186   "Delete the file PATH from the file system."
 187   (path sstring))
 188
 189 (defsyscall (chown "chown")
 190     (:int :restart t)
 191   "Change ownership of file PATH to uid OWNER and gid GROUP(dereferences symlinks)."
 192   (path  sstring)
 193   (owner uid-t)
 194   (group uid-t))
 195
 196 (defsyscall (fchown "fchown")
 197     (:int :restart t :handle fd)
 198   "Change ownership of an open file referenced by FD to uid OWNER and gid GROUP."
 199   (fd    :int)
 200   (owner uid-t)
 201   (group uid-t))
 202
 203 (defsyscall (lchown "lchown")
 204     (:int :restart t)
 205   "Change ownership of a file PATH to uid OWNER and gid GROUP(does not dereference symlinks)."
 206   (path  sstring)
 207   (owner uid-t)
 208   (group uid-t))
 209
 210 (defsyscall (chmod "chmod")
 211     (:int :restart t)
 212   "Change permissions of file PATH to mode MODE."
 213   (path sstring)
 214   (mode mode-t))
 215
 216 (defsyscall (fchmod "fchmod")
 217     (:int :restart t :handle fd)
 218   "Change permissions of open file referenced by FD to mode MODE."
 219   (fd   :int)
 220   (mode mode-t))
 221 \f
 222
 223 ;;;-------------------------------------------------------------------------
 224 ;;; I/O
 225 ;;;-------------------------------------------------------------------------
 226
 227 (defsyscall (read "read")
 228     (ssize-t :restart t :handle fd)
 229   "Read at most COUNT bytes from FD into the foreign area BUF."
 230   (fd    :int)
 231   (buf   :pointer)
 232   (count size-t))
 233
 234 (defsyscall (write "write")
 235     (ssize-t :restart t :handle fd)
 236   "Write at most COUNT bytes to FD from the foreign area BUF."
 237   (fd    :int)
 238   (buf   :pointer)
 239   (count size-t))
 240
 241 (defsyscall (readv "readv")
 242     (ssize-t :restart t :handle fd)
 243   "Read from FD into the first IOVCNT buffers of the IOV array."
 244   (fd     :int)
 245   (iov    :pointer)
 246   (iovcnt :int))
 247
 248 (defsyscall (writev "writev")
 249     (ssize-t :restart t :handle fd)
 250   "Writes to FD the first IOVCNT buffers of the IOV array."
 251   (fd     :int)
 252   (iov    :pointer)
 253   (iovcnt :int))
 254
 255 (defsyscall (pread "lfp_pread")
 256     (ssize-t :restart t :handle fd)
 257   "Read at most COUNT bytes from FD at offset OFFSET into the foreign area BUF."
 258   (fd     :int)
 259   (buf    :pointer)
 260   (count  size-t)
 261   (offset off-t))
 262
 263 (defsyscall (pwrite "lfp_pwrite")
 264     (ssize-t :restart t :handle fd)
 265   "Write at most COUNT bytes to FD at offset OFFSET from the foreign area BUF."
 266   (fd     :int)
 267   (buf    :pointer)
 268   (count  size-t)
 269   (offset off-t))
 270
 271 (defsyscall (sendfile "lfp_sendfile")
 272     (ssize-t :restart t :handle infd :handle2 outfd)
 273   (infd   :int)
 274   (outfd  :int)
 275   (offset off-t)
 276   (nbytes size-t))
 277 \f
 278
 279 ;;;-------------------------------------------------------------------------
 280 ;;; Stat()
 281 ;;;-------------------------------------------------------------------------
 282
 283 (define-c-struct-wrapper stat ())
 284
 285 (defsyscall (%stat "lfp_stat")
 286     :int
 287   (file-name sstring)
 288   (buf       :pointer))
 289
 290 (defsyscall (%fstat "lfp_fstat")
 291     (:int :handle fd)
 292   (fd      :int)
 293   (buf     :pointer))
 294
 295 (defsyscall (%lstat "lfp_lstat")
 296     :int
 297   (file-name sstring)
 298   (buf       :pointer))
 299
 300 ;;; If necessary for performance reasons, we can add an optional
 301 ;;; argument to this function and use that to reuse a wrapper object.
 302 (defentrypoint funcall-stat (fn arg)
 303   (with-foreign-object (buf 'stat)
 304     (funcall fn arg buf)
 305     (make-instance 'stat :pointer buf)))
 306
 307 (defentrypoint stat (path)
 308   "Get information about file PATH(dereferences symlinks)."
 309   (funcall-stat #'%stat path))
 310
 311 (defentrypoint fstat (fd)
 312   "Get information about file descriptor FD."
 313   (funcall-stat #'%fstat fd))
 314
 315 (defentrypoint lstat (path)
 316   "Get information about file PATH(does not dereference symlinks)."
 317   (funcall-stat #'%lstat path))
 318
 319 (defsyscall (sync "sync") :void
 320   "Schedule all file system buffers to be written to disk.")
 321
 322 (defsyscall (fsync "fsync")
 323     (:int :restart t)
 324   "Schedule a file's buffers to be written to disk."
 325   (fd :int))
 326
 327 (defsyscall (%mkstemp "lfp_mkstemp") :int
 328   (template :pointer))
 329
 330 (defentrypoint mkstemp (&optional (template ""))
 331   "Generate a unique temporary filename from TEMPLATE.
 332 Return two values: the file descriptor and the path of the temporary file."
 333   (let ((template (concatenate 'string template "XXXXXX")))
 334     (with-sstring-to-cstring (ptr template)
 335       (values (%mkstemp ptr) (cstring-to-sstring ptr)))))
 336 \f
 337
 338 ;;;-------------------------------------------------------------------------
 339 ;;; Directories
 340 ;;;-------------------------------------------------------------------------
 341
 342 (defsyscall (mkdir "mkdir") :int
 343   "Create directory PATH with permissions MODE."
 344   (path sstring)
 345   (mode mode-t))
 346
 347 (defsyscall (rmdir "rmdir") :int
 348   "Delete directory PATH."
 349   (path sstring))
 350
 351 (defsyscall (chdir "chdir") :int
 352   "Change the current working directory to PATH."
 353   (path sstring))
 354
 355 (defsyscall (fchdir "fchdir")
 356     (:int :restart t :handle fd)
 357   "Change the current working directory to the directory referenced by FD."
 358   (fd :int))
 359
 360 (defsyscall (%getcwd "getcwd") :pointer
 361   (buf :pointer)
 362   (size size-t))
 363
 364 (defentrypoint getcwd ()
 365   "Return the current working directory as a string."
 366   (with-cstring-to-sstring (buf +cstring-path-max+ bufsize)
 367     (%getcwd buf bufsize)))
 368
 369 (defsyscall (%mkdtemp "mkdtemp") sstring
 370   (template sstring))
 371
 372 (defentrypoint mkdtemp (&optional (template ""))
 373   "Generate a unique temporary filename from TEMPLATE."
 374   (let ((template (concatenate 'string template "XXXXXX")))
 375     (%mkdtemp template)))
 376 \f
 377
 378 ;;;-------------------------------------------------------------------------
 379 ;;; File Descriptors
 380 ;;;-------------------------------------------------------------------------
 381
 382 (defsyscall (close "close")
 383     (:int :handle fd)
 384   "Close open file descriptor FD."
 385   (fd :int))
 386
 387 (defsyscall (dup "dup")
 388     (:int :handle fd)
 389   "Duplicate file descriptor FD."
 390   (fd :int))
 391
 392 (defsyscall (dup2 "dup2")
 393     (:int :restart t :handle oldfd :handle2 newfd)
 394   "Make NEWFD be the copy of OLDFD, closing NEWFD first if necessary."
 395   (oldfd :int)
 396   (newfd :int))
 397
 398 (defsyscall (%fcntl/noarg "fcntl")
 399     (:int :handle fd)
 400   (fd  :int)
 401   (cmd :int))
 402
 403 ;;; FIXME: Linux/glibc says ARG's type is long, POSIX says it's int.
 404 ;;; Is this an issue?
 405 (defsyscall (%fcntl/int "fcntl")
 406     (:int :handle fd)
 407   (fd  :int)
 408   (cmd :int)
 409   (arg :int))
 410
 411 (defsyscall (%fcntl/pointer "fcntl")
 412     (:int :handle fd)
 413   (fd  :int)
 414   (cmd :int)
 415   (arg :pointer))
 416
 417 (defentrypoint fcntl (fd cmd &optional (arg nil argp))
 418   (cond
 419     ((not argp)     (%fcntl/noarg   fd cmd))
 420     ((integerp arg) (%fcntl/int     fd cmd arg))
 421     ((pointerp arg) (%fcntl/pointer fd cmd arg))
 422     (t (error 'type-error :datum arg
 423               :expected-type '(or null integer foreign-pointer)))))
 424
 425 (defsyscall (%ioctl/noarg "ioctl")
 426     (:int :handle fd)
 427   "Send request REQUEST to file referenced by FD."
 428   (fd      :int)
 429   (request :unsigned-int))
 430
 431 (defsyscall (%ioctl/pointer "ioctl")
 432     (:int :handle fd)
 433   "Send request REQUEST to file referenced by FD using argument ARG."
 434  (fd      :int)
 435  (request :unsigned-int)
 436  (arg     :pointer))
 437
 438 (defentrypoint ioctl (fd request &optional (arg nil argp))
 439   "Control an I/O device."
 440   (cond
 441     ((not argp)     (%ioctl/noarg   fd request))
 442     ((pointerp arg) (%ioctl/pointer fd request arg))
 443     (t (error 'type-error :datum arg
 444               :expected-type '(or null foreign-pointer)))))
 445
 446 (defsyscall (fd-cloexec-p "lfp_is_fd_cloexec") bool-designator
 447   (fd :int))
 448
 449 (defsyscall (%set-fd-cloexec "lfp_set_fd_cloexec") :int
 450   (fd      :int)
 451   (enabled bool-designator))
 452
 453 (defentrypoint (setf fd-cloexec-p) (enabled fd)
 454   (%set-fd-cloexec fd enabled))
 455
 456 (defsyscall (fd-nonblock-p "lfp_is_fd_nonblock") bool-designator
 457   (fd :int))
 458
 459 (defsyscall (%set-fd-nonblock "lfp_set_fd_nonblock") :int
 460   (fd      :int)
 461   (enabled bool-designator))
 462
 463 (defentrypoint (setf fd-nonblock-p) (enabled fd)
 464   (%set-fd-nonblock fd enabled))
 465
 466 (defsyscall (fd-open-p "lfp_is_fd_open") bool-designator
 467   (fd :int))
 468 \f
 469
 470 ;;;-------------------------------------------------------------------------
 471 ;;; TTYs
 472 ;;;-------------------------------------------------------------------------
 473
 474 (defsyscall (openpt "lfp_openpt") :int
 475   (flags :uint64))
 476
 477 (defsyscall (grantpt "grantpt")
 478     (:int :handle fd)
 479   (fd :int))
 480
 481 (defsyscall (unlockpt "unlockpt")
 482     (:int :handle fd)
 483   (fd :int))
 484
 485 (defsyscall (%ptsname "lfp_ptsname")
 486     (:int :handle fd)
 487   (fd     :int)
 488   (buf    :pointer)
 489   (buflen size-t))
 490
 491 (defentrypoint ptsname (fd)
 492   (with-foreign-pointer (buf +cstring-path-max+ bufsize)
 493     (%ptsname fd buf bufsize)
 494     (nth-value 0 (foreign-string-to-lisp buf))))
 495 \f
 496
 497 ;;;-------------------------------------------------------------------------
 498 ;;; I/O polling
 499 ;;;-------------------------------------------------------------------------
 500
 501 (defsyscall (select "lfp_select") :int
 502   "Scan for I/O activity on multiple file descriptors."
 503   (nfds      :int)
 504   (readfds   :pointer)
 505   (writefds  :pointer)
 506   (exceptfds :pointer)
 507   (timeout   :pointer))
 508
 509 (defentrypoint copy-fd-set (from to)
 510   (memcpy to from (sizeof 'fd-set))
 511   to)
 512
 513 (defcfun (fd-clr "lfp_fd_clr") :void
 514   (fd     :int)
 515   (fd-set :pointer))
 516
 517 (defcfun (fd-isset "lfp_fd_isset") bool
 518   (fd     :int)
 519   (fd-set :pointer))
 520
 521 (defcfun (fd-set "lfp_fd_set") :void
 522   (fd     :int)
 523   (fd-set :pointer))
 524
 525 (defcfun (fd-zero "lfp_fd_zero") :void
 526   (fd-set :pointer))
 527
 528 ;;; FIXME: Until a way to autodetect platform features is implemented
 529 (eval-when (:compile-toplevel :load-toplevel :execute)
 530   (unless (boundp 'pollrdhup)
 531     (defconstant pollrdhup 0)))
 532
 533 (defsyscall (poll "poll") :int
 534   "Scan for I/O activity on multiple file descriptors."
 535   (fds     :pointer)
 536   (nfds    nfds-t)
 537   (timeout :int))
 538
 539 #+linux
 540 (progn
 541   (defsyscall (epoll-create "epoll_create") :int
 542     "Open an epoll file descriptor."
 543     (size :int))
 544
 545   (defsyscall (epoll-ctl "epoll_ctl")
 546       (:int :handle epfd :handle2 fd)
 547     "Control interface for an epoll descriptor."
 548     (epfd  :int)
 549     (op    :int)
 550     (fd    :int)
 551     (event :pointer))
 552
 553   (defsyscall (epoll-wait "epoll_wait")
 554       (:int :handle epfd)
 555     "Wait for an I/O event on an epoll file descriptor."
 556     (epfd      :int)
 557     (events    :pointer)
 558     (maxevents :int)
 559     (timeout   :int)))
 560
 561 #+bsd
 562 (progn
 563   (defsyscall (kqueue "kqueue") :int
 564     "Open a kernel event queue.")
 565
 566   (defsyscall (kevent "kevent")
 567       (:int :handle fd)
 568     "Control interface for a kernel event queue."
 569     (fd         :int)
 570     (changelist :pointer)               ; const struct kevent *
 571     (nchanges   :int)
 572     (eventlist  :pointer)               ; struct kevent *
 573     (nevents    :int)
 574     (timeout    :pointer))              ; const struct timespec *
 575
 576   (defentrypoint ev-set (%kev %ident %filter %flags %fflags %data %udata)
 577     (with-foreign-slots ((ident filter flags fflags data udata) %kev kevent)
 578       (setf ident %ident filter %filter flags %flags
 579             fflags %fflags data %data udata %udata))))
 580 \f
 581
 582 ;;;-------------------------------------------------------------------------
 583 ;;; Socket message readers
 584 ;;;-------------------------------------------------------------------------
 585
 586 (defcfun (cmsg.firsthdr "lfp_cmsg_firsthdr") :pointer
 587   (msgh :pointer))
 588
 589 (defcfun (cmsg.nxthdr "lfp_cmsg_nxthdr") :pointer
 590   (msgh :pointer)
 591   (cmsg :pointer))
 592
 593 (defcfun (cmsg.space "lfp_cmsg_space") size-t
 594   (length size-t))
 595
 596 (defcfun (cmsg.len "lfp_cmsg_len") size-t
 597   (length size-t))
 598
 599 (defcfun (cmsg.data "lfp_cmsg_data") :pointer
 600   (cmsg :pointer))
 601 \f
 602
 603 ;;;-------------------------------------------------------------------------
 604 ;;; Directory walking
 605 ;;;-------------------------------------------------------------------------
 606
 607 (defsyscall (opendir "opendir") :pointer
 608   "Open directory PATH for listing of its contents."
 609   (path sstring))
 610
 611 (defsyscall (closedir "closedir") :int
 612   "Close directory DIR when done listing its contents."
 613   (dirp :pointer))
 614
 615 (defsyscall (%readdir "lfp_readdir") :int
 616   (dirp   :pointer)
 617   (entry  :pointer)
 618   (result :pointer))
 619
 620 (defentrypoint readdir (dir)
 621   "Reads an item from the listing of directory DIR (reentrant)."
 622   (with-foreign-objects ((entry 'dirent) (result :pointer))
 623     (%readdir dir entry result)
 624     (if (null-pointer-p (mem-ref result :pointer))
 625         nil
 626         (with-foreign-slots ((name type fileno) entry dirent)
 627           (values (cstring-to-sstring name) type fileno)))))
 628
 629 (defsyscall (rewinddir "rewinddir") :void
 630   "Rewind directory DIR."
 631   (dirp :pointer))
 632
 633 (defsyscall (seekdir "seekdir") :void
 634   "Seek into directory DIR to position POS(as returned by TELLDIR)."
 635   (dirp :pointer)
 636   (pos  :long))
 637
 638 ;;; FIXME: According to POSIX docs "no errors are defined" for
 639 ;;; telldir() but Linux manpages specify a possible EBADF.
 640 (defsyscall (telldir "telldir") off-t
 641   "Return the current location in directory DIR."
 642   (dirp :pointer))
 643 \f
 644
 645 ;;;-------------------------------------------------------------------------
 646 ;;; Memory mapping
 647 ;;;-------------------------------------------------------------------------
 648
 649 (defsyscall (mmap "lfp_mmap")
 650     (:pointer :handle fd)
 651   "Map file referenced by FD at offset OFFSET into address space of the
 652 calling process at address ADDR and length LENGTH.
 653 PROT describes the desired memory protection of the mapping.
 654 FLAGS determines whether updates to the mapping are visible to other
 655 processes mapping the same region."
 656   (addr   :pointer)
 657   (length size-t)
 658   (prot   :int)
 659   (flags  :int)
 660   (fd     :int)
 661   (offset off-t))
 662
 663 (defsyscall (munmap "munmap") :int
 664   "Unmap pages of memory starting at address ADDR with length LENGTH."
 665   (addr   :pointer)
 666   (length size-t))
 667 \f
 668
 669 ;;;-------------------------------------------------------------------------
 670 ;;; Process creation and info
 671 ;;;-------------------------------------------------------------------------
 672
 673 (defsyscall (fork "fork") pid-t)
 674
 675 (defsyscall (execv "execv") :int
 676   (path sstring)
 677   (argv :pointer))
 678
 679 (defsyscall (%waitpid "waitpid") pid-t
 680   (pid     pid-t)
 681   (status  :pointer)
 682   (options :int))
 683
 684 (defentrypoint waitpid (pid options)
 685   (with-foreign-pointer (status (sizeof :int))
 686     (let ((ret (%waitpid pid status options)))
 687       (values ret (mem-ref status :int)))))
 688
 689 (defsyscall (getpid "getpid") pid-t
 690   "Returns the process id of the current process")
 691
 692 (defsyscall (getppid "getppid") pid-t
 693   "Returns the process id of the current process's parent")
 694
 695 #+linux
 696 (defentrypoint gettid ()
 697   (foreign-funcall "syscall" :int sys-gettid :int))
 698
 699 (defsyscall (getuid "getuid") uid-t
 700   "Get real user id of the current process.")
 701
 702 (defsyscall (setuid "setuid") :int
 703   "Set real user id of the current process to UID."
 704   (uid uid-t))
 705
 706 (defsyscall (geteuid "geteuid") uid-t
 707   "Get effective user id of the current process.")
 708
 709 (defsyscall (seteuid "seteuid") :int
 710   "Set effective user id of the current process to UID."
 711   (uid uid-t))
 712
 713 (defsyscall (getgid "getgid") gid-t
 714   "Get real group id of the current process.")
 715
 716 (defsyscall (setgid "setgid") :int
 717   "Set real group id of the current process to GID."
 718   (gid gid-t))
 719
 720 (defsyscall (getegid "getegid") gid-t
 721   "Get effective group id of the current process.")
 722
 723 (defsyscall (setegid "setegid") :int
 724   "Set effective group id of the current process to GID."
 725   (gid gid-t))
 726
 727 (defsyscall (setreuid "setreuid") :int
 728   "Set real and effective user id of the current process to RUID and EUID."
 729   (ruid uid-t)
 730   (euid uid-t))
 731
 732 (defsyscall (setregid "setregid") :int
 733   "Set real and effective group id of the current process to RGID and EGID."
 734   (rgid gid-t)
 735   (egid gid-t))
 736
 737 (defsyscall (getpgid "getpgid") pid-t
 738   "Get process group id of process PID."
 739   (pid pid-t))
 740
 741 (defsyscall (setpgid "setpgid") :int
 742   "Set process group id of process PID to value PGID."
 743   (pid  pid-t)
 744   (pgid pid-t))
 745
 746 (defsyscall (getpgrp "getpgrp") pid-t
 747   "Get process group id of the current process.")
 748
 749 (defsyscall (setpgrp "setpgrp") pid-t
 750   "Set process group id of the current process.")
 751
 752 (defsyscall (setsid "setsid") pid-t
 753   "Create session and set process group id of the current process.")
 754
 755 (defsyscall (%getrlimit "lfp_getrlimit")
 756     :int
 757   (resource :int)
 758   (rlimit   :pointer))
 759
 760 (defentrypoint getrlimit (resource)
 761   "Return soft and hard limit of system resource RESOURCE."
 762   (with-foreign-object (rl 'rlimit)
 763     (with-foreign-slots ((cur max) rl rlimit)
 764       (%getrlimit resource rl)
 765       (values cur max))))
 766
 767 (defsyscall (%setrlimit "lfp_setrlimit")
 768     :int
 769   (resource :int)
 770   (rlimit   :pointer))
 771
 772 (defentrypoint setrlimit (resource soft-limit hard-limit)
 773   "Set SOFT-LIMIT and HARD-LIMIT of system resource RESOURCE."
 774   (with-foreign-object (rl 'rlimit)
 775     (with-foreign-slots ((cur max) rl rlimit)
 776       (setf cur soft-limit
 777             max hard-limit)
 778       (%setrlimit resource rl))))
 779
 780 (defsyscall (%getrusage "getrusage") :int
 781   (who   :int)
 782   (usage :pointer))
 783
 784 ;;; TODO: it might be more convenient to return a wrapper object here
 785 ;;; instead like we do in STAT.
 786 (defentrypoint getrusage (who)
 787   "Return resource usage measures of WHO."
 788   (with-foreign-object (ru 'rusage)
 789     (%getrusage who ru)
 790     (with-foreign-slots ((maxrss ixrss idrss isrss minflt majflt nswap inblock
 791                           oublock msgsnd msgrcv nsignals nvcsw nivcsw)
 792                          ru rusage)
 793       (values (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 794                                   'timeval 'sec)
 795               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 796                                   'timeval 'usec)
 797               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 798                                   'timeval 'sec)
 799               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 800                                   'timeval 'usec)
 801               maxrss ixrss idrss isrss minflt majflt
 802               nswap inblock oublock msgsnd
 803               msgrcv nsignals nvcsw nivcsw))))
 804
 805 (defsyscall (getpriority "getpriority") :int
 806   "Get the scheduling priority of a process, process group, or user,
 807 as indicated by WHICH and WHO."
 808   (which :int)
 809   (who   :int))
 810
 811 (defsyscall (setpriority "setpriority") :int
 812   "Set the scheduling priority of a process, process group, or user,
 813 as indicated by WHICH and WHO to VALUE."
 814   (which :int)
 815   (who   :int)
 816   (value :int))
 817
 818 (defentrypoint nice (&optional (increment 0))
 819   "Get or set process priority."
 820   ;; FIXME: race condition. might need WITHOUT-INTERRUPTS on some impl.s
 821   (setf (errno) 0)
 822   (let ((retval (foreign-funcall "nice" :int increment :int))
 823         (errno (errno)))
 824     (if (and (= retval -1) (/= errno 0))
 825         (signal-syscall-error errno "nice")
 826         retval)))
 827
 828 (defsyscall (exit "_exit") :void
 829   "terminate the calling process"
 830   (status :int))
 831
 832 \f
 833
 834 ;;;-------------------------------------------------------------------------
 835 ;;; Signals
 836 ;;;-------------------------------------------------------------------------
 837
 838 (defsyscall (kill "kill") :int
 839   "Send signal SIG to process PID."
 840   (pid    pid-t)
 841   (signum signal))
 842
 843 (defsyscall (sigaction "sigaction") :int
 844   (signum :int)
 845   (act    :pointer)
 846   (oldact :pointer))
 847
 848 (defentrypoint wifexited (status)
 849   (plusp (foreign-funcall "lfp_wifexited" :int status :int)))
 850
 851 (defentrypoint wexitstatus (status)
 852   (foreign-funcall "lfp_wexitstatus" :int status :int))
 853
 854 (defentrypoint wifsignaled (status)
 855   (plusp (foreign-funcall "lfp_wifsignaled" :int status :int)))
 856
 857 (defentrypoint wtermsig (status)
 858   (foreign-funcall "lfp_wtermsig" :int status :int))
 859
 860 (defentrypoint wtermsig* (status)
 861   (foreign-enum-keyword 'signal (wtermsig status)))
 862
 863 (defentrypoint wcoredump (status)
 864   (plusp (foreign-funcall "lfp_wcoredump" :int status :int)))
 865
 866 (defentrypoint wifstopped (status)
 867   (plusp (foreign-funcall "lfp_wifstopped" :int status :int)))
 868
 869 (defentrypoint wstopsig (status)
 870   (foreign-funcall "lfp_wstopsig" :int status :int))
 871
 872 (defentrypoint wifcontinued (status)
 873   (plusp (foreign-funcall "lfp_wifcontinued" :int status :int)))
 874 \f
 875
 876 ;;;-------------------------------------------------------------------------
 877 ;;; Time
 878 ;;;-------------------------------------------------------------------------
 879
 880 (defsyscall (usleep "usleep") :int
 881   "Suspend execution for USECONDS microseconds."
 882   (useconds useconds-t))
 883
 884 (defsyscall (%clock-getres "lfp_clock_getres") :int
 885   "Returns the resolution of the clock CLOCKID."
 886   (clockid clockid-t)
 887   (res     :pointer))
 888
 889 (defentrypoint clock-getres (clock-id)
 890   (with-foreign-object (ts 'timespec)
 891     (with-foreign-slots ((sec nsec) ts timespec)
 892       (%clock-getres clock-id ts)
 893       (values sec nsec))))
 894
 895 (defsyscall (%clock-gettime "lfp_clock_gettime") :int
 896   (clockid clockid-t)
 897   (tp      :pointer))
 898
 899 (defentrypoint clock-gettime (clock-id)
 900   "Returns the time of the clock CLOCKID."
 901   (with-foreign-object (ts 'timespec)
 902     (with-foreign-slots ((sec nsec) ts timespec)
 903       (%clock-gettime clock-id ts)
 904       (values sec nsec))))
 905
 906 (defsyscall (%clock-settime "lfp_clock_settime") :int
 907   (clockid clockid-t)
 908   (tp      :pointer))
 909
 910 (defentrypoint clock-settime (clock-id)
 911   "Sets the time of the clock CLOCKID."
 912   (with-foreign-object (ts 'timespec)
 913     (with-foreign-slots ((sec nsec) ts timespec)
 914       (%clock-settime clock-id ts)
 915       (values sec nsec))))
 916
 917 ;; FIXME: replace it with clock_gettime(CLOCK_MONOTONIC, ...)
 918 (defentrypoint get-monotonic-time ()
 919   "Gets current time in seconds from a system's monotonic clock."
 920   (multiple-value-bind (seconds nanoseconds)
 921       (clock-gettime clock-monotonic)
 922     (+ seconds (/ nanoseconds 1d9))))
 923 \f
 924
 925 ;;;-------------------------------------------------------------------------
 926 ;;; Environment
 927 ;;;-------------------------------------------------------------------------
 928
 929 (defsyscall (os-environ "lfp_get_environ") :pointer
 930   "Return a pointer to the current process environment.")
 931
 932 (defmacro %obsolete-*environ* ()
 933   (iolib.base::signal-obsolete '*environ* "use function OS-ENVIRON instead"
 934                                "symbol macro" :WARN)
 935   `(os-environ))
 936
 937 (define-symbol-macro *environ* (%obsolete-*environ*))
 938
 939 (defentrypoint getenv (name)
 940   "Returns the value of environment variable NAME."
 941   (when (and (pointerp name) (null-pointer-p name))
 942     (setf (errno) einval)
 943     (signal-syscall-error einval "getenv"))
 944   (foreign-funcall "getenv" :string name :string))
 945
 946 (defsyscall (setenv "setenv") :int
 947   "Changes the value of environment variable NAME to VALUE.
 948 The environment variable is overwritten only if overwrite is not NIL."
 949   (name      :string)
 950   (value     :string)
 951   (overwrite bool-designator))
 952
 953 (defsyscall (unsetenv "unsetenv") :int
 954   "Removes the binding of environment variable NAME."
 955   (name :string))
 956
 957 ;; FIXME: move into libfixposix
 958 (defentrypoint clearenv ()
 959   "Remove all name-value pairs from the environment set the
 960 OS environment to NULL."
 961   (let ((envptr (os-environ)))
 962     (unless (null-pointer-p envptr)
 963       (loop :for i :from 0 :by 1
 964             :for string := (mem-aref envptr :string i)
 965             :for name := (subseq string 0 (position #\= string))
 966             :while name :do (unsetenv name))
 967       (setf (mem-ref envptr :pointer) (null-pointer)))
 968     (values)))
 969 \f
 970
 971 ;;;-------------------------------------------------------------------------
 972 ;;; Hostname info
 973 ;;;-------------------------------------------------------------------------
 974
 975 (defsyscall (%gethostname "gethostname") :int
 976   (name    :pointer)
 977   (namelen size-t))
 978
 979 (defentrypoint gethostname ()
 980   "Return the host name of the current machine."
 981   (with-foreign-pointer-as-string ((cstr size) 256)
 982     (%gethostname cstr size)))
 983
 984 (defsyscall (%getdomainname "getdomainname") :int
 985   (name    :pointer)
 986   (namelen size-t))
 987
 988 (defentrypoint getdomainname ()
 989   "Return the domain name of the current machine."
 990   (with-foreign-pointer-as-string ((cstr size) 256)
 991     (%getdomainname cstr size)))
 992
 993 (defsyscall (%uname "uname") :int
 994   (buf :pointer))
 995
 996 (defentrypoint uname ()
 997   "Get name and information about current kernel."
 998   (with-foreign-object (buf 'utsname)
 999     (bzero buf (sizeof 'utsname))
1000     (%uname buf)
1001     (macrolet ((utsname-slot (name)
1002                  `(foreign-string-to-lisp
1003                    (foreign-slot-pointer buf 'utsname ',name))))
1004       (values (utsname-slot sysname)
1005               (utsname-slot nodename)
1006               (utsname-slot release)
1007               (utsname-slot version)
1008               (utsname-slot machine)))))
1009 \f
1010
1011 ;;;-------------------------------------------------------------------------
1012 ;;; User info
1013 ;;;-------------------------------------------------------------------------
1014
1015 (defsyscall (%getpwuid-r "getpwuid_r")
1016     (:int
1017      :error-predicate plusp
1018      :error-location :return)
1019   (uid     uid-t)
1020   (pwd     :pointer)
1021   (buffer  :pointer)
1022   (bufsize size-t)
1023   (result  :pointer))
1024
1025 (defsyscall (%getpwnam-r "getpwnam_r")
1026     (:int
1027      :error-predicate plusp
1028      :error-location :return)
1029   (name    :string)
1030   (pwd     :pointer)
1031   (buffer  :pointer)
1032   (bufsize size-t)
1033   (result  :pointer))
1034
1035 (defun funcall-getpw (fn arg)
1036   (with-foreign-objects ((pw 'passwd) (pwp :pointer))
1037     (with-foreign-pointer (buf +cstring-path-max+ bufsize)
1038       (with-foreign-slots ((name passwd uid gid gecos dir shell) pw passwd)
1039         (funcall fn arg pw buf bufsize pwp)
1040         (if (null-pointer-p (mem-ref pwp :pointer))
1041             nil
1042             (values name passwd uid gid gecos dir shell))))))
1043
1044 (defentrypoint getpwuid (uid)
1045   "Gets the passwd info of a user, by user id (reentrant)."
1046   (funcall-getpw #'%getpwuid-r uid))
1047
1048 (defentrypoint getpwnam (name)
1049   "Gets the passwd info of a user, by username (reentrant)."
1050   (funcall-getpw #'%getpwnam-r name))
1051 \f
1052
1053 ;;;-------------------------------------------------------------------------
1054 ;;; Group info
1055 ;;;-------------------------------------------------------------------------
1056
1057 (defsyscall (%getgrgid-r "getgrgid_r")
1058     (:int
1059      :error-predicate plusp
1060      :error-location :return)
1061   (uid     uid-t)
1062   (grp     :pointer)
1063   (buffer  :pointer)
1064   (bufsize size-t)
1065   (result  :pointer))
1066
1067 (defsyscall (%getgrnam-r "getgrnam_r")
1068     (:int
1069      :error-predicate plusp
1070      :error-location :return)
1071   (name    :string)
1072   (grp     :pointer)
1073   (buffer  :pointer)
1074   (bufsize size-t)
1075   (result  :pointer))
1076
1077 ;; FIXME: return group members too
1078 (defun funcall-getgr (fn arg)
1079   (with-foreign-objects ((gr 'group) (grp :pointer))
1080     (with-foreign-pointer (buf +cstring-path-max+ bufsize)
1081       (with-foreign-slots ((name passwd gid) gr group)
1082         (funcall fn arg gr buf bufsize grp)
1083         (if (null-pointer-p (mem-ref grp :pointer))
1084             nil
1085             (values name passwd gid))))))
1086
1087 (defentrypoint getgrgid (gid)
1088   "Gets a group info, by group id (reentrant)."
1089   (funcall-getgr #'%getgrgid-r gid))
1090
1091 (defentrypoint getgrnam (name)
1092   "Gets a group info, by group name (reentrant)."
1093   (funcall-getgr #'%getgrnam-r name))
1094 \f
1095
1096 ;;;-------------------------------------------------------------------------
1097 ;;; Syslog
1098 ;;;-------------------------------------------------------------------------
1099
1100 (defsyscall (openlog "lfp_openlog") :void
1101   "Opens a connection to the system logger for a program."
1102   (ident    :string)
1103   (option   :int)
1104   (facility :int))
1105
1106 (defsyscall (%syslog "lfp_syslog") :void
1107   "Generates a log message, which will be distributed by syslogd."
1108   (priority :int)
1109   (format   :string)
1110   (message  :string))
1111
1112 (defentrypoint syslog (priority format &rest args)
1113   "Generates a log message, which will be distributed by syslogd.
1114 Using a FORMAT string and ARGS for lisp-side message formating."
1115   (with-foreign-string (c-string (apply #'format nil format args))
1116     (%syslog priority "%s" c-string)))
1117
1118 (defsyscall (closelog "lfp_closelog") :void
1119   "Closes the descriptor being used to write to the system logger (optional).")
1120
1121 (defsyscall (setlogmask "lfp_setlogmask") :int
1122   "Set the log mask level."
1123   (mask :int))
1124
1125 (defsyscall (log-mask "lfp_log_mask") :int
1126   "Log mask corresponding to PRIORITY."
1127   (priority :int))
1128
1129 (defsyscall (log-upto "lfp_log_upto") :int
1130   "Log mask upto and including PRIORITY."
1131   (priority :int))
1132
1133 (defmacro with-syslog ((identity &key (options log-ndelay) (facility log-daemon))
1134                        &body body)
1135   `(unwind-protect
1136         (progn
1137           (openlog ,identity ,options ,facility)
1138           ,@body)
1139      (closelog)))