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     (%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-without-arg) :int
 262   (fd      :int)
 263   (request :int))
 264
 265 (defsyscall* ("ioctl" %%sys-ioctl-with-arg) :int
 266  (fd      :int)
 267  (request :int)
 268  (arg     :pointer))
 269
 270 (defentrypoint %sys-ioctl (fd request &optional (arg nil argp))
 271   "Control device."
 272   (cond
 273     ((not argp) (%%sys-ioctl-without-arg fd request))
 274     ((pointerp arg) (%%sys-ioctl-with-arg fd request arg))
 275     (t (error "Wrong argument to ioctl: ~S" arg))))
 276
 277 (defentrypoint %sys-fd-open-p (fd)
 278   (not (minusp (%sys-fstat fd))))
 279 \f
 280
 281 ;;;-----------------------------------------------------------------------------
 282 ;;; File descriptor polling
 283 ;;;-----------------------------------------------------------------------------
 284
 285 ;;; FIXME: Until a way to autodetect platform features is implemented
 286 #+(or darwin freebsd)
 287 (define-constant pollrdhup 0)
 288
 289 (defsyscall ("poll" %sys-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 ;;; Memory mapping
 298 ;;;-----------------------------------------------------------------------------
 299
 300 (defsyscall ("munmap" %sys-munmap) :int
 301   "Unmap pages of memory."
 302   (addr :pointer)
 303   (len  size-t))
 304 \f
 305
 306 ;;;-----------------------------------------------------------------------------
 307 ;;; Time
 308 ;;;-----------------------------------------------------------------------------
 309
 310 (defsyscall* ("usleep" %sys-usleep) :int
 311   (useconds useconds-t))
 312
 313 (defsyscall ("time" %%sys-time) time-t
 314   (tloc :pointer))
 315
 316 (defentrypoint %sys-time ()
 317   (%%sys-time (null-pointer)))
 318
 319 (defsyscall ("gettimeofday" %%sys-gettimeofday) :int
 320   (tp  :pointer)
 321   (tzp :pointer))
 322
 323 (defentrypoint %sys-gettimeofday ()
 324   "Return the time in seconds and microseconds."
 325   (with-foreign-object (tv 'timeval)
 326     (with-foreign-slots ((sec usec) tv timeval)
 327       (%%sys-gettimeofday tv (null-pointer))
 328       (values sec usec))))
 329
 330 ;;; FIXME: or we can implement this through the MACH functions.
 331 #+darwin
 332 (progn
 333   (defctype kern-return-t :int)
 334   (defctype clock-res-t :int)
 335   (defctype clock-id-t :int)
 336   (defctype port-t :unsigned-int)         ; not sure
 337   (defctype clock-serv-t port)
 338
 339   (defconstant kern-success 0)
 340
 341   (defconstant system-clock 0)
 342   (defconstant calendar-clock 1)
 343   (defconstant realtime-clock 0)
 344
 345   (defsyscall ("mach_host_self" %sys-mach-host-self) port-t)
 346
 347   (defsyscall ("host_get_clock_service" %%sys-host-get-clock-service) kern-return-t
 348     (host port-t)
 349     (id clock-id-t)
 350     (clock-name (:pointer clock-serv-t)))
 351
 352   (defentrypoint %sys-host-get-clock-service (id &optional (host (%sys-mach-host-self)))
 353     (with-foreign-object (clock 'clock-serv-t)
 354       (%%sys-host-get-clock-service host id clock)
 355       (mem-ref clock :int)))
 356
 357   (defsyscall ("clock_get_time" %clock-get-time) kern-return-t
 358     (clock-serv clock-serv-t)
 359     (cur-time timespec))
 360
 361   (defentrypoint clock-get-time (clock-service)
 362     (with-foreign-object (time 'timespec)
 363       (%clock-get-time clock-service time)
 364       (with-foreign-slots ((tv-sec tv-nsec) time timespec)
 365         (values tv-sec tv-nsec)))))
 366
 367 #-darwin
 368 (progn
 369   (defsyscall ("clock_getres" %%sys-clock-getres) :int
 370     "Returns the resolution of the clock CLOCKID."
 371     (clockid clockid-t)
 372     (res     :pointer))
 373
 374   (defentrypoint %sys-clock-getres (clock-id)
 375     (with-foreign-object (ts 'timespec)
 376       (with-foreign-slots ((sec nsec) ts timespec)
 377         (%%sys-clock-getres clock-id ts)
 378         (values sec nsec))))
 379
 380   (defsyscall ("clock_gettime" %%sys-clock-gettime) :int
 381     (clockid clockid-t)
 382     (tp      :pointer))
 383
 384   (defentrypoint %sys-clock-gettime (clock-id)
 385     "Returns the time of the clock CLOCKID."
 386     (with-foreign-object (ts 'timespec)
 387       (with-foreign-slots ((sec nsec) ts timespec)
 388         (%%sys-clock-gettime clock-id ts)
 389         (values sec nsec))))
 390
 391   (defsyscall ("clock_settime" %%sys-clock-settime) :int
 392     (clockid clockid-t)
 393     (tp      :pointer))
 394
 395   (defentrypoint %sys-clock-settime (clock-id)
 396     "Sets the time of the clock CLOCKID."
 397     (with-foreign-object (ts 'timespec)
 398       (with-foreign-slots ((sec nsec) ts timespec)
 399         (%%sys-clock-settime clock-id ts)
 400         (values sec nsec)))))
 401
 402 (defentrypoint %sys-get-monotonic-time ()
 403   "Gets current time in seconds from a system's monotonic clock."
 404   (multiple-value-bind (seconds nanoseconds)
 405       #-darwin (%sys-clock-gettime clock-monotonic)
 406       #+darwin (%sys-clock-get-time (%sys-host-get-clock-service system-clock))
 407     (+ seconds (/ nanoseconds 1d9))))
 408 \f
 409
 410 ;;;-----------------------------------------------------------------------------
 411 ;;; Environement
 412 ;;;-----------------------------------------------------------------------------
 413
 414 (defcvar ("environ" :read-only t) (:pointer :string))
 415
 416 (defsyscall ("getenv" %sys-getenv) :string
 417   "Returns the value of an environment variable"
 418   (name :string))
 419
 420 (defsyscall ("setenv" %sys-setenv) :int
 421   "Changes the value of an environment variable"
 422   (name      :string)
 423   (value     :string)
 424   (overwrite bool-designator))
 425
 426 (defsyscall ("unsetenv" %sys-unsetenv) :int
 427   "Removes the binding of an environment variable"
 428   (name :string))
 429 \f
 430
 431 ;;;-----------------------------------------------------------------------------
 432 ;;; Local info
 433 ;;;-----------------------------------------------------------------------------
 434
 435 (defsyscall ("gethostname" %%sys-gethostname) :int
 436   (name    :pointer)
 437   (namelen size-t))
 438
 439 (defentrypoint %sys-gethostname ()
 440   (with-foreign-pointer-as-string ((cstr size) 256)
 441     (%%sys-gethostname cstr size)))
 442
 443 (defsyscall ("getdomainname" %%sys-getdomainname) :int
 444   (name    :pointer)
 445   (namelen size-t))
 446
 447 (defentrypoint %sys-getdomainname ()
 448   (with-foreign-pointer-as-string ((cstr size) 256)
 449     (%%sys-getdomainname cstr size)))