From 3e4a8149efbf7d6515ec6ac542ee8882320763d0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 26 Jul 2021 14:06:58 -0700 Subject: 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 --- src/connection/as.lisp | 2 +- src/connection/chroot.lisp | 15 ++++++--------- src/connection/local.lisp | 2 +- src/connection/sbcl.lisp | 2 +- src/connection/setuid.lisp | 21 ++------------------- src/image.lisp | 17 +++++++++-------- src/util.lisp | 39 ++++++++------------------------------- 7 files changed, 28 insertions(+), 70 deletions(-) (limited to 'src') 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))) -- cgit v1.2.3