use CFFI, mostly via Osicat, for all syscalls/libc except fork(2)

Also replace some calls to chmod(1) with calls to chmod(2).

Using CFFI rather than implementation-specific wrappers should be better for
portability.  Also with this commit we stop hard coding types like uid_t as
:UNSIGNED-INT, which was less portable.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

7 files changed, 28 insertions, 70 deletions

diff --git a/src/connection/as.lisp b/src/connection/as.lisp
index 229d238..0a15cf8 100644
--- a/src/connection/as.lisp
+++ b/src/connection/as.lisp
@@ -21,7 +21,7 @@
 ;; currently we only check whether we're root, but, for example, on Linux, we
 ;; might have a CAP_* which lets us setuid as non-root
 (defun can-setuid ()
-  (zerop (foreign-funcall "geteuid" :unsigned-int)))
+  (zerop (nix:geteuid)))
 
 (defmethod establish-connection ((type (eql :as)) remaining &key to)
   "Establish a :SETUID or :SU connection to another user account, depending on
diff --git a/src/connection/chroot.lisp b/src/connection/chroot.lisp
index 70a603d..6b3f29e 100644
--- a/src/connection/chroot.lisp
+++ b/src/connection/chroot.lisp
@@ -21,7 +21,7 @@
 ;; currently we only check whether we're root, but, for example, on Linux, we
 ;; might have a CAP_* which lets us chroot as non-root
 (defun can-chroot ()
-  (zerop (foreign-funcall "geteuid" :unsigned-int)))
+  (zerop (nix:geteuid)))
 
 (defmethod establish-connection ((type (eql :chroot)) remaining &key into)
   (establish-connection (if (and (lisp-connection-p) (can-chroot))
@@ -97,16 +97,11 @@ should be the mount point, without the chroot's root prefixed.")
 
 ;;;; :CHROOT.FORK
 
-(defun chroot (path)
-  #+sbcl      (sb-posix:chroot path)
-  #-(or sbcl) (foreign-funcall "chroot" :string path :int))
-
 (defclass chroot.fork-connection
     (rehome-connection chroot-connection fork-connection) ())
 
 (defmethod establish-connection ((type (eql :chroot.fork)) remaining &key into)
-  (unless (and (lisp-connection-p)
-               (zerop (foreign-funcall "geteuid" :unsigned-int)))
+  (unless (and (lisp-connection-p) (zerop (nix:geteuid)))
     (error "~&Forking into a chroot requires a Lisp image running as root"))
   (informat 1 "~&Forking into chroot at ~A" into)
   (let* ((into (ensure-pathname into :want-absolute t :ensure-directory t))
@@ -125,8 +120,10 @@ should be the mount point, without the chroot's root prefixed.")
       (connection-teardown connection))))
 
 (defmethod post-fork ((connection chroot.fork-connection))
-  (unless (zerop (chroot (slot-value connection 'into)))
-    (error "chroot(2) failed!"))
+  (with-slots (into) connection
+    (unless (zerop
+             (foreign-funcall "chroot" :string (unix-namestring into) :int))
+      (error "chroot(2) failed!")))
   (let ((home (connection-connattr connection :remote-home)))
     (setf (getenv "HOME") (unix-namestring home))
     ;; chdir, else our current working directory is a pointer to something
diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index 41944ff..1d70adc 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -57,7 +57,7 @@
   (with-remote-temporary-file
       (temp :connection connection
             :directory (pathname-directory-pathname path))
-    (run-program `("chmod" ,(format nil "~O" mode) ,temp))
+    (nix:chmod temp mode)
     (etypecase content
       (string
        (with-open-file (stream temp :direction :output :if-exists :supersede)
diff --git a/src/connection/sbcl.lisp b/src/connection/sbcl.lisp
index ed68243..206b5ab 100644
--- a/src/connection/sbcl.lisp
+++ b/src/connection/sbcl.lisp
@@ -20,7 +20,7 @@
 
 (defproplist sbcl-available :posix ()
   (os:etypecase
-    (debianlike (apt:installed "sbcl"))))
+    (debianlike (apt:installed "sbcl" "build-essential"))))
 
 (defparameter *sbcl* '("sbcl" "--noinform" "--noprint"
                        "--disable-debugger" "--no-sysinit" "--no-userinit"))
diff --git a/src/connection/setuid.lisp b/src/connection/setuid.lisp
index 3e835e0..f0e17d8 100644
--- a/src/connection/setuid.lisp
+++ b/src/connection/setuid.lisp
@@ -18,22 +18,10 @@
 (in-package :consfigurator.connection.setuid)
 (named-readtables:in-readtable :consfigurator)
 
-(defun setuid (uid)
-  #+sbcl      (sb-posix:setuid uid)
-  #-(or sbcl) (foreign-funcall "setuid" :unsigned-int uid :int))
-
-(defun setgid (gid)
-  #+sbcl      (sb-posix:setgid gid)
-  #-(or sbcl) (foreign-funcall "setgid" :unsigned-int uid :int))
-
-(defun initgroups (user gid)
-  (foreign-funcall "initgroups" :string user :unsigned-int gid :int))
-
 (defclass setuid-connection (rehome-connection fork-connection) ())
 
 (defmethod establish-connection ((type (eql :setuid)) remaining &key to)
-  (unless (and (lisp-connection-p)
-               (zerop (foreign-funcall "geteuid" :unsigned-int)))
+  (unless (and (lisp-connection-p) (zerop (nix:geteuid)))
     (error "~&SETUIDing requires a Lisp image running as root"))
   (informat 1 "~&SETUIDing to ~A" to)
   (multiple-value-bind (match groups)
@@ -72,9 +60,4 @@
     (posix-login-environment
      user (connection-connattr connection :remote-home))
     ;; We are privileged, so this sets the real, effective and saved IDs.
-    (unless (zerop (setgid gid))
-      (error "setgid(2) failed!"))
-    (unless (zerop (initgroups user gid))
-      (error "initgroups(3) failed!"))
-    (unless (zerop (setuid uid))
-      (error "setuid(2) failed!"))))
+    (nix:setgid gid) (nix:initgroups user gid) (nix:setuid uid)))
diff --git a/src/image.lisp b/src/image.lisp
index fc29179..cbd63c5 100644
--- a/src/image.lisp
+++ b/src/image.lisp
@@ -99,7 +99,7 @@ Thus, PREREQUEST must not start up any threads."
        ,@forms)))
 
 (defun dump-consfigurator (filename form)
-  (umask #o077)
+  (nix:umask #o077)
   (uiop:register-image-restore-hook (lambda () (eval form)) nil)
   (uiop:dump-image filename :executable t))
 
@@ -150,7 +150,7 @@ already running from FILENAME."
                   (eql :linux (uiop:operating-system))
                   (pathname-equal file (resolve-symlinks "/proc/self/exe")))
        (unless filename
-         (mrun "chmod" "0700" (pathname-directory-pathname file)))
+         (nix:chmod #o700 (unix-namestring (pathname-directory-pathname file))))
        (if form
            (dump-consfigurator-in-grandchild file form)
            (dump-consfigurator-in-grandchild file))))
@@ -183,7 +183,7 @@ already running from FILENAME."
                    #'force-output
                    *standard-output* *error-output* *debug-io* *terminal-io*)
                when (zerop (fork))
-                 do (setsid)
+                 do (nix:setsid)
                     (close ,fork-control)
                     (handle-fork-request input output)
                     (uiop:quit))
@@ -197,8 +197,9 @@ already running from FILENAME."
          (delete-file ,fork-control)
          (unwind-protect (progn ,@forms)
            (close *fork-control*)
-           (let ((status (nth-value 1 (waitpid child 0))))
-             (unless (and (wifexited status) (zerop (wexitstatus status)))
+           (let ((status (nth-value 1 (nix:waitpid child))))
+             (unless
+                 (and (nix:WIFEXITED status) (zerop (nix:WEXITSTATUS status)))
                (error "Fork control child did not exit zero."))))))))
 
 ;; IPC security considerations
@@ -258,8 +259,8 @@ already running from FILENAME."
     (unwind-protect
          (with-open-file (out out :element-type 'character)
            (with-open-file (err err :element-type 'character)
-             (let ((status (nth-value 1 (waitpid child 0))))
-               (unless (wifexited status)
+             (let ((status (nth-value 1 (nix:waitpid child))))
+               (unless (nix:WIFEXITED status)
                  (failed-change
                   "~&Grandchild process did not exit normally, status #x~(~4,'0X~)."
                   status))
@@ -268,7 +269,7 @@ already running from FILENAME."
                                               :element-type 'character)
                  (write-to-mkfifo (list (slurp-stream-string out)
                                         (slurp-stream-string err)
-                                        (wexitstatus status))
+                                        (nix:WEXITSTATUS status))
                                   output)))))
       (delete-file out) (delete-file err))))
 
diff --git a/src/util.lisp b/src/util.lisp
index f498352..74e2801 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -370,15 +370,7 @@ expansion as a starting point for your own DEFPACKAGE form for your consfig."
                             (char +alphanum+ (random #.(length +alphanum+))))
                    finally (return result)))
            (mkfifo (temp)
-             (handler-case
-                 (progn
-                   #+sbcl (sb-posix:mkfifo temp #o600)
-                   #-(or sbcl)
-                   (unless (zerop
-                            (foreign-funcall
-                             "mkfifo" :string temp :unsigned-int #o600 :int))
-                     (error "mkfifo(3) failed!"))
-                   t)
+             (handler-case (nix:mkfifo temp #o600)
                (serious-condition (c)
                  (if (or (file-exists-p temp) (directory-exists-p temp))
                      nil
@@ -507,31 +499,16 @@ previous output."
 
 ;;;; Forking utilities
 
-;;; Use only implementation-specific fork, waitpid etc. calls to avoid thread
-;;; woes.  Things like chroot(2) and setuid(2), however, should be okay.
+;;; Use implementation-specific fork(2) wrapper, and never fork(2) itself, to
+;;; allow the implementation to handle things like finaliser threads.  For all
+;;; other syscalls/libc & POSIX macros like WIFEXITED, use CFFI, via Osicat
+;;; when there's a wrapper available, for portability.
 
 (defun fork ()
   ;; Normalise any other implementations such that we signal an error if
   ;; fork(2) returns -1, so caller doesn't have to check for that.
   #+sbcl (sb-posix:fork))
 
-(defun waitpid (pid options)
-  ;; Normalise any other implementations such that we always return (values
-  ;; PID EXIT-STATUS), as SB-POSIX:WAITPID does.
-  #+sbcl (sb-posix:waitpid pid options))
-
-(defun wifexited (status)
-  #+sbcl (sb-posix:wifexited status))
-
-(defun wexitstatus (status)
-  #+sbcl (sb-posix:wexitstatus status))
-
-(defun setsid ()
-  #+sbcl (sb-posix:setsid))
-
-(defun umask (mode)
-  #+sbcl (sb-posix:umask mode))
-
 (defmacro forked-progn (child-pid child-form &body parent-forms)
   (with-gensyms (retval)
     `(progn
@@ -600,9 +577,9 @@ interactive debugger."))
 (defun posix-login-environment (logname home)
   "Reset the environment after switching UID, or similar, in a :LISP connection.
 Does not currently establish a PAM session."
-  (let ((euid (foreign-funcall "geteuid" :unsigned-int))
+  (let ((rootp (zerop (nix:geteuid)))
         (maybe-preserve '("TERM")))
-    (when (zerop euid)
+    (when rootp
       (push "SSH_AUTH_SOCK" maybe-preserve))
     (let ((preserved (loop for var in maybe-preserve
                            for val = (getenv var)
@@ -615,7 +592,7 @@ Does not currently establish a PAM session."
           (getenv "LOGNAME") logname
           (getenv "SHELL") "/bin/sh"
           (getenv "PATH")
-          (if (zerop euid)
+          (if rootp
               "/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
               "/usr/local/bin:/bin:/usr/bin"))
     (uiop:chdir home)))