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