[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Passwords



>Hi,
>
>I want to prompt for a password using an editable-text-dialog-item
>or the like, but I don't want the characters to be echoed.
>
>Actually, the best would be if it could be like the Appleshare
>prompt which uses blobs.
>
>I've tried intercepting the key-event handler, but if I replace
>the char I loose the text.
>
>I've tried intercepting the draw-contents handler, but it
>doesn't seem to be called char by char.
>
>If you set the font type to :srcBic which makes the chars 
>invisible - this will work buth it's not very elegant...

enclosed is a set of files that will do this for you.

It is not bulletproof in terms of seeing the characters...if you're eyes
are fast enough you can see the characters go by as you type...
"TANSTAAFL" Rich lynch@ils.nwu.edu
;;;;font-info
;;;;  MCMXCI Northwestern University Institute for the Learning Sciences
;;;;Richard Lynch
;;;;lynch@ils.nwu.edu

;;;;Some little functions that should be pre-defined and aren't.

(in-package :ccl)

(export '(font-ascent
          font-descent
          font-widmax
          font-leading
          font-line-height
          font-height
)        )

(defun font-ascent (&optional font-spec)
"&optional font-spec
Returns the ascent of font-spec."
  (first (multiple-value-list (font-info font-spec)))
)

(defun font-descent (&optional font-spec)
"&optional font-spec
Returns the descent of font-spec."
  (second (multiple-value-list (font-info font-spec)))
)

(defun font-widmax (&optional font-spec)
"&optional font-spec
Returns the widmax of font-spec."
  (third (multiple-value-list (font-info font-spec)))
)

(defun font-leading (&optional font-spec)
"&optional font-spec
Returns the leading of font-spec."
  (fourth (multiple-value-list (font-info font-spec)))
)

#|
;Pre-defined
(defun font-line-height (&optional font-spec)
"&optional font-spec
Returns the sum of the ascent, descent, and leading of font-spec."
  (let ((info (multiple-value-list (font-info font-spec))))
    (+ (first info) (second info) (fourth info))
) )
|#

(defun font-height (&optional font-spec)
"&optional font-spec
Returns the sum of the ascent and leading of font-spec."
  (let ((info (multiple-value-list (font-info font-spec))))
    (+ (first info) (fourth info))
) )
;;;;  MCMXCI Northwestern University Institute for the Learning Sciences
;;;;Richard Lynch
;;;;lynch@ils.nwu.edu

;;;;Defines a password-text-dialog-item class which is an editable text
that
;;;;does not display the actual text.

;;;;Known bugs:
;;;;   Typing causes the password to be momentarily displayed.
;;;;   (faster than my eyes can see, but you younguns might be able to see
it.)
;;;;   View-click-event-handler is disabled entirely.

;;;;   If I was a real hacker, I'd fix these by:
;;;;      Making my own special font to map all characters to the same
graphic
;;;;      and loading it into the system whenever this was loaded, or
;;;;      Temporarily altering _DrawChar to always draw the same character.
;;;;      Get the source code for view-key-event-handler and
;;;;      view-click-event-handler and duplicating them with one small
change.

