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 %sys-strerror (&optional (err (get-errno)))
  17   "Look up the error message string for ERRNO. (reentrant)"
  18   (let ((errno
  19          (if (keywordp err)
  20              (foreign-enum-value 'errno-values err)
  21              err)))
  22     (with-foreign-pointer-as-string ((buf bufsiz) 1024)
  23       (%sys-strerror-r errno buf bufsiz))))
  24
  25 (defmethod print-object ((posix-error posix-error) stream)
  26   (print-unreadable-object (posix-error stream :type nil :identity nil)
  27     (let ((code (code-of posix-error))
  28           (identifier (identifier-of posix-error)))
  29       (format stream "POSIX Error ~A code: ~S ~S"
  30               identifier (or code "[No code]")
  31               (or (%sys-strerror code) "[Can't get error string.]")))))
  32 \f
  33
  34 ;;;-----------------------------------------------------------------------------
  35 ;;; Memory manipulation
  36 ;;;-----------------------------------------------------------------------------
  37
  38 (defcfun* ("memset" %sys-memset) :pointer
  39   (buffer :pointer)
  40   (value  :int)
  41   (length size-t))
  42
  43 (defentrypoint %sys-bzero (buffer length)
  44   (%sys-memset buffer 0 length))
  45
  46 (defcfun* ("memcpy" %sys-memcpy) :pointer
  47   (dest   :pointer)
  48   (src    :pointer)
  49   (length size-t))
  50
  51 (defcfun* ("memmove" %sys-memmove) :pointer
  52   (dest   :pointer)
  53   (src    :pointer)
  54   (length size-t))
  55 \f
  56
  57 ;;;-----------------------------------------------------------------------------
  58 ;;; I/O
  59 ;;;-----------------------------------------------------------------------------
  60
  61 (defsyscall* ("read" %sys-read) ssize-t
  62   "Read at most COUNT bytes from FD into the foreign area BUF."
  63   (fd    :int)
  64   (buf   :pointer)
  65   (count size-t))
  66
  67 (defsyscall* ("write" %sys-write) ssize-t
  68   "Write at most COUNT bytes to FD from the foreign area BUF."
  69   (fd    :int)
  70   (buf   :pointer)
  71   (count size-t))
  72 \f
  73
  74 ;;;-----------------------------------------------------------------------------
  75 ;;; Files
  76 ;;;-----------------------------------------------------------------------------
  77
  78 (defsyscall* ("open" %%sys-open) :int
  79   (pathname filename-designator)
  80   (flags    :int)
  81   (mode     mode-t))
  82
  83 (defvar *default-open-mode* #o666)
  84
  85 (defentrypoint %sys-open (pathname flags &optional (mode *default-open-mode*))
  86   (%%sys-open pathname flags mode))
  87
  88 (defsyscall* ("creat" %sys-creat) :int
  89   (pathname filename-designator)
  90   (mode     mode-t))
  91
  92 (defsyscall ("pipe" %%sys-pipe) :int
  93   (filedes :pointer))
  94
  95 (defentrypoint %sys-pipe ()
  96   "Create pipe, returns two values with the new FDs."
  97   (with-foreign-object (filedes :int 2)
  98     (%%sys-pipe filedes)
  99     (values (mem-aref filedes :int 0)
 100             (mem-aref filedes :int 1))))
 101
 102 (defsyscall ("mkfifo" %sys-mkfifo) :int
 103   "Create a FIFO (named pipe)."
 104   (path filename-designator)
 105   (mode mode-t))
 106
 107 (defsyscall "umask" mode-t
 108   "Sets the umask and returns the old one"
 109   (new-mode mode-t))
 110
 111 (defsyscall ("access" %sys-access) :int
 112   (path  filename-designator)
 113   (amode :int))
 114
 115 (defsyscall ("rename" %sys-rename) :int
 116   "Rename a file."
 117   (old filename-designator)
 118   (new filename-designator))
 119
 120 (defsyscall ("link" %sys-link) :int
 121   (path1 filename-designator)
 122   (path2 filename-designator))
 123
 124 (defsyscall ("symlink" %sys-symlink) :int
 125   "Creates a symbolic link"
 126   (name1 filename-designator)
 127   (name2 filename-designator))
 128
 129 (defsyscall ("readlink" %%sys-readlink) ssize-t
 130   (path    filename-designator)
 131   (buf     :pointer)
 132   (bufsize size-t))
 133
 134 (defentrypoint %sys-readlink (path)
 135   "Read value of a symbolic link."
 136   (with-foreign-pointer (buf 4096 bufsize)
 137     (let ((count (%%sys-readlink path buf bufsize)))
 138       (values (foreign-string-to-lisp buf :count count)))))
 139
 140 (defsyscall ("unlink" %sys-unlink) :int
 141   (path filename-designator))
 142
 143 (defsyscall* ("chown" %sys-chown) :int
 144   "Change ownership of a file."
 145   (path  filename-designator)
 146   (owner uid-t)
 147   (group uid-t))
 148
 149 (defsyscall* ("fchown" %sys-fchown) :int
 150   "Change ownership of an open file."
 151   (fd    :int)
 152   (owner uid-t)
 153   (group uid-t))
 154
 155 (defsyscall* ("lchown" %sys-lchown) :int
 156   "Change ownership of a file or symlink."
 157   (path  filename-designator)
 158   (owner uid-t)
 159   (group uid-t))
 160
 161 (defsyscall* ("chmod" %sys-chmod) :int
 162   (path filename-designator)
 163   (mode mode-t))
 164
 165 (defsyscall* ("fchmod" %sys-fchmod) :int
 166   (fd   :int)
 167   (mode mode-t))
 168
 169 ;;; STAT()
 170
 171 (define-c-struct-wrapper stat ())
 172
 173 (defconstant +stat-version-linux+ 3)
 174
 175 ;;; If necessary for performance reasons, we can add an optional
 176 ;;; argument to this function and use that to reuse a wrapper object.
 177 (defentrypoint funcall-stat (fn arg)
 178   (with-foreign-object (buf 'stat)
 179     (funcall fn arg buf)
 180     (make-instance 'stat :pointer buf)))
 181
 182 (defentrypoint %sys-stat (path)
 183   "Get information about a file."
 184   (funcall-stat #'%%sys-stat path))
 185
 186 (defentrypoint %sys-fstat (fd)
 187   "Get information about a file descriptor"
 188   (funcall-stat #'%%sys-fstat fd))
 189
 190 (defentrypoint %sys-lstat (path)
 191   "Get information about a file or symlink."
 192   (funcall-stat #'%%sys-lstat path))
 193
 194 (defsyscall ("sync" %sys-sync) :void
 195   "Schedule all file system buffers to be written to disk.")
 196
 197 (defsyscall* ("fsync" %sys-fsync) :int
 198   (fildes :int))
 199
 200 (defsyscall ("mkstemp" %%sys-mkstemp) :int
 201   (template filename-designator))
 202
 203 (defentrypoint %sys-mkstemp (&optional (template ""))
 204   (let ((template (concatenate 'string template "XXXXXX")))
 205     (with-foreign-string (ptr (filename template))
 206       (values (%%sys-mkstemp ptr) (foreign-string-to-lisp ptr)))))
 207 \f
 208
 209 ;;;-----------------------------------------------------------------------------
 210 ;;; Directories
 211 ;;;-----------------------------------------------------------------------------
 212
 213 (defsyscall "mkdir" :int
 214   "Create a directory."
 215   (path filename-designator)
 216   (mode mode-t))
 217
 218 (defsyscall ("rmdir" %sys-rmdir) :int
 219   (path filename-designator))
 220
 221 (defsyscall ("chdir" %sys-chdir) :int
 222   "Changes the current working directory"
 223   (path filename-designator))
 224
 225 (defsyscall* ("fchdir" %sys-fchdir) :int
 226   (fildes :int))
 227
 228 (defsyscall ("getcwd" %%sys-getcwd) :string
 229   (buf :pointer)
 230   (size size-t))
 231
 232 (defentrypoint %sys-getcwd ()
 233   "Returns the current working directory as a string."
 234   (with-foreign-pointer (buf path-max size)
 235     (%%sys-getcwd buf size)))
 236
 237 (defsyscall ("mkdtemp" %%sys-mkdtemp) :int
 238   (template filename-designator))
 239
 240 (defentrypoint %sys-mkdtemp (&optional (template ""))
 241   (let ((template (concatenate 'string template "XXXXXX")))
 242     (with-foreign-string (ptr (filename template))
 243       (values (%%sys-mkdtemp ptr) (foreign-string-to-lisp ptr)))))
 244 \f
 245
 246 ;;;-----------------------------------------------------------------------------
 247 ;;; File Descriptors
 248 ;;;-----------------------------------------------------------------------------
 249
 250 (defsyscall ("close" %sys-close) :int
 251   "Close an open file descriptor."
 252   (fd :int))
 253
 254 (defsyscall ("dup" %sys-dup) :int
 255   (fildes :int))
 256
 257 (defsyscall* ("dup2" %sys-dup2) :int
 258   (fildes1 :int)
 259   (fildes2 :int))
 260
 261 (defsyscall* ("ioctl" %sys-ioctl/2) :int
 262   (fd      :int)
 263   (request :int))
 264
 265 (defsyscall* ("ioctl" %sys-ioctl/3) :int
 266  (fd      :int)
 267  (request :int)
 268  (arg     :pointer))
 269
 270 (defentrypoint %sys-fd-open-p (fd)
 271   (not (minusp (%sys-fstat fd))))
 272 \f
 273
 274 ;;;-----------------------------------------------------------------------------
 275 ;;; File descriptor polling
 276 ;;;-----------------------------------------------------------------------------
 277
 278 ;;; FIXME: Until a way to autodetect platform features is implemented
 279 #+(or darwin freebsd)
 280 (define-constant pollrdhup 0)
 281
 282 (defsyscall ("poll" %sys-poll) :int
 283   "Scan for I/O activity on multiple file descriptors."
 284   (fds     :pointer)
 285   (nfds    nfds-t)
 286   (timeout :int))
 287 \f
 288
 289 ;;;-----------------------------------------------------------------------------
 290 ;;; Memory mapping
 291 ;;;-----------------------------------------------------------------------------
 292
 293 (defsyscall ("munmap" %sys-munmap) :int
 294   "Unmap pages of memory."
 295   (addr :pointer)
 296   (len  size-t))
 297 \f
 298
 299 ;;;-----------------------------------------------------------------------------
 300 ;;; Time
 301 ;;;-----------------------------------------------------------------------------
 302
 303 (defsyscall* ("usleep" %sys-usleep) :int
 304   (useconds useconds-t))
 305
 306 (defsyscall ("time" %%sys-time) time-t
 307   (tloc :pointer))
 308
 309 (defentrypoint %sys-time ()
 310   (%%sys-time (null-pointer)))
 311
 312 (defsyscall ("gettimeofday" %%sys-gettimeofday) :int
 313   (tp  :pointer)
 314   (tzp :pointer))
 315
 316 (defentrypoint %sys-gettimeofday ()
 317   "Return the time in seconds and microseconds."
 318   (with-foreign-object (tv 'timeval)
 319     (with-foreign-slots ((sec usec) tv timeval)
 320       (%%sys-gettimeofday tv (null-pointer))
 321       (values sec usec))))
 322
 323 ;;; FIXME: or we can implement this through the MACH functions.
 324 #+darwin
 325 (progn
 326   (defctype kern-return-t :int)
 327   (defctype clock-res-t :int)
 328   (defctype clock-id-t :int)
 329   (defctype port-t :unsigned-int)         ; not sure
 330   (defctype clock-serv-t port)
 331
 332   (defconstant kern-success 0)
 333
 334   (defconstant system-clock 0)
 335   (defconstant calendar-clock 1)
 336   (defconstant realtime-clock 0)
 337
 338   (defsyscall ("mach_host_self" %sys-mach-host-self) port-t)
 339
 340   (defsyscall ("host_get_clock_service" %%sys-host-get-clock-service) kern-return-t
 341     (host port-t)
 342     (id clock-id-t)
 343     (clock-name (:pointer clock-serv-t)))
 344
 345   (defentrypoint %sys-host-get-clock-service (id &optional (host (%sys-mach-host-self)))
 346     (with-foreign-object (clock 'clock-serv-t)
 347       (%%sys-host-get-clock-service host id clock)
 348       (mem-ref clock :int)))
 349
 350   (defsyscall ("clock_get_time" %clock-get-time) kern-return-t
 351     (clock-serv clock-serv-t)
 352     (cur-time timespec))
 353
 354   (defentrypoint clock-get-time (clock-service)
 355     (with-foreign-object (time 'timespec)
 356       (%clock-get-time clock-service time)
 357       (with-foreign-slots ((tv-sec tv-nsec) time timespec)
 358         (values tv-sec tv-nsec)))))
 359
 360 #-darwin
 361 (progn
 362   (defsyscall ("clock_getres" %%sys-clock-getres) :int
 363     "Returns the resolution of the clock CLOCKID."
 364     (clockid clockid-t)
 365     (res     :pointer))
 366
 367   (defentrypoint %sys-clock-getres (clock-id)
 368     (with-foreign-object (ts 'timespec)
 369       (with-foreign-slots ((sec nsec) ts timespec)
 370         (%%sys-clock-getres clock-id ts)
 371         (values sec nsec))))
 372
 373   (defsyscall ("clock_gettime" %%sys-clock-gettime) :int
 374     (clockid clockid-t)
 375     (tp      :pointer))
 376
 377   (defentrypoint %sys-clock-gettime (clock-id)
 378     "Returns the time of the clock CLOCKID."
 379     (with-foreign-object (ts 'timespec)
 380       (with-foreign-slots ((sec nsec) ts timespec)
 381         (%%sys-clock-gettime clock-id ts)
 382         (values sec nsec))))
 383
 384   (defsyscall ("clock_settime" %%sys-clock-settime) :int
 385     (clockid clockid-t)
 386     (tp      :pointer))
 387
 388   (defentrypoint %sys-clock-settime (clock-id)
 389     "Sets the time of the clock CLOCKID."
 390     (with-foreign-object (ts 'timespec)
 391       (with-foreign-slots ((sec nsec) ts timespec)
 392         (%%sys-clock-settime clock-id ts)
 393         (values sec nsec)))))
 394
 395 (defentrypoint %sys-get-monotonic-time ()
 396   "Gets current time in seconds from a system's monotonic clock."
 397   (multiple-value-bind (seconds nanoseconds)
 398       #-darwin (%sys-clock-gettime clock-monotonic)
 399       #+darwin (%sys-clock-get-time (%sys-host-get-clock-service system-clock))
 400     (+ seconds (/ nanoseconds 1d9))))
 401 \f
 402
 403 ;;;-----------------------------------------------------------------------------
 404 ;;; Environement
 405 ;;;-----------------------------------------------------------------------------
 406
 407 (defcvar ("environ" :read-only t) (:pointer :string))
 408
 409 (defsyscall ("getenv" %sys-getenv) :string
 410   "Returns the value of an environment variable"
 411   (name :string))
 412
 413 (defsyscall ("setenv" %sys-setenv) :int
 414   "Changes the value of an environment variable"
 415   (name      :string)
 416   (value     :string)
 417   (overwrite bool-designator))
 418
 419 (defsyscall ("unsetenv" %sys-unsetenv) :int
 420   "Removes the binding of an environment variable"
 421   (name :string))
 422 \f
 423
 424 ;;;-----------------------------------------------------------------------------
 425 ;;; Local info
 426 ;;;-----------------------------------------------------------------------------
 427
 428 (defsyscall ("gethostname" %%sys-gethostname) :int
 429   (name    :pointer)
 430   (namelen size-t))
 431
 432 (defentrypoint %sys-gethostname ()
 433   (with-foreign-pointer-as-string ((cstr size) 256)
 434     (%%sys-gethostname cstr size)))
 435
 436 (defsyscall ("getdomainname" %%sys-getdomainname) :int
 437   (name    :pointer)
 438   (namelen size-t))
 439
 440 (defentrypoint %sys-getdomainname ()
 441   (with-foreign-pointer-as-string ((cstr size) 256)
 442     (%%sys-getdomainname cstr size)))