Commit 39123298c928e81d1af5bb66cebe5555d146f87a

Thomas de Grivel 2018-02-03T17:22:15

Exhaustively export unistd.h from Linux.

diff --git a/cffi-unistd.lisp b/cffi-unistd.lisp
index 7f8c644..ec4ea41 100644
--- a/cffi-unistd.lisp
+++ b/cffi-unistd.lisp
@@ -28,6 +28,16 @@
       (error-errno "access"))
     r))
 
+(defcfun ("euidaccess" c-euidaccess) :int
+  (name :string)
+  (type :int))
+
+(defun euidaccess (name type)
+  (let ((r (c-euidaccess name type)))
+    (when (< r 0)
+      (error-errno "access"))
+    r))
+
 (defcfun ("lseek" c-lseek) off-t
   (fd :int)
   (offset off-t)
@@ -96,6 +106,34 @@ or number of bytes written otherwise."
             (error-errno "write"))
         r)))
 
+(defcfun ("pread" c-pread) ssize-t
+  (fd :int)
+  (buf :pointer)
+  (nbytes size-t)
+  (offset off-t))
+
+(defun pread (fd buf nbytes offset)
+  "Reads at most COUNT bytes from FD into BUF at position OFFSET
+without changing file pointer. Returns number of bytes read."
+  (let ((r (c-pread fd buf nbytes offset)))
+    (when (< r 0)
+      (error-errno "pread"))
+    r))
+
+(defcfun ("pwrite" c-pwrite) ssize-t
+  (fd :int)
+  (buf :pointer)
+  (n size-t)
+  (offset off-t))
+
+(defun pwrite (fd buf count offset)
+  "Writes at most COUNT bytes from BUF into FD at position OFFSET
+without changing the file pointer. Returns number of bytes written."
+  (let ((r (c-pwrite fd buf count offset)))
+    (when (< r 0)
+      (error-errno "pwrite"))
+    r))
+
 (defcfun ("pipe" c-pipe) :int
   (pipefd (:pointer :int)))
 
