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 (execvp "execvp") :int
 680   (file sstring)
 681   (argv :pointer))
 682
 683 (defsyscall (%waitpid "waitpid") pid-t
 684   (pid     pid-t)
 685   (status  :pointer)
 686   (options :int))
 687
 688 (defentrypoint waitpid (pid options)
 689   (with-foreign-pointer (status (sizeof :int))
 690     (let ((ret (%waitpid pid status options)))
 691       (values ret (mem-ref status :int)))))
 692
 693 (defsyscall (getpid "getpid") pid-t
 694   "Returns the process id of the current process")
 695
 696 (defsyscall (getppid "getppid") pid-t
 697   "Returns the process id of the current process's parent")
 698
 699 #+linux
 700 (defentrypoint gettid ()
 701   (foreign-funcall "syscall" :int sys-gettid :int))
 702
 703 (defsyscall (getuid "getuid") uid-t
 704   "Get real user id of the current process.")
 705
 706 (defsyscall (setuid "setuid") :int
 707   "Set real user id of the current process to UID."
 708   (uid uid-t))
 709
 710 (defsyscall (geteuid "geteuid") uid-t
 711   "Get effective user id of the current process.")
 712
 713 (defsyscall (seteuid "seteuid") :int
 714   "Set effective user id of the current process to UID."
 715   (uid uid-t))
 716
 717 (defsyscall (getgid "getgid") gid-t
 718   "Get real group id of the current process.")
 719
 720 (defsyscall (setgid "setgid") :int
 721   "Set real group id of the current process to GID."
 722   (gid gid-t))
 723
 724 (defsyscall (getegid "getegid") gid-t
 725   "Get effective group id of the current process.")
 726
 727 (defsyscall (setegid "setegid") :int
 728   "Set effective group id of the current process to GID."
 729   (gid gid-t))
 730
 731 (defsyscall (setreuid "setreuid") :int
 732   "Set real and effective user id of the current process to RUID and EUID."
 733   (ruid uid-t)
 734   (euid uid-t))
 735
 736 (defsyscall (setregid "setregid") :int
 737   "Set real and effective group id of the current process to RGID and EGID."
 738   (rgid gid-t)
 739   (egid gid-t))
 740
 741 (defsyscall (getpgid "getpgid") pid-t
 742   "Get process group id of process PID."
 743   (pid pid-t))
 744
 745 (defsyscall (setpgid "setpgid") :int
 746   "Set process group id of process PID to value PGID."
 747   (pid  pid-t)
 748   (pgid pid-t))
 749
 750 (defsyscall (getpgrp "getpgrp") pid-t
 751   "Get process group id of the current process.")
 752
 753 (defsyscall (setpgrp "setpgrp") pid-t
 754   "Set process group id of the current process.")
 755
 756 (defsyscall (setsid "setsid") pid-t
 757   "Create session and set process group id of the current process.")
 758
 759 (defsyscall (%getrlimit "lfp_getrlimit")
 760     :int
 761   (resource :int)
 762   (rlimit   :pointer))
 763
 764 (defentrypoint getrlimit (resource)
 765   "Return soft and hard limit of system resource RESOURCE."
 766   (with-foreign-object (rl 'rlimit)
 767     (with-foreign-slots ((cur max) rl rlimit)
 768       (%getrlimit resource rl)
 769       (values cur max))))
 770
 771 (defsyscall (%setrlimit "lfp_setrlimit")
 772     :int
 773   (resource :int)
 774   (rlimit   :pointer))
 775
 776 (defentrypoint setrlimit (resource soft-limit hard-limit)
 777   "Set SOFT-LIMIT and HARD-LIMIT of system resource RESOURCE."
 778   (with-foreign-object (rl 'rlimit)
 779     (with-foreign-slots ((cur max) rl rlimit)
 780       (setf cur soft-limit
 781             max hard-limit)
 782       (%setrlimit resource rl))))
 783
 784 (defsyscall (%getrusage "getrusage") :int
 785   (who   :int)
 786   (usage :pointer))
 787
 788 ;;; TODO: it might be more convenient to return a wrapper object here
 789 ;;; instead like we do in STAT.
 790 (defentrypoint getrusage (who)
 791   "Return resource usage measures of WHO."
 792   (with-foreign-object (ru 'rusage)
 793     (%getrusage who ru)
 794     (with-foreign-slots ((maxrss ixrss idrss isrss minflt majflt nswap inblock
 795                           oublock msgsnd msgrcv nsignals nvcsw nivcsw)
 796                          ru rusage)
 797       (values (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 798                                   'timeval 'sec)
 799               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 800                                   'timeval 'usec)
 801               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 802                                   'timeval 'sec)
 803               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 804                                   'timeval 'usec)
 805               maxrss ixrss idrss isrss minflt majflt
 806               nswap inblock oublock msgsnd
 807               msgrcv nsignals nvcsw nivcsw))))
 808
 809 (defsyscall (getpriority "getpriority") :int
 810   "Get the scheduling priority of a process, process group, or user,
 811 as indicated by WHICH and WHO."
 812   (which :int)
 813   (who   :int))
 814
 815 (defsyscall (setpriority "setpriority") :int
 816   "Set the scheduling priority of a process, process group, or user,
 817 as indicated by WHICH and WHO to VALUE."
 818   (which :int)
 819   (who   :int)
 820   (value :int))
 821
 822 (defentrypoint nice (&optional (increment 0))
 823   "Get or set process priority."
 824   ;; FIXME: race condition. might need WITHOUT-INTERRUPTS on some impl.s
 825   (setf (errno) 0)
 826   (let ((retval (foreign-funcall "nice" :int increment :int))
 827         (errno (errno)))
 828     (if (and (= retval -1) (/= errno 0))
 829         (signal-syscall-error errno "nice")
 830         retval)))
 831
 832 (defsyscall (exit "_exit") :void
 833   "terminate the calling process"
 834   (status :int))
 835
 836 \f
 837
 838 ;;;-------------------------------------------------------------------------
 839 ;;; Signals
 840 ;;;-------------------------------------------------------------------------
 841
 842 (defsyscall (kill "kill") :int
 843   "Send signal SIG to process PID."
 844   (pid    pid-t)
 845   (signum signal))
 846
 847 (defsyscall (sigaction "sigaction") :int
 848   (signum :int)
 849   (act    :pointer)
 850   (oldact :pointer))
 851
 852 (defentrypoint wifexited (status)
 853   (plusp (foreign-funcall "lfp_wifexited" :int status :int)))
 854
 855 (defentrypoint wexitstatus (status)
 856   (foreign-funcall "lfp_wexitstatus" :int status :int))
 857
 858 (defentrypoint wifsignaled (status)
 859   (plusp (foreign-funcall "lfp_wifsignaled" :int status :int)))
 860
 861 (defentrypoint wtermsig (status)
 862   (foreign-funcall "lfp_wtermsig" :int status :int))
 863
 864 (defentrypoint wtermsig* (status)
 865   (foreign-enum-keyword 'signal (wtermsig status)))
 866
 867 (defentrypoint wcoredump (status)
 868   (plusp (foreign-funcall "lfp_wcoredump" :int status :int)))
 869
 870 (defentrypoint wifstopped (status)
 871   (plusp (foreign-funcall "lfp_wifstopped" :int status :int)))
 872
 873 (defentrypoint wstopsig (status)
 874   (foreign-funcall "lfp_wstopsig" :int status :int))
 875
 876 (defentrypoint wifcontinued (status)
 877   (plusp (foreign-funcall "lfp_wifcontinued" :int status :int)))
 878 \f
 879
 880 ;;;-------------------------------------------------------------------------
 881 ;;; Time
 882 ;;;-------------------------------------------------------------------------
 883
 884 (defsyscall (usleep "usleep") :int
 885   "Suspend execution for USECONDS microseconds."
 886   (useconds useconds-t))
 887
 888 (defsyscall (%clock-getres "lfp_clock_getres") :int
 889   "Returns the resolution of the clock CLOCKID."
 890   (clockid clockid-t)
 891   (res     :pointer))
 892
 893 (defentrypoint clock-getres (clock-id)
 894   (with-foreign-object (ts 'timespec)
 895     (with-foreign-slots ((sec nsec) ts timespec)
 896       (%clock-getres clock-id ts)
 897       (values sec nsec))))
 898
 899 (defsyscall (%clock-gettime "lfp_clock_gettime") :int
 900   (clockid clockid-t)
 901   (tp      :pointer))
 902
 903 (defentrypoint clock-gettime (clock-id)
 904   "Returns the time of the clock CLOCKID."
 905   (with-foreign-object (ts 'timespec)
 906     (with-foreign-slots ((sec nsec) ts timespec)
 907       (%clock-gettime clock-id ts)
 908       (values sec nsec))))
 909
 910 (defsyscall (%clock-settime "lfp_clock_settime") :int
 911   (clockid clockid-t)
 912   (tp      :pointer))
 913
 914 (defentrypoint clock-settime (clock-id)
 915   "Sets the time of the clock CLOCKID."
 916   (with-foreign-object (ts 'timespec)
 917     (with-foreign-slots ((sec nsec) ts timespec)
 918       (%clock-settime clock-id ts)
 919       (values sec nsec))))
 920
 921 ;; FIXME: replace it with clock_gettime(CLOCK_MONOTONIC, ...)
 922 (defentrypoint get-monotonic-time ()
 923   "Gets current time in seconds from a system's monotonic clock."
 924   (multiple-value-bind (seconds nanoseconds)
 925       (clock-gettime clock-monotonic)
 926     (+ seconds (/ nanoseconds 1d9))))
 927 \f
 928
 929 ;;;-------------------------------------------------------------------------
 930 ;;; Environment
 931 ;;;-------------------------------------------------------------------------
 932
 933 (defsyscall (os-environ "lfp_get_environ") :pointer
 934   "Return a pointer to the current process environment.")
 935
 936 (defmacro %obsolete-*environ* ()
 937   (iolib.base::signal-obsolete '*environ* "use function OS-ENVIRON instead"
 938                                "symbol macro" :WARN)
 939   `(os-environ))
 940
 941 (define-symbol-macro *environ* (%obsolete-*environ*))
 942
 943 (defentrypoint getenv (name)
 944   "Returns the value of environment variable NAME."
 945   (when (and (pointerp name) (null-pointer-p name))
 946     (setf (errno) einval)
 947     (signal-syscall-error einval "getenv"))
 948   (foreign-funcall "getenv" :string name :string))
 949
 950 (defsyscall (setenv "setenv") :int
 951   "Changes the value of environment variable NAME to VALUE.
 952 The environment variable is overwritten only if overwrite is not NIL."
 953   (name      :string)
 954   (value     :string)
 955   (overwrite bool-designator))
 956
 957 (defsyscall (unsetenv "unsetenv") :int
 958   "Removes the binding of environment variable NAME."
 959   (name :string))
 960
 961 ;; FIXME: move into libfixposix
 962 (defentrypoint clearenv ()
 963   "Remove all name-value pairs from the environment set the
 964 OS environment to NULL."
 965   (let ((envptr (os-environ)))
 966     (unless (null-pointer-p envptr)
 967       (loop :for i :from 0 :by 1
 968             :for string := (mem-aref envptr :string i)
 969             :for name := (subseq string 0 (position #\= string))
 970             :while name :do (unsetenv name))
 971       (setf (mem-ref envptr :pointer) (null-pointer)))
 972     (values)))
 973 \f
 974
 975 ;;;-------------------------------------------------------------------------
 976 ;;; Hostname info
 977 ;;;-------------------------------------------------------------------------
 978
 979 (defsyscall (%gethostname "gethostname") :int
 980   (name    :pointer)
 981   (namelen size-t))
 982
 983 (defentrypoint gethostname ()
 984   "Return the host name of the current machine."
 985   (with-foreign-pointer-as-string ((cstr size) 256)
 986     (%gethostname cstr size)))
 987
 988 (defsyscall (%getdomainname "getdomainname") :int
 989   (name    :pointer)
 990   (namelen size-t))
 991
 992 (defentrypoint getdomainname ()
 993   "Return the domain name of the current machine."
 994   (with-foreign-pointer-as-string ((cstr size) 256)
 995     (%getdomainname cstr size)))
 996
 997 (defsyscall (%uname "uname") :int
 998   (buf :pointer))
 999
1000 (defentrypoint uname ()
1001   "Get name and information about current kernel."
1002   (with-foreign-object (buf 'utsname)
1003     (bzero buf (sizeof 'utsname))
1004     (%uname buf)
1005     (macrolet ((utsname-slot (name)
1006                  `(foreign-string-to-lisp
1007                    (foreign-slot-pointer buf 'utsname ',name))))
1008       (values (utsname-slot sysname)
1009               (utsname-slot nodename)
1010               (utsname-slot release)
1011               (utsname-slot version)
1012               (utsname-slot machine)))))
1013 \f
1014
1015 ;;;-------------------------------------------------------------------------
1016 ;;; User info
1017 ;;;-------------------------------------------------------------------------
1018
1019 (defsyscall (%getpwuid-r "getpwuid_r")
1020     (:int
1021      :error-predicate plusp
1022      :error-location :return)
1023   (uid     uid-t)
1024   (pwd     :pointer)
1025   (buffer  :pointer)
1026   (bufsize size-t)
1027   (result  :pointer))
1028
1029 (defsyscall (%getpwnam-r "getpwnam_r")
1030     (:int
1031      :error-predicate plusp
1032      :error-location :return)
1033   (name    :string)
1034   (pwd     :pointer)
1035   (buffer  :pointer)
1036   (bufsize size-t)
1037   (result  :pointer))
1038
1039 (defun funcall-getpw (fn arg)
1040   (with-foreign-objects ((pw 'passwd) (pwp :pointer))
1041     (with-foreign-pointer (buf +cstring-path-max+ bufsize)
1042       (with-foreign-slots ((name passwd uid gid gecos dir shell) pw passwd)
1043         (funcall fn arg pw buf bufsize pwp)
1044         (if (null-pointer-p (mem-ref pwp :pointer))
1045             nil
1046             (values name passwd uid gid gecos dir shell))))))
1047
1048 (defentrypoint getpwuid (uid)
1049   "Gets the passwd info of a user, by user id (reentrant)."
1050   (funcall-getpw #'%getpwuid-r uid))
1051
1052 (defentrypoint getpwnam (name)
1053   "Gets the passwd info of a user, by username (reentrant)."
1054   (funcall-getpw #'%getpwnam-r name))
1055 \f
1056
1057 ;;;-------------------------------------------------------------------------
1058 ;;; Group info
1059 ;;;-------------------------------------------------------------------------
1060
1061 (defsyscall (%getgrgid-r "getgrgid_r")
1062     (:int
1063      :error-predicate plusp
1064      :error-location :return)
1065   (uid     uid-t)
1066   (grp     :pointer)
1067   (buffer  :pointer)
1068   (bufsize size-t)
1069   (result  :pointer))
1070
1071 (defsyscall (%getgrnam-r "getgrnam_r")
1072     (:int
1073      :error-predicate plusp
1074      :error-location :return)
1075   (name    :string)
1076   (grp     :pointer)
1077   (buffer  :pointer)
1078   (bufsize size-t)
1079   (result  :pointer))
1080
1081 ;; FIXME: return group members too
1082 (defun funcall-getgr (fn arg)
1083   (with-foreign-objects ((gr 'group) (grp :pointer))
1084     (with-foreign-pointer (buf +cstring-path-max+ bufsize)
1085       (with-foreign-slots ((name passwd gid) gr group)
1086         (funcall fn arg gr buf bufsize grp)
1087         (if (null-pointer-p (mem-ref grp :pointer))
1088             nil
1089             (values name passwd gid))))))
1090
1091 (defentrypoint getgrgid (gid)
1092   "Gets a group info, by group id (reentrant)."
1093   (funcall-getgr #'%getgrgid-r gid))
1094
1095 (defentrypoint getgrnam (name)
1096   "Gets a group info, by group name (reentrant)."
1097   (funcall-getgr #'%getgrnam-r name))
1098 \f
1099
1100 ;;;-------------------------------------------------------------------------
1101 ;;; Syslog
1102 ;;;-------------------------------------------------------------------------
1103
1104 (defsyscall (openlog "lfp_openlog") :void
1105   "Opens a connection to the system logger for a program."
1106   (ident    :string)
1107   (option   :int)
1108   (facility :int))
1109
1110 (defsyscall (%syslog "lfp_syslog") :void
1111   "Generates a log message, which will be distributed by syslogd."
1112   (priority :int)
1113   (format   :string)
1114   (message  :string))
1115
1116 (defentrypoint syslog (priority format &rest args)
1117   "Generates a log message, which will be distributed by syslogd.
1118 Using a FORMAT string and ARGS for lisp-side message formating."
1119   (with-foreign-string (c-string (apply #'format nil format args))
1120     (%syslog priority "%s" c-string)))
1121
1122 (defsyscall (closelog "lfp_closelog") :void
1123   "Closes the descriptor being used to write to the system logger (optional).")
1124
1125 (defsyscall (setlogmask "lfp_setlogmask") :int
1126   "Set the log mask level."
1127   (mask :int))
1128
1129 (defsyscall (log-mask "lfp_log_mask") :int
1130   "Log mask corresponding to PRIORITY."
1131   (priority :int))
1132
1133 (defsyscall (log-upto "lfp_log_upto") :int
1134   "Log mask upto and including PRIORITY."
1135   (priority :int))
1136
1137 (defmacro with-syslog ((identity &key (options log-ndelay) (facility log-daemon))
1138                        &body body)
1139   `(unwind-protect
1140         (progn
1141           (openlog ,identity ,options ,facility)
1142           ,@body)
1143      (closelog)))