syscalls/ffi-functions-unix.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- *UNIX foreign function definitions.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 ;;; Needed for clock_gettime() and friends.
   9 (eval-when (:compile-toplevel :load-toplevel :execute)
  10   (define-foreign-library librt
  11     (:linux "librt.so"))
  12   (use-foreign-library librt))
  13 \f
  14
  15 ;;;-------------------------------------------------------------------------
  16 ;;; ERRNO-related functions
  17 ;;;-------------------------------------------------------------------------
  18
  19 (defentrypoint (setf %sys-errno) (value)
  20   (%%sys-set-errno value))
  21
  22 (defentrypoint %sys-strerror (&optional (err (%sys-errno)))
  23   "Look up the error message string for ERRNO. (reentrant)"
  24   (let ((errno
  25          (if (keywordp err)
  26              (foreign-enum-value 'errno-values err)
  27              err)))
  28     (with-foreign-pointer-as-string ((buf bufsiz) 1024)
  29       (%sys-strerror-r errno buf bufsiz))))
  30
  31 (defmethod print-object ((posix-error posix-error) stream)
  32   (print-unreadable-object (posix-error stream :type nil :identity nil)
  33     (let ((code (code-of posix-error))
  34           (identifier (identifier-of posix-error)))
  35       (format stream "POSIX Error ~A code: ~S ~S"
  36               identifier (or code "[No code]")
  37               (or (%sys-strerror code) "[Can't get error string.]")))))
  38 \f
  39
  40 ;;;-------------------------------------------------------------------------
  41 ;;; Memory manipulation
  42 ;;;-------------------------------------------------------------------------
  43
  44 (defcfun* (%sys-memset "memset") :pointer
  45   (buffer :pointer)
  46   (value  :int)
  47   (length size-t))
  48
  49 (defentrypoint %sys-bzero (buffer length)
  50   (%sys-memset buffer 0 length))
  51
  52 (defcfun* (%sys-memcpy "memcpy") :pointer
  53   (dest   :pointer)
  54   (src    :pointer)
  55   (length size-t))
  56
  57 (defcfun* (%sys-memmove "memmove") :pointer
  58   (dest   :pointer)
  59   (src    :pointer)
  60   (length size-t))
  61 \f
  62
  63 ;;;-------------------------------------------------------------------------
  64 ;;; I/O
  65 ;;;-------------------------------------------------------------------------
  66
  67 (defsyscall* (%sys-read "read") ssize-t
  68   "Read at most COUNT bytes from FD into the foreign area BUF."
  69   (fd    :int)
  70   (buf   :pointer)
  71   (count size-t))
  72
  73 (defsyscall* (%sys-write "write") ssize-t
  74   "Write at most COUNT bytes to FD from the foreign area BUF."
  75   (fd    :int)
  76   (buf   :pointer)
  77   (count size-t))
  78 \f
  79
  80 ;;;-------------------------------------------------------------------------
  81 ;;; Files
  82 ;;;-------------------------------------------------------------------------
  83
  84 (defsyscall* (%%sys-open "open") :int
  85   (pathname filename-designator)
  86   (flags    :int)
  87   (mode     mode-t))
  88
  89 (defvar *default-open-mode* #o666)
  90
  91 (defentrypoint %sys-open (pathname flags &optional (mode *default-open-mode*))
  92   (%%sys-open pathname flags mode))
  93
  94 (defsyscall* (%sys-creat "creat") :int
  95   (pathname filename-designator)
  96   (mode     mode-t))
  97
  98 (defsyscall (%%sys-pipe "pipe") :int
  99   (filedes :pointer))
 100
 101 (defentrypoint %sys-pipe ()
 102   "Create pipe, returns two values with the new FDs."
 103   (with-foreign-object (filedes :int 2)
 104     (%%sys-pipe filedes)
 105     (values (mem-aref filedes :int 0)
 106             (mem-aref filedes :int 1))))
 107
 108 (defsyscall (%sys-mkfifo "mkfifo") :int
 109   "Create a FIFO (named pipe)."
 110   (path filename-designator)
 111   (mode mode-t))
 112
 113 (defsyscall (%sys-umask "umask") mode-t
 114   "Sets the umask and returns the old one"
 115   (new-mode mode-t))
 116
 117 (defsyscall (%sys-access "access") :int
 118   (path  filename-designator)
 119   (amode :int))
 120
 121 (defsyscall (%sys-rename "rename") :int
 122   "Rename a file."
 123   (old filename-designator)
 124   (new filename-designator))
 125
 126 (defsyscall (%sys-link "link") :int
 127   (path1 filename-designator)
 128   (path2 filename-designator))
 129
 130 (defsyscall (%sys-symlink "symlink") :int
 131   "Creates a symbolic link"
 132   (name1 filename-designator)
 133   (name2 filename-designator))
 134
 135 (defsyscall (%%sys-readlink "readlink") ssize-t
 136   (path    filename-designator)
 137   (buf     :pointer)
 138   (bufsize size-t))
 139
 140 (defentrypoint %sys-readlink (path)
 141   "Read value of a symbolic link."
 142   (with-foreign-pointer (buf 4096 bufsize)
 143     (let ((count (%%sys-readlink path buf bufsize)))
 144       (values (foreign-string-to-lisp buf :count count)))))
 145
 146 (defsyscall (%sys-unlink "unlink") :int
 147   (path filename-designator))
 148
 149 (defsyscall* (%sys-chown "chown") :int
 150   "Change ownership of a file."
 151   (path  filename-designator)
 152   (owner uid-t)
 153   (group uid-t))
 154
 155 (defsyscall* (%sys-fchown "fchown") :int
 156   "Change ownership of an open file."
 157   (fd    :int)
 158   (owner uid-t)
 159   (group uid-t))
 160
 161 (defsyscall* (%sys-lchown "lchown") :int
 162   "Change ownership of a file or symlink."
 163   (path  filename-designator)
 164   (owner uid-t)
 165   (group uid-t))
 166
 167 (defsyscall* (%sys-chmod "chmod") :int
 168   (path filename-designator)
 169   (mode mode-t))
 170
 171 (defsyscall* (%sys-fchmod "fchmod") :int
 172   (fd   :int)
 173   (mode mode-t))
 174
 175 ;;; STAT()
 176
 177 (define-c-struct-wrapper stat ())
 178
 179 (defconstant +stat-version-linux+ 3)
 180
 181 ;;; If necessary for performance reasons, we can add an optional
 182 ;;; argument to this function and use that to reuse a wrapper object.
 183 (defentrypoint funcall-stat (fn arg)
 184   (with-foreign-object (buf 'stat)
 185     (funcall fn arg buf)
 186     (make-instance 'stat :pointer buf)))
 187
 188 (defentrypoint %sys-stat (path)
 189   "Get information about a file."
 190   (funcall-stat #'%%sys-stat path))
 191
 192 (defentrypoint %sys-fstat (fd)
 193   "Get information about a file descriptor"
 194   (funcall-stat #'%%sys-fstat fd))
 195
 196 (defentrypoint %sys-lstat (path)
 197   "Get information about a file or symlink."
 198   (funcall-stat #'%%sys-lstat path))
 199
 200 (defsyscall (%sys-sync "sync") :void
 201   "Schedule all file system buffers to be written to disk.")
 202
 203 (defsyscall* (%sys-fsync "fsync") :int
 204   (fildes :int))
 205
 206 (defsyscall (%%sys-mkstemp "mkstemp") :int
 207   (template filename-designator))
 208
 209 (defentrypoint %sys-mkstemp (&optional (template ""))
 210   (let ((template (concatenate 'string template "XXXXXX")))
 211     (with-foreign-string (ptr (filename template))
 212       (values (%%sys-mkstemp ptr) (foreign-string-to-lisp ptr)))))
 213 \f
 214
 215 ;;;-------------------------------------------------------------------------
 216 ;;; Directories
 217 ;;;-------------------------------------------------------------------------
 218
 219 (defsyscall (%sys-mkdir "mkdir") :int
 220   "Create a directory."
 221   (path filename-designator)
 222   (mode mode-t))
 223
 224 (defsyscall (%sys-rmdir "rmdir") :int
 225   (path filename-designator))
 226
 227 (defsyscall (%sys-chdir "chdir") :int
 228   "Changes the current working directory"
 229   (path filename-designator))
 230
 231 (defsyscall* (%sys-fchdir "fchdir") :int
 232   (fildes :int))
 233
 234 (defsyscall (%%sys-getcwd "getcwd") :string
 235   (buf :pointer)
 236   (size size-t))
 237
 238 (defentrypoint %sys-getcwd ()
 239   "Returns the current working directory as a string."
 240   (with-foreign-pointer (buf path-max size)
 241     (%%sys-getcwd buf size)))
 242
 243 (defsyscall (%%sys-mkdtemp "mkdtemp") :int
 244   (template filename-designator))
 245
 246 (defentrypoint %sys-mkdtemp (&optional (template ""))
 247   (let ((template (concatenate 'string template "XXXXXX")))
 248     (with-foreign-string (ptr (filename template))
 249       (values (%%sys-mkdtemp ptr) (foreign-string-to-lisp ptr)))))
 250 \f
 251
 252 ;;;-------------------------------------------------------------------------
 253 ;;; File Descriptors
 254 ;;;-------------------------------------------------------------------------
 255
 256 (defsyscall (%sys-close "close") :int
 257   "Close an open file descriptor."
 258   (fd :int))
 259
 260 (defsyscall (%sys-dup "dup") :int
 261   (fildes :int))
 262
 263 (defsyscall* (%sys-dup2 "dup2") :int
 264   (fildes1 :int)
 265   (fildes2 :int))
 266
 267 (defsyscall* (%sys-ioctl/2 "ioctl") :int
 268   (fd      :int)
 269   (request :int))
 270
 271 (defsyscall* (%sys-ioctl/3 "ioctl") :int
 272  (fd      :int)
 273  (request :int)
 274  (arg     :pointer))
 275
 276 (defentrypoint %sys-fd-open-p (fd)
 277   (not (minusp (%sys-fstat fd))))
 278 \f
 279
 280 ;;;-------------------------------------------------------------------------
 281 ;;; File descriptor polling
 282 ;;;-------------------------------------------------------------------------
 283
 284 ;;; FIXME: Until a way to autodetect platform features is implemented
 285 (eval-when (:compile-toplevel :load-toplevel :execute)
 286   (unless (boundp 'pollrdhup)
 287     (defconstant pollrdhup 0)))
 288
 289 (defsyscall (%sys-poll "poll") :int
 290   "Scan for I/O activity on multiple file descriptors."
 291   (fds     :pointer)
 292   (nfds    nfds-t)
 293   (timeout :int))
 294 \f
 295
 296 ;;;-------------------------------------------------------------------------
 297 ;;; Directory walking
 298 ;;;-------------------------------------------------------------------------
 299
 300 (defsyscall (%sys-opendir "opendir") :pointer
 301   "Opens a directory for listing of its contents"
 302   (filename filename-designator))
 303
 304 (defsyscall (%sys-closedir "closedir") :int
 305   "Closes a directory when done listing its contents"
 306   (dir :pointer))
 307
 308 (defentrypoint %sys-readdir (dir)
 309   "Reads an item from the listing of a directory (reentrant)"
 310   (with-foreign-objects ((entry 'dirent) (result :pointer))
 311     (%%sys-readdir-r dir entry result)
 312     (if (null-pointer-p (mem-ref result :pointer))
 313         nil
 314         (with-foreign-slots ((name type fileno) entry dirent)
 315           (values (foreign-string-to-lisp name) type fileno)))))
 316
 317 (defsyscall (%sys-rewinddir "rewinddir") :void
 318   "Rewinds a directory."
 319   (dir :pointer))
 320
 321 (defsyscall (%sys-seekdir "seekdir") :void
 322   "Seeks a directory."
 323   (dir :pointer)
 324   (pos :long))
 325
 326 ;;; FIXME: According to POSIX docs "no errors are defined" for
 327 ;;; telldir() but Linux manpages specify a possible EBADF.
 328 (defsyscall (%sys-telldir "telldir") off-t
 329   "Returns the current location in a directory"
 330   (dir :pointer))
 331 \f
 332
 333 ;;;-------------------------------------------------------------------------
 334 ;;; Memory mapping
 335 ;;;-------------------------------------------------------------------------
 336
 337 (defsyscall (%sys-munmap "munmap") :int
 338   "Unmap pages of memory."
 339   (addr :pointer)
 340   (len  size-t))
 341 \f
 342
 343 ;;;-------------------------------------------------------------------------
 344 ;;; Process creation and info
 345 ;;;-------------------------------------------------------------------------
 346
 347 (defsyscall (%sys-fork "fork") pid-t
 348   "Create a child process.")
 349
 350 (defsyscall (%sys-getpid "getpid") pid-t
 351   "Returns the process id of the current process")
 352
 353 (defsyscall (%sys-getppid "getppid") pid-t
 354   "Returns the process id of the current process's parent")
 355
 356 (defsyscall (%sys-getuid "getuid") uid-t
 357   "Get real user id of the current process.")
 358
 359 (defsyscall (%sys-setuid "setuid") :int
 360   "Set real user id of the current process."
 361   (uid uid-t))
 362
 363 (defsyscall (%sys-geteuid "geteuid") uid-t
 364   "Get effective user id of the current process.")
 365
 366 (defsyscall (%sys-seteuid "seteuid") :int
 367   "Set effective user id of the current process."
 368   (uid uid-t))
 369
 370 (defsyscall (%sys-getgid "getgid") gid-t
 371   "Get real group id of the current process.")
 372
 373 (defsyscall (%sys-setgid "setgid") :int
 374   "Set real group id of the current process."
 375   (gid gid-t))
 376
 377 (defsyscall (%sys-getegid "getegid") gid-t
 378   "Get effective group id of the current process.")
 379
 380 (defsyscall (%sys-setegid "setegid") :int
 381   "Set effective group id of the current process."
 382   (gid gid-t))
 383
 384 (defsyscall (%sys-setreuid "setreuid") :int
 385   "Set real and effective user id of the current process."
 386   (ruid uid-t)
 387   (euid uid-t))
 388
 389 (defsyscall (%sys-setregid "setregid") :int
 390   "Set real and effective group id of the current process."
 391   (rgid gid-t)
 392   (egid gid-t))
 393
 394 (defsyscall (%sys-getpgid "getpgid") pid-t
 395   "Get process group id of a process."
 396   (pid pid-t))
 397
 398 (defsyscall (%sys-setpgid "setpgid") :int
 399   "Set process group id of a process."
 400   (pid  pid-t)
 401   (pgid pid-t))
 402
 403 (defsyscall (%sys-getpgrp "getpgrp") pid-t
 404   "Get process group id of the current process.")
 405
 406 (defsyscall (%sys-setpgrp "setpgrp") pid-t
 407   "Set process group id of the current process.")
 408
 409 (defsyscall (%sys-setsid "setsid") pid-t
 410   "Create session and set process group id of the current process.")
 411
 412 (defentrypoint %sys-getrlimit (resource)
 413   (with-foreign-object (rl 'rlimit)
 414     (with-foreign-slots ((cur max) rl rlimit)
 415       (%%sys-getrlimit resource rl)
 416       (values cur max))))
 417
 418 (defentrypoint %sys-setrlimit (resource soft-limit hard-limit)
 419   (with-foreign-object (rl 'rlimit)
 420     (with-foreign-slots ((cur max) rl rlimit)
 421       (setf cur soft-limit
 422             max hard-limit)
 423       (%%sys-setrlimit resource rl))))
 424
 425 (defsyscall (%%sys-getrusage "getrusage") :int
 426   (who   :int)
 427   (usage :pointer))
 428
 429 ;;; TODO: it might be more convenient to return a wrapper object here
 430 ;;; instead like we do in STAT.
 431 (defentrypoint %sys-getrusage (who)
 432   (with-foreign-object (ru 'rusage)
 433     (%%sys-getrusage who ru)
 434     (with-foreign-slots ((maxrss ixrss idrss isrss minflt majflt nswap inblock
 435                           oublock msgsnd msgrcv nsignals nvcsw nivcsw)
 436                          ru rusage)
 437       (values (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 438                                   'timeval 'sec)
 439               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
 440                                   'timeval 'usec)
 441               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 442                                   'timeval 'sec)
 443               (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
 444                                   'timeval 'usec)
 445               maxrss ixrss idrss isrss minflt majflt
 446               nswap inblock oublock msgsnd
 447               msgrcv nsignals nvcsw nivcsw))))
 448
 449 (defsyscall (%sys-getpriority "getpriority") :int
 450   (which :int)
 451   (who   :int))
 452
 453 (defsyscall (%sys-setpriority "setpriority") :int
 454   (which :int)
 455   (who   :int)
 456   (value :int))
 457
 458 (defentrypoint %sys-nice (&optional (increment 0))
 459   "Get or set process priority."
 460   ;; FIXME: race condition. might need WITHOUT-INTERRUPTS on some impl.s
 461   (setf (%sys-errno) 0)
 462   (let ((r (foreign-funcall "nice" :int increment :int)))
 463     (if (and (= r -1) (/= (%sys-errno) 0))
 464         (signal-posix-error r)
 465         r)))
 466 \f
 467
 468 ;;;-------------------------------------------------------------------------
 469 ;;; Time
 470 ;;;-------------------------------------------------------------------------
 471
 472 (defsyscall* (%sys-usleep "usleep") :int
 473   (useconds useconds-t))
 474
 475 (defsyscall (%%sys-time "time") time-t
 476   (tloc :pointer))
 477
 478 (defentrypoint %sys-time ()
 479   (%%sys-time (null-pointer)))
 480
 481 (defsyscall (%%sys-gettimeofday "gettimeofday") :int
 482   (tp  :pointer)
 483   (tzp :pointer))
 484
 485 (defentrypoint %sys-gettimeofday ()
 486   "Return the time in seconds and microseconds."
 487   (with-foreign-object (tv 'timeval)
 488     (with-foreign-slots ((sec usec) tv timeval)
 489       (%%sys-gettimeofday tv (null-pointer))
 490       (values sec usec))))
 491
 492 ;;; FIXME: or we can implement this through the MACH functions.
 493 #+darwin
 494 (progn
 495   (defctype kern-return-t :int)
 496   (defctype clock-res-t :int)
 497   (defctype clock-id-t :int)
 498   (defctype port-t :unsigned-int)         ; not sure
 499   (defctype clock-serv-t port)
 500
 501   (defconstant kern-success 0)
 502
 503   (defconstant system-clock 0)
 504   (defconstant calendar-clock 1)
 505   (defconstant realtime-clock 0)
 506
 507   (defsyscall (%sys-mach-host-self "mach_host_self") port-t)
 508
 509   (defsyscall (%%sys-host-get-clock-service "host_get_clock_service") kern-return-t
 510     (host port-t)
 511     (id clock-id-t)
 512     (clock-name (:pointer clock-serv-t)))
 513
 514   (defentrypoint %sys-host-get-clock-service (id &optional (host (%sys-mach-host-self)))
 515     (with-foreign-object (clock 'clock-serv-t)
 516       (%%sys-host-get-clock-service host id clock)
 517       (mem-ref clock :int)))
 518
 519   (defsyscall (%clock-get-time "clock_get_time") kern-return-t
 520     (clock-serv clock-serv-t)
 521     (cur-time timespec))
 522
 523   (defentrypoint clock-get-time (clock-service)
 524     (with-foreign-object (time 'timespec)
 525       (%clock-get-time clock-service time)
 526       (with-foreign-slots ((tv-sec tv-nsec) time timespec)
 527         (values tv-sec tv-nsec)))))
 528
 529 #-darwin
 530 (progn
 531   (defsyscall (%%sys-clock-getres "clock_getres") :int
 532     "Returns the resolution of the clock CLOCKID."
 533     (clockid clockid-t)
 534     (res     :pointer))
 535
 536   (defentrypoint %sys-clock-getres (clock-id)
 537     (with-foreign-object (ts 'timespec)
 538       (with-foreign-slots ((sec nsec) ts timespec)
 539         (%%sys-clock-getres clock-id ts)
 540         (values sec nsec))))
 541
 542   (defsyscall (%%sys-clock-gettime "clock_gettime") :int
 543     (clockid clockid-t)
 544     (tp      :pointer))
 545
 546   (defentrypoint %sys-clock-gettime (clock-id)
 547     "Returns the time of the clock CLOCKID."
 548     (with-foreign-object (ts 'timespec)
 549       (with-foreign-slots ((sec nsec) ts timespec)
 550         (%%sys-clock-gettime clock-id ts)
 551         (values sec nsec))))
 552
 553   (defsyscall (%%sys-clock-settime "clock_settime") :int
 554     (clockid clockid-t)
 555     (tp      :pointer))
 556
 557   (defentrypoint %sys-clock-settime (clock-id)
 558     "Sets the time of the clock CLOCKID."
 559     (with-foreign-object (ts 'timespec)
 560       (with-foreign-slots ((sec nsec) ts timespec)
 561         (%%sys-clock-settime clock-id ts)
 562         (values sec nsec)))))
 563
 564 (defentrypoint %sys-get-monotonic-time ()
 565   "Gets current time in seconds from a system's monotonic clock."
 566   (multiple-value-bind (seconds nanoseconds)
 567       #-darwin (%sys-clock-gettime clock-monotonic)
 568       #+darwin (%sys-clock-get-time (%sys-host-get-clock-service system-clock))
 569     (+ seconds (/ nanoseconds 1d9))))
 570 \f
 571
 572 ;;;-------------------------------------------------------------------------
 573 ;;; Environement
 574 ;;;-------------------------------------------------------------------------
 575
 576 (defcvar ("environ" :read-only t) (:pointer :string))
 577
 578 (defsyscall (%sys-getenv "getenv") :string
 579   "Returns the value of an environment variable"
 580   (name :string))
 581
 582 (defsyscall (%sys-setenv "setenv") :int
 583   "Changes the value of an environment variable"
 584   (name      :string)
 585   (value     :string)
 586   (overwrite bool-designator))
 587
 588 (defsyscall (%sys-unsetenv "unsetenv") :int
 589   "Removes the binding of an environment variable"
 590   (name :string))
 591 \f
 592
 593 ;;;-------------------------------------------------------------------------
 594 ;;; Hostname info
 595 ;;;-------------------------------------------------------------------------
 596
 597 (defsyscall (%%sys-gethostname "gethostname") :int
 598   (name    :pointer)
 599   (namelen size-t))
 600
 601 (defentrypoint %sys-gethostname ()
 602   (with-foreign-pointer-as-string ((cstr size) 256)
 603     (%%sys-gethostname cstr size)))
 604
 605 (defsyscall (%%sys-getdomainname "getdomainname") :int
 606   (name    :pointer)
 607   (namelen size-t))
 608
 609 (defentrypoint %sys-getdomainname ()
 610   (with-foreign-pointer-as-string ((cstr size) 256)
 611     (%%sys-getdomainname cstr size)))
 612
 613 (defsyscall (%%sys-uname "uname") :int
 614   (buf :pointer))
 615
 616 (defentrypoint %sys-uname ()
 617   "Get name and information about current kernel."
 618   (with-foreign-object (buf 'utsname)
 619     (%sys-bzero buf size-of-utsname)
 620     (%%sys-uname buf)
 621     (macrolet ((utsname-slot (name)
 622                  `(foreign-string-to-lisp
 623                    (foreign-slot-pointer buf 'utsname ',name))))
 624       (values (utsname-slot sysname)
 625               (utsname-slot nodename)
 626               (utsname-slot release)
 627               (utsname-slot version)
 628               (utsname-slot machine)))))
 629 \f
 630
 631 ;;;-------------------------------------------------------------------------
 632 ;;; User info
 633 ;;;-------------------------------------------------------------------------
 634
 635 (defcfun (%%sys-getpwuid-r "getpwuid_r")
 636     (return-wrapper :int :error-predicate (lambda (x) (not (zerop x)))
 637                     :error-generator signal-posix-error-from-return-value)
 638   (uid     uid-t)
 639   (pwd     :pointer)
 640   (buffer  :pointer)
 641   (bufsize size-t)
 642   (result  :pointer))
 643
 644 (defcfun (%%sys-getpwnam-r "getpwnam_r")
 645     (return-wrapper :int :error-predicate (lambda (x) (not (zerop x)))
 646                     :error-generator signal-posix-error-from-return-value)
 647   (name    :string)
 648   (pwd     :pointer)
 649   (buffer  :pointer)
 650   (bufsize size-t)
 651   (result  :pointer))
 652
 653 (defun funcall-getpw (fn arg)
 654   (with-foreign-objects ((pw 'passwd-entry) (pwp :pointer))
 655     (with-foreign-pointer (buf 4096 bufsize)
 656       (with-foreign-slots ((name passwd uid gid gecos dir shell) pw passwd-entry)
 657         (funcall fn arg pw buf bufsize pwp)
 658         (if (null-pointer-p (mem-ref pwp :pointer))
 659             nil
 660             (values name passwd uid gid gecos dir shell))))))
 661
 662 (defentrypoint %sys-getpwuid (uid)
 663   "Gets the password-entry of a user, by user id."
 664   (funcall-getpw #'%%sys-getpwuid-r uid))
 665
 666 (defentrypoint %sys-getpwnam (name)
 667   "Gets the password-entry of a user, by username."
 668   (funcall-getpw #'%%sys-getpwnam-r name))
 669 \f
 670
 671 ;;;-------------------------------------------------------------------------
 672 ;;; Group info
 673 ;;;-------------------------------------------------------------------------
 674
 675 (defsyscall (%%sys-getgrgid-r "getgrgid_r")
 676     (return-wrapper :int :error-predicate (lambda (x) (not (zerop x)))
 677                     :error-generator signal-posix-error-from-return-value)
 678   (uid     uid-t)
 679   (grp     :pointer)
 680   (buffer  :pointer)
 681   (bufsize size-t)
 682   (result  :pointer))
 683
 684 (defsyscall (%%sys-getgrnam-r "getgrnam_r")
 685     (return-wrapper :int :error-predicate (lambda (x) (not (zerop x)))
 686                     :error-generator signal-posix-error-from-return-value)
 687   (name    :string)
 688   (grp     :pointer)
 689   (buffer  :pointer)
 690   (bufsize size-t)
 691   (result  :pointer))
 692
 693 (defun funcall-getgr (fn arg)
 694   (with-foreign-objects ((gr 'group-entry) (grp :pointer))
 695     (with-foreign-pointer (buf 4096 bufsize)
 696       (with-foreign-slots ((name passwd gid) gr group-entry)
 697         (funcall fn arg gr buf bufsize grp)
 698         (if (null-pointer-p (mem-ref grp :pointer))
 699             nil
 700             (values name passwd gid))))))
 701
 702 (defentrypoint %sys-getgrgid (gid)
 703   "Gets a group-entry, by group id. (reentrant)"
 704   (funcall-getgr #'%%sys-getgrgid-r gid))
 705
 706 (defentrypoint %sys-getgrnam (name)
 707   "Gets a group-entry, by group name. (reentrant)"
 708   (funcall-getgr #'%%sys-getgrnam-r name))