#!/bin/sh
# Emacs: please open this file in -*-Tcl-*- mode
# the next but one line restarts with wish...
# DO NOT REMOVE THIS BACKSLASH -> \
exec wish "$0" ${1+"$@"}
#
# Author: Mark Oakden http://wiki.tcl.tk/MNO
# Version: 1.0
#
# password generator and drilling program:
# generate a password according to the rules array and allow the user to
# test themselves on said password, displaying statistics on how often
# they get it right
#
# no sanity checks on the supplied rules are done.
#
# datasets for password generation:-
# separate lowercase and UPPERCASE letters so we can demand minimum
# number of each separately.
set data(letters) "abcdefghijklmnopqrstuvwxyz"
set data(LETTERS) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
set data(numbers) "0123456789"
set data(punctuation) "!\"£$%^&*()_+-={};':@#~<>,.?/\\|"
# a simpler set might be, for example:-
#
# set data(letters) "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
# set data(numbers) "0123456789"
# set data(punctuation) "!\"£$%^&*()_+-={};':@#~<>,.?/\\|"
# the rules determine characteristics of the randomly generated passwords
# presently available are:-
# rules(len) password length
# rules(<dataset_name>,min) minimum number of characters from <dataset_name>
# entry on the data array
# example rules:-
# password 7 chars long, with at least one U/C char, one l/c char,
# one number and one punctuation.
set rules(len) 7
set rules(letters,min) 1
set rules(LETTERS,min) 1
set rules(numbers,min) 1
set rules(punctuation,min) 1
# example rules appropriate to the commented "simpler" datasets above:-
#
# set rules(len) 7
# set rules(numbers,min) 1
# set rules(punctuation,min) 1
proc initStats {} {
global stats
set stats(tries) 0
set stats(correct) 0
updateStatsDisplay
}
# picks a (pseudo)random char from str
proc oneCharFrom { str } {
set len [string length $str]
set indx [expr {int(rand()*$len)}]
return [string index $str $indx]
}
# for a string of length n, swap random pairs of chars n times
# and return the result
proc shuffle { str } {
set len [string length $str]
for { set i 1 } { $i <= $len } { incr i 1 } {
set indx1 [expr {int(rand()*$len)}]
set indx2 [expr {int(rand()*$len)}]
set str [swapStringChars $str $indx1 $indx2]
}
return $str
}
# given a string, and integers i and j, swap the ith and jth chars of str
# return the result
proc swapStringChars { str i j } {
if { $i == $j } {
return $str
}
if { $i > $j } {
set t $j
set j $i
set i $t
}
set pre [string range $str 0 [expr {$i - 1}]]
set chari [string index $str $i]
set mid [string range $str [expr {$i + 1}] [expr {$j - 1}]]
set charj [string index $str $j]
set end [string range $str [expr {$j + 1}] end]
set ret ${pre}${charj}${mid}${chari}${end}
return $ret
}
# generate a password
proc genPw {} {
global data rules
# Algorithm
# 1. foreach dataset with a min parameter, choose exactly min
# random chars from it
# 2. concatenate results of above into password
# 3. concatenate all datasets into large dataset
# 4. choose desired_length-password_length chars from large
# 5. concatenate (4) and (2)
# 6. shuffle (5)
set password {}
foreach indx [array names rules *,min] {
set ds_name [lindex [split $indx ,] 0]
set num $rules($indx)
for {set i 1} {$i <= $num} {incr i 1} {
append password [oneCharFrom $data($ds_name)]
}
}
set all_data {}
foreach set [array names data] {
append all_data $data($set)
}
set rem_len [expr $rules(len) - [string length $password]]
for {set i 1} {$i <= $rem_len} {incr i 1} {
append password [oneCharFrom $all_data]
}
return [shuffle $password]
}
#
# routines for the GUI
#
# get a new password, update stats and GUI
proc newPass {} {
global password displaypass pwattempt pwishidden
set password [genPw]
set pwattempt {}
set pwishidden 0
set displaypass $password
.pw configure -text $password
initStats
update idletasks
return
}
# toggle whether the password is displayed or not
proc hideOrShowPass {} {
global password displaypass pwishidden
set hidden [starString $password]
if { $pwishidden } {
set displaypass $password
} else {
set displaypass $hidden
}
# toggle the hidden state
set pwishidden [expr {1 - $pwishidden}]
update idletasks
}
# return a string same length as argument str filled with "*"
proc starString { str } {
set ret {}
foreach char [split $str {}] {
append ret "*"
}
return $ret
}
# the following works in 8.3 and above, but not in 8.0 or the plugin...
#proc starString { str } {
# return [string repeat "*" [string length $str]]
#}
# check a password typed by user, update stats and GUI
proc testPass {} {
global pwattempt password feedback stats
incr stats(tries)
# would like to use [string equal] in the following but doesn't work
# in 8.0 or the plugin
if {[string compare $password $pwattempt] == 0} {
set feedback "Correct"
.feedback configure -background green
incr stats(correct)
} else {
set feedback "Wrong"
.feedback configure -background red
}
set pwattempt {}
updateStatsDisplay
update idletasks
return
}
# update the string used to display stats in GUI
proc updateStatsDisplay {} {
global stats formattedStats
set formattedStats "$stats(correct)/$stats(tries) "
if { $stats(tries) != 0 } {
set perc [expr {100*double($stats(correct))/double($stats(tries))}]
} else {
set perc 0
}
append formattedStats [format "(%.1f%%)" $perc]
return
}
#
# set up the GUI
#
initStats
set password [genPw]
set displaypass $password
set pwishidden 0
set formattedStats {0/0 (0%)}
set feedback {}
button .newpw -text {New} -command newPass
label .pw -font {Courier} -textvariable displaypass
button .hide -text "Show/Hide" -command hideOrShowPass
entry .try -font {Courier} -show "*" -width $rules(len) -textvariable pwattempt
label .feedback -textvariable feedback
label .stats -text "Stats:"
label .statval -textvariable formattedStats
button .statreset -text "Reset Stats" -command initStats
grid .newpw .pw .hide -sticky ew
grid .try - .feedback -sticky ew
grid .stats .statval .statreset -sticky ew
grid columnconfigure . 1 -weight 1
focus .try
bind .try <Return> testPassRLH - I ran it through Nagelfar:
Line 65: W Expr without braces Line 74: W Expr without braces Line 75: W Expr without braces Line 92: W Expr without braces Line 94: W Expr without braces Line 94: W Expr without braces Line 96: W Expr without braces Line 128: W Expr without braces Line 161: W Expr without braces Line 203: W Expr without braces
yahalom - better fix after pointing to the mistake. I done that.
Another simple password generator can be found at random
And yet another at Pass-word mixer.
Also take a look at the slightly related app Password Gorilla.
