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