@@ -108,10 +146,145 @@ or number of bytes written otherwise."
               (mem-aref fd :int 1)))))
 
 (defmacro with-pipe ((in-var out-var) &body body)
-  `(multiple-value-bind (,in-var ,out-var) (pipe)
-     (unwind-protect (progn ,@body)
-       (close ,out-var)
-       (close ,in-var))))
+  (let ((in (gensym "IN-"))
+        (out (gensym "OUT-")))
+    `(multiple-value-bind (,in ,out) (pipe)
+       (unwind-protect (let ((,in-var ,in)
+                             (,out-var ,out))
+                         ,@body)
+         (close ,out)
+         (close ,in)))))
+
+(defcfun ("pipe2" c-pipe2) :int
+  (pipefd (:pointer :int))
+  (flags :int))
+
+(defun pipe2 (flags)
+  (with-foreign-object (fd :int 2)
+    (let ((r (c-pipe2 fd flags)))
+      (when (< r 0)
+        (error-errno "pipe2"))
+      (values (mem-aref fd :int 0)
+              (mem-aref fd :int 1)))))
+
+(defmacro with-pipe2 ((in-var out-var flags) &body body)
+  (let ((in (gensym "IN-"))
+        (out (gensym "OUT-")))
+    `(multiple-value-bind (,in ,out) (pipe2 ,flags)
+       (unwind-protect (let ((,in-var ,in)
+                             (,out-var ,out))
+                         ,@body)
+         (close ,out)
+         (close ,in)))))
+
+(defcfun ("alarm" c-alarm) :unsigned-int
+  (seconds :unsigned-int))
+
+(defun alarm (seconds)
+  (c-alarm seconds))
+
+(defcfun ("sleep" c-sleep) :unsigned-int
+  (seconds :unsigned-int))
+
+(defun sleep (seconds)
+  (c-sleep seconds))
+
+(defcfun ("ualarm" c-ualarm) useconds-t
+  (value useconds-t)
+  (interval useconds-t))
+
+(defun ualarm (value interval)
+  (c-ualarm value interval))
+
+(defcfun ("usleep" c-usleep) useconds-t
+  (useconds useconds-t))
+
+(defun usleep (useconds)
+  (c-usleep useconds))
+
+(defcfun ("pause" c-pause) :int)
+
+(defun pause ()
+  (c-pause))
+
+(defcfun ("chown" c-chown) :int
+  (file :string)
+  (owner uid-t)
+  (group gid-t))
+
+(defun chown (path owner group)
+  (let ((r (c-chown path owner group)))
+    (when (< r 0)
+      (error-errno "chown"))
+    r))
+
+(defcfun ("fchown" c-fchown) :int
+  (fd :int)
+  (owner uid-t)
+  (group gid-t))
+
+(defun fchown (fd owner group)
+  (let ((r (c-fchown fd owner group)))
+    (when (< r 0)
+      (error-errno "fchown"))
+    r))
+
+(defcfun ("lchown" c-lchown) :int
+  (file :string)
+  (owner uid-t)
+  (group gid-t))
+
+(defun lchown (path owner group)
+  (let ((r (c-lchown path owner group)))
+    (when (< r 0)
+      (error-errno "lchown"))
+    r))
+
+(defcfun ("fchownat" c-fchownat) :int
+  (fd :int)
+  (file :string)
+  (owner uid-t)
+  (group gid-t)
+  (flag :int))
+
+(defun fchownat (fd path owner group flag)
+  (let ((r (c-fchownat fd path owner group flag)))
+    (when (< r 0)
+      (error-errno "fchownat"))
+    r))
+
+(defcfun ("chdir" c-chdir) :int
+  (path :string))
+
+(defun chdir (path)
+  (let ((r (c-chdir path)))
+    (when (< r 0)
+      (error-errno "chdir"))
+    r))
+
+(defcfun ("fchdir" c-fchdir) :int
+  (fd :int))
+
+(defun fchdir (fd)
+  (let ((r (c-fchdir fd)))
+    (when (< r 0)
+      (error-errno "fchdir"))
+    r))
+
+(defcfun ("getcwd" c-getcwd) :string
+  (buf :string)
+  (size size-t))
+
+(defvar *path-max* 4096)
+
+(defun getcwd ()
+  (let* ((len (or (ignore-errors (the integer *path-max*))
+                  4096))
+         (s (make-string len)))
+    (let ((r (c-getcwd s len)))
+      (unless r
+        (error-errno "getcwd"))
+      r)))
 
 (defcfun ("dup" c-dup) :int
   (oldfd :int))
@@ -122,6 +295,43 @@ or number of bytes written otherwise."
       (error-errno "dup"))
     r))
 
+(defcfun ("dup2" c-dup2) :int
+  (fd :int)
+  (fd2 :int))
+
+(defun dup2 (fd fd2)
+  (let ((r (c-dup2 fd fd2)))
+    (when (< r 0)
+      (error-errno "dup2"))
+    r))
+
+(defcfun ("dup3" c-dup3) :int
+  (fd :int)
+  (fd2 :int)
+  (flags :int))
+
+(defun dup3 (fd fd2 flags)
+  (let ((r (c-dup3 fd fd2 flags)))
+    (when (< r 0)
+      (error-errno "dup3"))
+    r))
+
+(defcvar ("environ" c-environ) (:pointer :string)
+  "NULL-terminated array of \"NAME=VALUE\" environment variables.")
+
+(defun environ ()
+  (let ((env c-environ)
+        (list ()))
+    (loop
+       (when (null-pointer-p env)
+         (return))
+       (push (mem-aref env '(:pointer :string)) list)
+       (setf env (mem-aptr env '(:pointer :string) 1)))
+    list))
+
+#+test
+(environ)
+
 ;;  Select
 
 (defcstruct fd-set
diff --git a/package.lisp b/package.lisp
index 1585cf2..1d921bf 100644
--- a/package.lisp
+++ b/package.lisp
@@ -27,42 +27,100 @@
   (:shadow
    #:close
    #:read
+   #:sleep
    #:write)
   (:export
+   #:+f-ok+
+   #:+fd-setsize+
+   #:+nfdbits+
+   #:+r-ok+
+   #:+seek-set+
+   #:+seek-cur+
+   #:+seek-end+
+   #:+seek-data+
+   #:+seek-hole+
+   #:+stderr-fileno+
    #:+stdin-fileno+
    #:+stdout-fileno+
-   #:+stderr-fileno+
-   #:c-access
+   #:+w-ok+
+   #:+x-ok+
    #:access
+   #:alarm
+   #:c-access
+   #:c-alarm
+   #:c-chdir
+   #:c-chown
+   #:c-close
+   #:c-dup
+   #:c-dup2
+   #:c-dup3
+   #:c-environ
+   #:c-euidaccess
+   #:c-fchdir
+   #:c-fchown
+   #:c-fchownat
+   #:c-getcwd
+   #:c-lchown
    #:c-lseek
-   #:lseek
+   #:c-pause
+   #:c-pipe
+   #:c-pipe2
+   #:c-pread
+   #:c-pwrite
    #:c-read
-   #:read
-   #:read-non-blocking
-   #:c-close
-   #:close
+   #:c-select
+   #:c-sleep
+   #:c-ualarm
+   #:c-usleep
    #:c-write
-   #:write
-   #:write-non-blocking
-   #:c-pipe
-   #:pipe
-   #:with-pipe
+   #:chdir
+   #:chown
+   #:close
    #:dup
-   #:fd-set
-   #:fds-bits
-   #:fd-mask
-   #:+fd-setsize+
-   #:+nfdbits+
-   #:fd-elt
+   #:dup2
+   #:dup3
+   #:environ
+   #:euidaccess
+   #:fchdir
+   #:fchown
+   #:fchownat
    #:fd-clr
+   #:fd-elt
    #:fd-isset
+   #:fd-mask
    #:fd-set
+   #:fd-set-filter
    #:fd-zero
+   #:fds-bits
+   #:getcwd
+   #:gid-t
+   #:intptr-t
+   #:lchown
+   #:list-to-fd-set
+   #:lseek
+   #:off-t
+   #:pause
+   #:pid-t
+   #:pipe
+   #:pipe2
+   #:pread
+   #:pwrite
+   #:read
+   #:read-non-blocking
+   #:seconds-to-timeval
+   #:select
+   #:size-t
+   #:sleep
+   #:socklen-t
+   #:ssize-t
    #:timeval
    #:tv-sec
    #:tv-usec
-   #:select
-   #:list-to-fd-set
-   #:seconds-to-timeval
-   #:fd-set-filter
-   #:with-selected))
+   #:ualarm
+   #:uid-t
+   #:useconds-t
+   #:usleep
+   #:with-pipe
+   #:with-selected
+   #:write
+   #:write-non-blocking))