add MAKE-PASSPHRASE and use it to protect more sudo passwords

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

3 files changed, 15 insertions, 6 deletions

diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 5e2dbf9..dc1bf58 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -68,8 +68,9 @@
 		 ;; stdin.  use CODE-CHAR in this way so that we can be sure
 		 ;; ASCII ^M is what will get emitted.
 		 :password (and password
-				(strcat (passphrase password)
-					(string (code-char 13))))))
+				(make-passphrase
+				 (strcat (passphrase password)
+					 (string (code-char 13)))))))
 
 (defclass sudo-connection (shell-wrap-connection)
   ((user
@@ -77,6 +78,9 @@
    (password
     :initarg :password)))
 
+(defmethod get-sudo-password ((connection sudo-connection))
+  (passphrase (slot-value connection 'password)))
+
 (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
@@ -85,15 +89,15 @@
 	  (escape-sh-token (strcat "cd \"$HOME\"; " cmd))))
 
 (defmethod connection-run ((c sudo-connection) cmd (input null))
-  (call-next-method c cmd (slot-value c 'password)))
+  (call-next-method c cmd (get-sudo-password c)))
 
 (defmethod connection-run ((c sudo-connection) cmd (input string))
-  (call-next-method c cmd (strcat (slot-value c 'password) input)))
+  (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 (slot-value connection 'password)))
+		    (if-let ((password (get-sudo-password connection)))
 		      (make-concatenated-stream
 		       (if (subtypep (stream-element-type input) 'character)
 			   (make-string-input-stream password)
diff --git a/src/data.lisp b/src/data.lisp
index 627a2b3..f63cd5b 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -357,11 +357,15 @@ of the current connection, where each entry is of the form
 (defclass passphrase ()
   ((passphrase :initarg :passphrase :reader passphrase)))
 
+(defun make-passphrase (passphrase)
+  "Make an object which is unprintable by default to contain a passphrase."
+  (make-instance 'passphrase :passphrase 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)))
+  (make-passphrase (get-data-string iden1 iden2)))
 
 (defvar *allow-printing-passphrases* nil)
 
diff --git a/src/package.lisp b/src/package.lisp
index b8fad64..f3b3662 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -175,6 +175,7 @@
 	   #:upload-all-prerequisite-data
 	   #:request-lisp-systems
 	   #:passphrase
+	   #:make-passphrase
 	   #:get-data-protected-string
 	   #:continue-deploy*-program))