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 ++------------------- 5 files changed, 11 insertions(+), 31 deletions(-) (limited to 'src/connection') 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))) -- cgit v1.2.3