From dd1e4f60665e112de213cbf9b1b6c76edec817cd Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 15 Aug 2020 14:58:54 +0200 Subject: [PATCH] - added a slot in 'command-window' to allow the user to insert secret input. the same character is echoed instead of the actual input. --- etc/default-theme.conf | 4 +++ src/command-window.lisp | 49 +++++++++++++++++++++------------ src/package.lisp | 2 ++ src/program-events.lisp | 17 +++++++++--- src/software-configuration.lisp | 4 +++ src/tui-utils.lisp | 2 +- src/ui-goodies.lisp | 24 +++++++++------- 7 files changed, 70 insertions(+), 32 deletions(-) diff --git a/etc/default-theme.conf b/etc/default-theme.conf index c541b1e..8ca7cd8 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -37,6 +37,10 @@ main-window.foreground = white crypted.mark.value = " 🔏👌" +# the string to be drawn instead of actual character when input password + +password-echo-character = "•" + # the character used to draw the vote's horizontal histogram # note: keeps it one character wide diff --git a/src/command-window.lisp b/src/command-window.lisp index f9f2f4d..5207c3a 100644 --- a/src/command-window.lisp +++ b/src/command-window.lisp @@ -22,6 +22,13 @@ :initarg :command-line :accessor command-line :documentation "A list of keys so far inserted by the user") + (echo-character + :initform nil + :initarg :echo-character + :accessor echo-character + :documentation "If non nil print a number of copies (equals to + length of slot 'command-line' of this string instead of the + command-line itself") (error-message :initform nil :initarg :error-message @@ -159,23 +166,31 @@ be either `:keybinding' or `:string'. the former for key command the latter for (point-position point-position) (point-bg point-bg) (point-fg point-fg) - (prompt prompt)) win - (let* ((length-cmd-line (length command-line)) - (no-prompt-point-pos (no-prompt-point-pos win)) - (cursor-value (if (and (> length-cmd-line 0) - (< no-prompt-point-pos - length-cmd-line)) - (elt command-line no-prompt-point-pos) - #\Space))) - (print-text win prompt 0 0) - (when command-line - (print-text win command-line (length prompt) 0)) - (print-text win - cursor-value - point-position - 0 - :fgcolor point-fg - :bgcolor point-bg)))) + (prompt prompt) + (echo-character echo-character)) win + (flet ((print-echo-character () + (let ((echoed (with-output-to-string (stream) + (loop repeat (length command-line) do + (princ echo-character stream))))) + (print-text win echoed (length prompt) 0)))) + (let* ((length-cmd-line (length command-line)) + (no-prompt-point-pos (no-prompt-point-pos win)) + (cursor-value (if (and (> length-cmd-line 0) + (< no-prompt-point-pos + length-cmd-line)) + (elt command-line no-prompt-point-pos) + #\Space))) + (print-text win prompt 0 0) + (when command-line + (if echo-character + (print-echo-character) + (print-text win command-line (length prompt) 0))) + (print-text win + cursor-value + point-position + 0 + :fgcolor point-fg + :bgcolor point-bg))))) (defmethod draw ((object command-window)) (with-accessors ((command-line command-line) diff --git a/src/package.lisp b/src/package.lisp index 69d8b7e..22f27af 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -993,6 +993,7 @@ :config-notification-life :config-server-name :config-username + :config-password-echo-character :config-win-focus-mark :thread-message-symbol :thread-message-read-colors @@ -1784,6 +1785,7 @@ :print-error :command-window :command-line + :echo-character :event-to-answer :prompt :add-error-message diff --git a/src/program-events.lisp b/src/program-events.lisp index d12bd62..fe4533c 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -172,6 +172,10 @@ :initform nil :initarg :initial-value :accessor initial-value) + (echo-character + :initform nil + :initarg :echo-character + :accessor echo-character) (complete-fn :initform nil :initarg :complete-fn @@ -189,9 +193,10 @@ (setf (priority object) (truncate (/ +standard-event-priority+ 2))))) (defmethod process-event ((object ask-user-input-string-event)) - (with-accessors ((prompt prompt) - (initial-value initial-value) - (complete-fn complete-fn)) object + (with-accessors ((prompt prompt) + (initial-value initial-value) + (complete-fn complete-fn) + (echo-character echo-character)) object (setf (command-window:event-to-answer specials:*command-window*) object) (setf (point-tracker:prompt specials:*command-window*) @@ -203,7 +208,9 @@ (setf (command-window:command-line specials:*command-window*) initial-value) (point-tracker:move-point-to-end specials:*command-window* initial-value) - (windows:draw specials:*command-window*))) + (setf (command-window:echo-character specials:*command-window*) + echo-character) + (windows:draw specials:*command-window*))) (defclass user-input-string-event (ask-user-input-string-event) () @@ -220,6 +227,8 @@ (defmethod process-event ((object user-input-string-event)) (with-accessors ((lock lock) (condition-variable condition-variable)) object + (setf (command-window:echo-character specials:*command-window*) + nil) (with-lock (lock) (bt:condition-notify condition-variable)))) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 3cc4eaa..bf0e110 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -399,6 +399,7 @@ input read unread + password-echo-character color-re ignore-user-re purge-history-days-offset @@ -657,6 +658,9 @@ (gen-simple-access (username) +key-username+) +(gen-simple-access (password-echo-character) + +key-password-echo-character+) + (defun config-win-focus-mark () (values (access:accesses *software-configuration* +key-window+ diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp index c74be18..2fc101d 100644 --- a/src/tui-utils.lisp +++ b/src/tui-utils.lisp @@ -155,7 +155,7 @@ as argument `complex-string'." (croatoan:concat-complex-string a b :color-attributes-contagion color-attributes-contagion)) (defmethod cat-complex-string ((a complex-string) (b complex-string) - &key (color-attributes-contagion t)) + &key (color-attributes-contagion nil)) "Return a complex string that is the results of concatenating of `a' and `b': two `complex-string'. If `color-attributes-contagion' is non nil `b' will inherit all the attributes and color of a." diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index c5e1eaf..a2287b1 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -145,17 +145,21 @@ (defun ask-string-input (on-input-complete-fn &key - (priority nil) - (initial-value nil) - (prompt +default-command-prompt+) - (complete-fn #'complete:directory-complete)) + (hide-input nil) + (priority nil) + (initial-value nil) + (prompt +default-command-prompt+) + (complete-fn #'complete:directory-complete)) (flet ((thread-fn () - (let ((event (make-instance 'ask-user-input-string-event - :forced-priority priority - :initial-value initial-value - :complete-fn complete-fn - :prompt prompt - :payload (box:dbox nil)))) + (let* ((password-echo (and hide-input + (swconf:config-password-echo-character))) + (event (make-instance 'ask-user-input-string-event + :echo-character password-echo + :forced-priority priority + :initial-value initial-value + :complete-fn complete-fn + :prompt prompt + :payload (box:dbox nil)))) (with-accessors ((lock lock) (condition-variable condition-variable)) event (push-event event)