Password Generator Gui

pwgen-gui.rkt

#lang racket/gui

;; Copyright (c) 2019 Alex Harsányi

;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.

;; http://www.iconarchive.com/show/papirus-apps-icons-by-papirus-team/preferences-desktop-user-password-icon.html

(require racket/random)


;;................................................. Generating Passwords ....

;; Generate a cryptographically secure random number of at least BITS bits
;; (BITS is rounded up to the next multiple of 8).  Returns the random number
;; as an integer -- note that Racket supports big numbers, so it can represent
;; integers of arbitrary size, this is convenient for us.
(define (random-bignum bits)
  (define num-bytes (exact-ceiling (/ bits 8)))
  (for/fold ([result 0])
            ([byte (in-bytes (crypto-random-bytes num-bytes))])
    (+ byte (* result 256))))

;; Encode KEY, a random integer produced by `random-bignum`, using ALPHABET,
;; which is a list of symbols to use for the encoding (see alphabet
;; definitions below).  If GROUP is greater than 0, than SEPARATOR will be
;; inserted every GROUP symbols, this is intended to produce passwords that
;; are easier to read out and type by hand.
;;
;; NOTE: the choice of alphabet does not affect how strong a password is, the
;; strength of the password is determined by the random number generated by
;; `random-bignum`.  However, alphabets with more symbols will produce shorter
;; passwords for the same strength.
(define (encode-bignum bignum alphabet group separator)
  (define base (string-length alphabet))
  (let loop ([position 0]
             [result '()]
             [bignum bignum])
    (if (> bignum 0)
        (let-values (([q r] (quotient/remainder bignum base)))
          (let ((symbol (string-ref alphabet r)))
            ;; NOTE: if `group` is 0, there is no grouping
            (if (and (> group 0) (> position 0) (= (remainder position group) 0))
                (loop (add1 position) (cons symbol (cons separator result)) q)
                (loop (add1 position) (cons symbol result) q))))
        (list->string (reverse result)))))

;; A list of symbols suitable for passing as an alphabet to `encode-bignum` --
;; it contains all small case and capital case letters plus the numbers.
(define normal-alphabet
  (string-append "abcdefghijklmnopqrstuvwxyz"
                 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                 "0123456789"))

;; Like `normal-alphabet` but add in some other symbols from punctuation
;; marks.  This will produce shorter passwords, but the resulting passwords
;; might be difficult to use from scripts or to manually type in at the
;; keyboard.
(define full-alphabet
  (string-append
   "abcdefghijklmnopqrstuvwxyz"
   "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   "0123456789"
   "~!@#$%^&*_+-=|{}[]<>?,./"))

;; Like `normal-alphabet`, but only with lower case letters, this will
;; generate passwords that are easy to type on devices that have a touch
;; screen.
(define lower-case-alphabet
  (string-append "abcdefghijklmnopqrstuvwxyz" "0123456789"))

;; Like `normal-alphabet`, but only contains symbols which are visually
;; distinct (i.e. the password will never contain 1, l, o or 0, as they can be
;; easily confused).  These passwords will be longer for the same strength,
;; but might be useful if you need to write them down on paper.
(define simplified-alphabet "acefghkrstwxyz23456789")


;;..................................................... application data ....

;; The key generated by `random-bignum`.  We need to keep it here, because we
;; use the same key when the user chooses a different encoding alphabet or
;; grouping.  The key only changes when the user will click on the Refresh
;; button or will choose a different bit count.
;;
;; This might not be a good idea from a password generation point of view, but
;; it is nicer interface to allow the user to select and view how the same
;; password is encoded using different options.

(define key #f)


;;.................................................................. GUI ....

;; The top level window for the application
(define toplevel
  (new (class frame% (init) (super-new)
         (define/augment (on-close)
           (on-toplevel-close this)))
       [label "Password Generator"]
       [width 600] [height 275] [border 15]))

;; The setting panel groups together the controls which select the password
;; strength and how it is encoded.

(define settings-panel
  (new group-box-panel% [parent toplevel] [label "Options"]
       [border 15] [spacing 20] [alignment '(center center)]
       [stretchable-height #f]))

;; Tell the settings panel to arrange items horizontally because, by default,
;; a group-box-panel% will stack them up vertically.
(send settings-panel set-orientation #t)

;; The password panel groups together the controls which display the password
;; as well as allowing it to be copied to the clipboard.
(define password-panel
  (new group-box-panel% [parent toplevel] [label "Password"]
       [border 15] [spacing 20] [stretchable-height #f]))

;; Tell the settings panel to arrange items horizontally because, by default,
;; a group-box-panel% will stack them up vertically.
(send password-panel set-orientation #t)

;; Another pane at the bottom of the form, contains the "New Password" and
;; "Close" buttons.
(define bottom-pane
  (new horizontal-pane% [parent toplevel]
       [border 15] [spacing 20]))


;;...................................................... alphabet-choice ....

;; This is the callback for the alphabet choice% control, it is called when
;; the user selects a new item in the control.  In our case, it simply calls
;; `refresh-password` which will read all configuration values, generate the
;; password and update the password field.
(define (on-alphabet-choice control event)
  (refresh-password))

;; List to map the name of the alphabets to the actual alphabets to use for
;; encoding.  This is used to construct the list of options for the choice%
;; control as well as to look up the actual alphabet based on the current
;; selection of the control.  Defining this information explicitly ensures
;; that the contents of the choice% control is always consistent with what the
;; application uses.
(define password-alphabets
  (list
   (list "Full" full-alphabet)
   (list "Normal" normal-alphabet)
   (list "Lower Case" lower-case-alphabet)
   (list "Simplified" simplified-alphabet)))

;; This is the choice% control which allows the user to select what alphabet
;; to use for encoding the key.
(define alphabet
  (new choice% [parent settings-panel] [label "Alphabet "]
       [choices (map first password-alphabets)]
       [callback on-alphabet-choice]))


;;..................................................... bit-count-choice ....

;; This is the callback for the bit count choice% control, it is called when
;; the user selects a new item in the control.  It sets the key to #f than
;; calls `refresh-password`, which will generate a new key, as well as encode
;; it.
(define (on-bit-count-choice control event)
  (set! key #f)
  (refresh-password))

;; List to map a selection in the bit-count-choice control to an actual number
;; of bits to use for the key.  This is used to construct the list of options
;; for the choice% control as well as to look up the actual bit count on the
;; current selection of the control.  Defining this information explicitly
;; ensures that the contents of the choice% control is always consistent with
;; what the application uses.
(define password-bits
  '(("64 bits" 64)
    ("96 bits" 96)
    ("128 bits" 128)
    ("256 bits" 256)
    ("512 bits" 512)
    ("1024 bits" 1024)))

(define bit-count
  (new choice% [parent settings-panel] [label "Strength "]
       [choices (map first password-bits)]
       [callback on-bit-count-choice]))


;;....................................................... group-checkbox ....

;; This is the callback for the "group" check-box% control, it is called when
;; the user checks or un-checks the control.  In our case, it simply calls
;; `refresh-password` which will read all configuration values, generate the
;; password and update the password field.
(define (on-group-letters control event)
  (refresh-password))

(define group
  (new check-box% [parent settings-panel] [label "Group letters"]
       [callback on-group-letters]))


;;....................................................... password-field ....

;; Use a larger font for the password-field, the font is also using a modern
;; face (which is monospace).
(define font
  (send the-font-list find-or-create-font 16 'modern 'normal 'normal))

;; This field shows the password.  It is updated by refresh-password when the
;; user interacts with other controls.
(define password
  (new text-field% [parent password-panel] [label #f] [init-value ""] [font font]))


;;.......................................................... copy-button ....

;; Callback for the "Copy" button -- when the user presses the button, the
;; contents of the password-field are copied to the clipboard.
(define (on-copy-to-clipboard control event)
  (define pw (send password get-value))
  (send the-clipboard set-clipboard-string pw (current-milliseconds)))

;; This is the "Copy" button, used to copy the password to the clipboard.
(define copy
  (new button% [parent password-panel] [label "Copy"]
       [callback on-copy-to-clipboard]))


;;.......................................................... bottom-pane ....

;; This is an empty control which is stretchable, and will flush all controls
;; in the `bottom-pane` to the right.
(define invisible
  (new message% [parent bottom-pane] [label ""] [stretchable-width #t]))


;;.................................................. new-password-button ....

;; Callback for the "New Password" button.  Will clear the key and call
;; `refresh-password` which will generate a new password and encode it.
(define (on-new-password control event)
  (set! key #f)
  (refresh-password))

(define new-password
  (new button% [parent bottom-pane] [label "New Password"]
       [callback on-new-password]))


;;......................................................... close-button ....

;; Callback for the "Close" button.  Will call `close-form` which will save
;; any options than close the toplevel window.
(define (on-close-form control event)
  (on-toplevel-close toplevel))

(define close
  (new button% [parent bottom-pane] [label "Close"]
       [callback on-close-form]))


;;..................................................... refresh-password ....

(define (refresh-password)
  ;; Generate a key if we don't have one
  (unless key
    (define index (send bit-count get-selection))
    (define bits (second (list-ref password-bits index)))
    (set! key (random-bignum bits)))
  ;; Encode the password based on the alphabet and group settings
  (define a
    (let ((index (send alphabet get-selection)))
      (second (list-ref password-alphabets index))))
  (define group? (send group get-value))
  (define encoded-key (encode-bignum key a (if group? 4 0) #\-))
  ;; Set the contents of the `password-field` to password
  (send password set-value encoded-key)
  (send password focus))

;; This is called when the toplevel form is closed, either by closing the
;; window or pressing the close button.  It will save the current selections
;; to the preferences file so they can be restored when the application starts
;; again.
(define (on-toplevel-close frame)
  (define alphabet-name
    (let ((index (send alphabet get-selection)))
      (first (list-ref password-alphabets index))))
  (define bits-name
    (let ([index (send bit-count get-selection)])
      (first (list-ref password-bits index))))
  (define group? (send group get-value))
  (put-preferences
   '(ah-password-generator:alphabet
     ah-password-generator:bit-count
     ah-password-generator:group?)
   (list alphabet-name bits-name group?))
  (send frame show #f))


;;..................................................... main application ....

;; Restore the selections for alphabet, bit count and grouping to the
;; previously saved values, or choose suitable defaults if no previous
;; values were found.
(let* ((previous-choice
        (get-preference 'ah-password-generator:alphabet (lambda () "Lower Case")))
       (index (index-where password-alphabets
                           (lambda (x) (equal? (first x) previous-choice)))))
  (send alphabet set-selection (or index 0)))

(let* ((previous-choice
        (get-preference 'ah-password-generator:bit-count (lambda () "96 bits")))
       (index (index-where password-bits
                           (lambda (x) (equal? (first x) previous-choice)))))
  (send bit-count set-selection (or index 0)))

(let ((previous-choice
       (get-preference 'ah-password-generator:group? (lambda () #f))))
  (send group set-value previous-choice))

;; Call `refresh-password` to generate a fresh password based on the current
;; settings.
(refresh-password)

;; Show the toplevel window to the user.
(send toplevel show #t)