(require 'font-info)

(defclass password-text-dialog-item (editable-text-dialog-item)
  ((password-character
     :documentation
"The character that will be displayed as a place-holder for the characters
of the password."
     :accessor password-character
     :initform #\AppleMark
     :initarg :password-character
   )
  )
  (:default-initargs
    :view-font (list "Chicago" 12)
  )
  (:documentation
"An editable text-dialog-item that displays place-holder characters.")
)

(defmethod view-draw-contents :around ((password-item
password-text-dialog-item))
;Alters view-draw-contents to replace the real text with a string of equal
;length consisting of password-character.
  (let* ((insert-point (fred-buffer password-item))
         (buffer-start (make-mark insert-point 0))
         (len (buffer-size buffer-start))
         (real-text (buffer-substring buffer-start len))
         (fake-text (make-string len :initial-element (password-character
password-item)))
        )
    (buffer-delete buffer-start 0 len)
    (buffer-insert buffer-start fake-text)
    (call-next-method)
    (buffer-delete buffer-start 0 len)
    (buffer-insert buffer-start real-text)
) )

;It's damned annoying when functions other than view-draw-contents do the
;drawing!!!
;What happened to modularity?!!!
;On a slow machine, or if event processing can halt it, you may actually
see
;the character flash while typing...
(defmethod view-key-event-handler :around ((password-item
password-text-dialog-item) char)
  (declare (ignore char))
  (without-interrupts
    (call-next-method)
    (view-draw-contents password-item)
) )

;I don't even want to think about trying to fix this one so it won't draw
the
;characters...
(defmethod view-click-event-handler ((password-item
password-text-dialog-item) where)
  (declare (ignore password-item where))
)

#|

(make-instance 'dialog
  :view-subviews
  (list
    (make-instance 'password-text-dialog-item :view-size #@(100 16))
  )
)

|#
;;;;  MCMXCI Northwestern University Institute for the Learning Sciences
;;;;Richard Lynch

(require 'password-text-dialog-item)

(defclass password-entry-dialog (dialog)
  ()
  (:default-initargs
    :window-type :double-edge-box
    :color-p t
  )
)

(defmethod initialize-instance :after ((view password-entry-dialog) &key
                                       view-size
                                       message
                                       ok-text
                                       cancel-text
                                       password-font
                                       password-char)
  (add-subviews view
    (make-instance 'static-text-dialog-item
      :view-position #@(4 4)
      :dialog-item-text message
    )
    (make-instance 'button-dialog-item
      :view-position (make-point (- (point-h view-size) 74) 4)
      :view-size #@(70 20)
      :dialog-item-text ok-text
      :default-button t
      :dialog-item-action
      #'(lambda (self)
          (return-from-modal-dialog (dialog-item-text (find-named-sibling
self 'password)))
        )
    )
    (make-instance 'button-dialog-item
      :view-position (make-point (- (point-h view-size) 74) 32)
      :view-size #@(70 20)
      :dialog-item-text cancel-text
      :dialog-item-action
      #'(lambda (self)
          (declare (ignore self))
          (return-from-modal-dialog :cancel)
        )
    )
    (make-instance 'password-text-dialog-item
      :view-position (make-point 4 (- (point-v view-size) 20))
      :view-size (make-point (- (point-h view-size) 8) 16)
      :view-nick-name 'password
      :view-font password-font
      :password-character password-char
    )
) )

(defmethod view-draw-contents :before ((view password-entry-dialog))
  (rlet ((rect :rect :topleft #@(0 0) :bottomright (view-size view)))
    (with-fore-color (make-color 40000 50000 40000)
      (#_PaintRect rect)
) ) )

(defun get-password-from-user (&optional
                                 (message "Please Enter Password")
                               &key
                                 (size #@(335 100))
                                 (position '(:bottom 140))
                                 (ok-text "Ok")
                                 (cancel-text "Cancel")
                                 (password-font (list "Chicago" 12))
                                 (password-char #\AppleMark)
                              )
  "&optional message &key size position ok-text cancel-text password-font
password-char
prompts the user for a string, which it returns without displaying.  If the
user clicks
the cancel button, a throw to :cancel is performed."
  (modal-dialog
    (make-instance 'password-entry-dialog
      :view-size size
      :view-position position
      :message message
      :ok-text ok-text
      :cancel-text cancel-text
      :password-font password-font
      :password-char password-char
) ) )

(defun check-password-p (password
                         &optional
                           (message "Please Enter Password")
                         &key
                           (size #@(335 100))
                           (position '(:bottom 140))
                           (ok-text "Ok")
                           (cancel-text "Cancel")
                           (password-font (list "Chicago" 12))
                           (password-char #\AppleMark)
                           (test #'string-equal)
                        )
  "password &optional message &key size position ok-text cancel-text
password-font password-char
Calls get-password-from-user and compares the result with password using
test  The default test
is string-equal."
  (let ((user-guess (get-password-from-user message
                      :size size
                      :position position
                      :ok-text ok-text
                      :cancel-text cancel-text
                      :password-font password-font
                      :password-char password-char
       ))           )
    (cond
      ((eq user-guess :cancel) (ed-beep) nil)
      ((funcall test password user-guess) t)
      (t (ed-beep) nil)
    )
) )


#|

(check-password-p "password" "The password is password")

|#