Commit Debian 3.0 (quilt) metadatadebian/0.8.0-2archive/debian/0.8.0-2

[dgit (9.13) quilt-fixup]

6 files changed, 384 insertions, 0 deletions

diff --git a/debian/patches/add-posix-login-environment-and-use-in-s.patch b/debian/patches/add-posix-login-environment-and-use-in-s.patch
new file mode 100644
index 0000000..54e100e
--- /dev/null
+++ b/debian/patches/add-posix-login-environment-and-use-in-s.patch
@@ -0,0 +1,90 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Thu, 1 Jul 2021 23:08:58 -0700
+X-Dgit-Generated: 0.8.0-2 eb33733e65326f771822f1f4b767f47382eb4914
+Subject: add POSIX-LOGIN-ENVIRONMENT and use in :SETUID connection
+
+Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
+(cherry picked from commit 60d2ca122ee7dc29fc66b4364bcf79f5a7041b64)
+
+---
+
+--- consfigurator-0.8.0.orig/src/connection/setuid.lisp
++++ consfigurator-0.8.0/src/connection/setuid.lisp
+@@ -53,15 +53,13 @@
+                                           :datadir datadir
+                                           :connattrs `(:remote-uid ,uid
+                                                        :remote-gid ,gid
++                                                       :remote-user ,to
+                                                        :remote-home ,home))
+                            remaining))))
+ 
+ (defmethod post-fork ((connection setuid-connection))
+-  ;; TODO Set up the new environment more systematically.  Perhaps look at how
+-  ;; runuser(1) uses PAM to do this.
+   (let ((uid (connection-connattr connection :remote-uid))
+-        (gid (connection-connattr connection :remote-gid))
+-        (home (connection-connattr connection :remote-home)))
++        (gid (connection-connattr connection :remote-gid)))
+     (run-program (list "chown" "-R"
+                        (format nil "~A:~A" uid gid)
+                        (unix-namestring (slot-value connection 'datadir))))
+@@ -69,5 +67,6 @@
+       (error "setgid(2) failed!"))
+     (unless (zerop (setuid uid))
+       (error "setuid(2) failed!"))
+-    (setf (getenv "HOME") (unix-namestring home))
+-    (uiop:chdir home)))
++    (posix-login-environment
++     (connection-connattr connection :remote-user)
++     (connection-connattr connection :remote-home))))
+--- consfigurator-0.8.0.orig/src/package.lisp
++++ consfigurator-0.8.0/src/package.lisp
+@@ -1,7 +1,7 @@
+ (in-package :cl-user)
+ 
+ (defpackage :consfigurator
+-  (:use #:cl #:alexandria)
++  (:use #:cl #:alexandria #:cffi)
+   (:local-nicknames (#:re #:cl-ppcre))
+   (:shadowing-import-from #:uiop
+                           #:strcat
+@@ -100,6 +100,7 @@
+ 
+            #:unwind-protect-in-parent
+            #:cancel-unwind-protect-in-parent-cleanup
++           #:posix-login-environment
+ 
+            ;; connection.lisp
+            #:establish-connection
+--- consfigurator-0.8.0.orig/src/util.lisp
++++ consfigurator-0.8.0/src/util.lisp
+@@ -387,6 +387,29 @@ of this macro."
+ Should be called soon after fork(2) in child processes."
+   (signal 'in-child-process))
+ 
++(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" :int))
++        (maybe-preserve '("TERM")))
++    (when (zerop euid)
++      (push "SSH_AUTH_SOCK" maybe-preserve))
++    (let ((preserved (loop for var in maybe-preserve
++                           for val = (getenv var)
++                           when val collect var and collect val)))
++      (unless (zerop (foreign-funcall "clearenv" :int))
++        (failed-change "clearenv(3) failed!"))
++      (loop for (var val) on preserved by #'cddr do (setf (getenv var) val)))
++    (setf (getenv "HOME") (drop-trailing-slash (unix-namestring home))
++          (getenv "USER") logname
++          (getenv "LOGNAME") logname
++          (getenv "SHELL") "/bin/sh"
++          (getenv "PATH")
++          (if (zerop euid)
++              "/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
++              "/usr/local/bin:/bin:/usr/bin"))
++    (uiop:chdir home)))
++
+ 
+ ;;;; Lisp data files
+ 
diff --git a/debian/patches/return-type-in-foreign-funcall-of-geteui.patch b/debian/patches/return-type-in-foreign-funcall-of-geteui.patch
new file mode 100644
index 0000000..6ea6bcf
--- /dev/null
+++ b/debian/patches/return-type-in-foreign-funcall-of-geteui.patch
@@ -0,0 +1,65 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Fri, 23 Jul 2021 11:37:25 -0700
+X-Dgit-Generated: 0.8.0-2 4719c2966d0ddb4cfa6855aacfc6a4774c18bd70
+Subject: return type in FOREIGN-FUNCALL of geteuid(2) is unsigned
+
+Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
+(cherry picked from commit 885b9f3f762cdf18ff358509fd8838f8222b43ba)
+
+---
+
+--- consfigurator-0.8.0.orig/src/connection/as.lisp
++++ consfigurator-0.8.0/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" :int)))
++  (zerop (foreign-funcall "geteuid" :unsigned-int)))
+ 
+ (defmethod establish-connection ((type (eql :as)) remaining &key to)
+   "Establish a :SETUID or :SU connection to another user account, depending on
+--- consfigurator-0.8.0.orig/src/connection/chroot.lisp
++++ consfigurator-0.8.0/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" :int)))
++  (zerop (foreign-funcall "geteuid" :unsigned-int)))
+ 
+ (defmethod establish-connection ((type (eql :chroot)) remaining &key into)
+   (establish-connection (if (and (lisp-connection-p)
+@@ -113,7 +113,8 @@ should be the mount point, without the c
+     (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" :int)))
++  (unless (and (lisp-connection-p)
++               (zerop (foreign-funcall "geteuid" :unsigned-int)))
+     (error "~&Forking into a chroot requires a Lisp image running as root"))
+   (informat 1 "~&Forking into chroot at ~A" into)
+   (let* ((into* (ensure-directory-pathname into))
+--- consfigurator-0.8.0.orig/src/connection/setuid.lisp
++++ consfigurator-0.8.0/src/connection/setuid.lisp
+@@ -32,7 +32,8 @@
+ (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" :int)))
++  (unless (and (lisp-connection-p)
++               (zerop (foreign-funcall "geteuid" :unsigned-int)))
+     (error "~&SETUIDing requires a Lisp image running as root"))
+   (informat 1 "~&SETUIDing to ~A" to)
+   (multiple-value-bind (match groups)
+--- consfigurator-0.8.0.orig/src/util.lisp
++++ consfigurator-0.8.0/src/util.lisp
+@@ -390,7 +390,7 @@ Should be called soon after fork(2) in c
+ (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" :int))
++  (let ((euid (foreign-funcall "geteuid" :unsigned-int))
+         (maybe-preserve '("TERM")))
+     (when (zerop euid)
+       (push "SSH_AUTH_SOCK" maybe-preserve))
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..9181f11
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1,5 @@
+add-posix-login-environment-and-use-in-s.patch
+setuid-connection-also-call-initgroups3.patch
+sudo-ensure-that-stdin-is-a-pipe-never-a.patch
+setuid-ensure-we-chdir2-before-we-setuid.patch
+return-type-in-foreign-funcall-of-geteui.patch
diff --git a/debian/patches/setuid-connection-also-call-initgroups3.patch b/debian/patches/setuid-connection-also-call-initgroups3.patch
new file mode 100644
index 0000000..31d14e8
--- /dev/null
+++ b/debian/patches/setuid-connection-also-call-initgroups3.patch
@@ -0,0 +1,43 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Wed, 21 Jul 2021 13:55:12 -0700
+X-Dgit-Generated: 0.8.0-2 07827bd9141d96ef89d05ba7f2596242ef0b6e27
+Subject: :SETUID connection: also call initgroups(3)
+
+Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
+(cherry picked from commit 052f5d522473f10fe46fd431b372de54f7a53e62)
+
+---
+
+--- consfigurator-0.8.0.orig/src/connection/setuid.lisp
++++ consfigurator-0.8.0/src/connection/setuid.lisp
+@@ -26,6 +26,9 @@
+   #+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)
+@@ -59,14 +62,17 @@
+ 
+ (defmethod post-fork ((connection setuid-connection))
+   (let ((uid (connection-connattr connection :remote-uid))
+-        (gid (connection-connattr connection :remote-gid)))
++        (gid (connection-connattr connection :remote-gid))
++        (user (connection-connattr connection :remote-user)))
+     (run-program (list "chown" "-R"
+                        (format nil "~A:~A" uid gid)
+                        (unix-namestring (slot-value connection 'datadir))))
++    ;; 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!"))
+     (posix-login-environment
+-     (connection-connattr connection :remote-user)
+-     (connection-connattr connection :remote-home))))
++     user (connection-connattr connection :remote-home))))
diff --git a/debian/patches/setuid-ensure-we-chdir2-before-we-setuid.patch b/debian/patches/setuid-ensure-we-chdir2-before-we-setuid.patch
new file mode 100644
index 0000000..00a55d9
--- /dev/null
+++ b/debian/patches/setuid-ensure-we-chdir2-before-we-setuid.patch
@@ -0,0 +1,28 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Fri, 23 Jul 2021 08:43:06 -0700
+X-Dgit-Generated: 0.8.0-2 927cdd896fd1a4d64691d50a90cdd11ce7d675f9
+Subject: :SETUID: ensure we chdir(2) before we setuid(2)
+
+Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
+(cherry picked from commit ae2f8d30cbcd82126de7daeb4b94dd05d5b46f01)
+
+---
+
+--- consfigurator-0.8.0.orig/src/connection/setuid.lisp
++++ consfigurator-0.8.0/src/connection/setuid.lisp
+@@ -67,12 +67,12 @@
+     (run-program (list "chown" "-R"
+                        (format nil "~A:~A" uid gid)
+                        (unix-namestring (slot-value connection 'datadir))))
++    (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!"))
+-    (posix-login-environment
+-     user (connection-connattr connection :remote-home))))
++      (error "setuid(2) failed!"))))
diff --git a/debian/patches/sudo-ensure-that-stdin-is-a-pipe-never-a.patch b/debian/patches/sudo-ensure-that-stdin-is-a-pipe-never-a.patch
new file mode 100644
index 0000000..3a918dc
--- /dev/null
+++ b/debian/patches/sudo-ensure-that-stdin-is-a-pipe-never-a.patch
@@ -0,0 +1,153 @@
+From: Sean Whitton <spwhitton@spwhitton.name>
+Date: Thu, 22 Jul 2021 15:20:09 -0700
+X-Dgit-Generated: 0.8.0-2 7b0c6d72899a5946b1fbc4c495de4b1458e72779
+Subject: :SUDO: ensure that stdin is a pipe, never a real file
+
+Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
+(cherry picked from commit 56dda681a644833f9b7de1775b7d193fd120bb8e)
+
+---
+
+--- consfigurator-0.8.0.orig/doc/connections.rst
++++ consfigurator-0.8.0/doc/connections.rst
+@@ -97,7 +97,9 @@ Consfigurator sends your sudo password o
+ password is required is violated, your sudo password will end up in the stdin
+ to whatever command is being run using sudo.  There is no facility for
+ directly passing in a passphrase; you must use ``:AS`` to obtain passwords
+-from sources of prerequisite data.
++from sources of prerequisite data.  The passphrase will be written to a
++private temporary file which is deleted when the ``:SUDO`` connection is torn
++down.
+ 
+ If any connection types which start up remote Lisp images occur before a
+ ``:SUDO`` entry in your connection chain, ``ESTABLISH-CONNECTION`` will need
+--- consfigurator-0.8.0.orig/src/connection/sudo.lisp
++++ consfigurator-0.8.0/src/connection/sudo.lisp
+@@ -35,6 +35,22 @@
+                      (get-data-protected-string
+                       (strcat "--user-passwd--" host) user)))))
+ 
++;; With sudo -S, we must ensure that sudo's stdin is a pipe, not a file,
++;; because otherwise the program sudo invokes may rewind(stdin) and read the
++;; password, intentionally or otherwise.  And UIOP:RUN-PROGRAM empties input
++;; streams into temporary files, so there is the potential for this to happen
++;; when using :SUDO to apply properties to localhost.  Other connection types
++;; might work similarly.
++;;
++;; The simplest way to handle this would be to just put 'cat |' at the
++;; beginning of the shell command we construct, but that relies on cat(1) not
++;; calling rewind(stdin) either.  So we write the password input out to a
++;; temporary file ourselves, and use cat(1) to concatenate that file with the
++;; actual input.
++
++(defclass sudo-connection (shell-wrap-connection)
++  ((password-file :initarg :password-file)))
++
+ (defmethod establish-connection ((type (eql :sudo))
+                                  remaining
+                                  &key
+@@ -42,56 +58,41 @@
+                                    password)
+   (declare (ignore remaining))
+   (informat 1 "~&Establishing sudo connection to ~A" user)
+-  (make-instance 'sudo-connection
+-                 :connattrs `(:remote-user ,user)
+-                 ;; we'll send the password followed by ^M, then the real
+-                 ;; stdin.  use CODE-CHAR in this way so that we can be sure
+-                 ;; ASCII ^M is what will get emitted.
+-                 :password (and password
+-                                (make-passphrase
+-                                 (strcat (passphrase password)
+-                                         (string (code-char 13)))))))
+-
+-(defclass sudo-connection (shell-wrap-connection)
+-  ((password :initarg :password)))
+-
+-(defmethod get-sudo-password ((connection sudo-connection))
+-  (let ((value (slot-value connection 'password)))
+-    (and value (passphrase value))))
+-
+-(defmethod connection-shell-wrap ((connection sudo-connection) cmd)
+-  ;; Wrap in sh -c so that it is more likely we are either asked for a
+-  ;; password for all our commands or not asked for one for any.
+-  ;;
+-  ;; Preserve SSH_AUTH_SOCK for root to enable this sort of workflow: deploy
+-  ;; laptop using (:SUDO :SBCL) and then DEFHOST for laptop contains (DEPLOYS
+-  ;; ((:SSH :TO "root")) ...) to deploy a VM running on the laptop.
+-  ;;
+-  ;; This only works for sudoing to root because only the superuser can access
+-  ;; the socket (and was always able to, so we're not granting new access
+-  ;; which may be unwanted).
+-  (let ((user (connection-connattr connection :remote-user)))
+-    (format
+-     nil
+-"sudo -HkS --prompt=\"\" ~:[~;--preserve-env=SSH_AUTH_SOCK ~]--user=~A sh -c ~A"
+-     (string= user "root") user (escape-sh-token cmd))))
+-
+-(defmethod connection-run ((c sudo-connection) cmd (input null))
+-  (call-next-method c cmd (get-sudo-password c)))
+-
+-(defmethod connection-run ((c sudo-connection) cmd (input string))
+-  (call-next-method c cmd (strcat (get-sudo-password c) input)))
+-
+-(defmethod connection-run ((connection sudo-connection) cmd (input stream))
+-  (call-next-method connection
+-                    cmd
+-                    (if-let ((password (get-sudo-password connection)))
+-                      (make-concatenated-stream
+-                       (if (subtypep (stream-element-type input) 'character)
+-                           (make-string-input-stream password)
+-                           (babel-streams:make-in-memory-input-stream
+-                            (babel:string-to-octets
+-                             password :encoding :UTF-8)
+-                            :element-type (stream-element-type input)))
+-                       input)
+-                      input)))
++  (make-instance
++   'sudo-connection
++   :connattrs `(:remote-user ,user)
++   :password-file (and password
++                       (let ((file (mktemp)))
++                         ;; We'll send the password followed by ^M, then the
++                         ;; real stdin.  Use CODE-CHAR in this way so that we
++                         ;; can be sure ASCII ^M is what will get emitted.
++                         (writefile file (strcat (passphrase password)
++                                                 (string (code-char 13)))
++                                    :mode #o600)
++                         file))))
++
++(defmethod connection-teardown :after ((connection sudo-connection))
++  (when-let ((file (slot-value connection 'password-file)))
++    (delete-remote-trees file)))
++
++(defmethod connection-run ((connection sudo-connection) cmd input)
++  (let* ((file (slot-value connection 'password-file))
++         (user (connection-connattr connection :remote-user))
++         (prefix (if file
++                     (format nil "cat ~A - | sudo -HkS --prompt=\"\""
++                             (escape-sh-token file))
++                     "sudo -Hkn")))
++    ;; Wrap in sh -c so that it is more likely we are either asked for a
++    ;; password for all our commands or not asked for one for any.
++    ;;
++    ;; Preserve SSH_AUTH_SOCK for root to enable this sort of workflow: deploy
++    ;; laptop using (:SUDO :SBCL) and then DEFHOST for laptop contains
++    ;; (DEPLOYS ((:SSH :TO "root")) ...) to deploy a VM running on the laptop.
++    ;;
++    ;; This only works for sudoing to root because only the superuser can
++    ;; access the socket (and was always able to, so we're not granting new
++    ;; access which may be unwanted).
++    (mrun :may-fail :input input
++          (format nil
++                  "~A ~:[~;--preserve-env=SSH_AUTH_SOCK ~]--user=~A sh -c ~A"
++                  prefix (string= user "root") user (escape-sh-token cmd)))))
+--- consfigurator-0.8.0.orig/src/package.lisp
++++ consfigurator-0.8.0/src/package.lisp
+@@ -121,6 +121,7 @@
+            #:run
+            #:mrun
+            #:with-remote-temporary-file
++           #:mktemp
+            #:with-remote-current-directory
+            #:run-failed
+            #:runlines