diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-19 19:44:43 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-19 19:44:43 -0700 |
commit | fac6720737e25688760621dfc0e1e5d483ef2f1f (patch) | |
tree | b538b53d35c72d7d3c24e7e9f9ac7cffce5316a3 /src | |
parent | 81ee52dd850fa606d78757ce8e4b1fdbd66a9d21 (diff) | |
download | consfigurator-fac6720737e25688760621dfc0e1e5d483ef2f1f.tar.gz |
hide sudo passwords in the debugger
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src')
-rw-r--r-- | src/connection/sudo.lisp | 7 | ||||
-rw-r--r-- | src/data.lisp | 39 | ||||
-rw-r--r-- | src/package.lisp | 2 |
3 files changed, 40 insertions, 8 deletions
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp index 6612414..935fc5b 100644 --- a/src/connection/sudo.lisp +++ b/src/connection/sudo.lisp @@ -52,7 +52,8 @@ as (destructuring-bind (user host) (split-string as :separator "@") - (get-data-string (strcat "--user-passwd--" host) user))))) + (get-data-protected-string + (strcat "--user-passwd--" host) user))))) (defmethod establish-connection ((type (eql :sudo)) remaining @@ -66,7 +67,9 @@ ;; 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 (strcat password (string (code-char 13))))) + :password (and password + (strcat (passphrase password) + (string (code-char 13)))))) (defclass sudo-connection (shell-wrap-connection) ((user diff --git a/src/data.lisp b/src/data.lisp index 2869b43..5315762 100644 --- a/src/data.lisp +++ b/src/data.lisp @@ -350,6 +350,32 @@ of the current connection, where each entry is of the form "#+sbcl (require \"sb-cltl2\")" :test #'equal) + +;;;; Passphrases + +(defclass passphrase () + ((passphrase :initarg :passphrase :reader passphrase))) + +(defun get-data-protected-string (iden1 iden2) + "Like GET-DATA-STRING, but wrap the content in an object which is unprintable +by default. Intended for code which fetches passwords and wants to lessen the +chance of those passwords showing up in the clear in the Lisp debugger." + (make-instance 'passphrase :passphrase (get-data-string iden1 iden2))) + +(defvar *allow-printing-passphrases* nil) + +(defmethod print-object ((passphrase passphrase) stream) + (if *allow-printing-passphrases* + (format stream "#.~S" + `(make-instance 'passphrase + :passphrase ,(passphrase passphrase))) + (print-unreadable-object (passphrase stream) + (format stream "PASSPHRASE"))) + passphrase) + + +;;;; Programs for remote Lisp images + (defun continue-deploy*-program (remaining-connections) "Return a program to complete the work of an enclosing call to DEPLOY*. @@ -402,12 +428,13 @@ Preprocessing must occur in the root Lisp.")) ,(wrap `((%consfigure ',remaining-connections ,*host*)))))) (handler-case (with-standard-io-syntax - ;; need line breaks in between so that packages exist before we - ;; try to have remote Lisp read sexps containing symbols from - ;; those packages - (format nil "~A~%~{~A~^~%~}" - +continue-deploy*-program-implementation-specific+ - (mapcar #'prin1-to-string forms))) + (let ((*allow-printing-passphrases* t)) + ;; need line breaks in between so that packages exist before we + ;; try to have remote Lisp read sexps containing symbols from + ;; those packages + (format nil "~A~%~{~A~^~%~}" + +continue-deploy*-program-implementation-specific+ + (mapcar #'prin1-to-string forms)))) (print-not-readable (c) (error "The Lisp printer could not serialise ~A for transmission to the remote Lisp. diff --git a/src/package.lisp b/src/package.lisp index ed422d8..1d1281e 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -167,6 +167,8 @@ #:get-data-string #:upload-all-prerequisite-data #:request-lisp-systems + #:passphrase + #:get-data-protected-string #:continue-deploy*-program)) (defpackage :consfigurator.connection.shell-wrap |