1#!/bin/sh 2# -*- tcl -*- 3# The next line is executed by /bin/sh, but not tcl \ 4exec tclsh "$0" ${1+"$@"} 5 6package require Expect 7package require Tk 8 9# tkpasswd - Change passwords using Expectk 10# Author: Don Libes, NIST, October 1, 1993 11# Version: 1.8 - Added support for Tk 4.1 12 13# There is no man page. However, there is some on-line help when you run 14# the program. Technical details and insights are described in the 15# O'Reilly book "Exploring Expect". 16 17proc prog_exists {prog} { 18 return [llength [auto_execok $prog]] 19} 20 21frame .type -relief raised -bd 1 22 23radiobutton .passwd -text passwd -variable passwd_cmd \ 24 -value {passwd {cat /etc/passwd}} \ 25 -anchor w -command get_users -relief flat 26pack .passwd -in .type -fill x 27 28if {[prog_exists yppasswd]} { 29 radiobutton .yppasswd -text yppasswd -variable passwd_cmd \ 30 -value {yppasswd {ypcat passwd}} \ 31 -anchor w -command get_users -relief flat 32 pack .yppasswd -in .type -fill x 33} 34 35if {[prog_exists nispasswd]} { 36 radiobutton .nispasswd -text nispasswd -variable passwd_cmd \ 37 -value {nispasswd {niscat passwd}} \ 38 -anchor w -command get_users -relief flat 39 pack .nispasswd -in .type -fill x 40} 41pack .type -fill x 42 43frame .sort -relief raised -bd 1 44radiobutton .unsorted -text unsorted -variable sort_cmd -value " " \ 45 -anchor w -relief flat -command get_users 46radiobutton .name -text name -variable sort_cmd -value "| sort" \ 47 -anchor w -relief flat -command get_users 48radiobutton .uid -text uid -variable sort_cmd -value "| sort -t: -n +2" \ 49 -anchor w -relief flat -command get_users 50pack .unsorted .name .uid -in .sort -fill x 51pack .sort -fill x 52 53frame .users -relief raised -bd 1 54# has to be wide enough for 8+1+5=14 55text .names -yscrollcommand ".scroll set" -width 14 -height 1 \ 56 -font {Courier 12 bold} -setgrid 1 57.names tag configure nopassword -relief raised 58.names tag configure selection -relief raised 59 60set iscolor 0 61if {[winfo depth .] > 1} { 62 set iscolor 1 63} 64 65if {$iscolor} { 66 .names tag configure nopassword -background red 67 .names tag configure selection -background green 68} else { 69 .names tag configure nopassword -background black -foreground white 70 .names tag configure selection -background white -foreground black 71} 72scrollbar .scroll -command ".names yview" -relief raised 73pack .scroll -in .users -side left -fill y 74pack .names -in .users -side left -fill y 75pack .users -expand 1 -fill y 76 77wm minsize . 14 1 78wm maxsize . 14 999 79wm geometry . 14x10 80 81frame .password_frame -relief raised -bd 1 82entry .password -textvar password -relief sunken -width 1 83focus .password 84bind .password <Return> password_set 85label .prompt -text "Password:" -bd 0 86button .password_set -text "set" -command password_set 87button .generate_button -text "generate" -command password_generate 88pack .prompt .password -in .password_frame -fill x -padx 2 -pady 2 89pack .password_set .generate_button -in .password_frame -side left -expand 1 -fill x -padx 2 -pady 2 90pack .password_frame -fill x 91 92set dict_loaded 0 93checkbutton .dict -text "test dictionary" -variable dict_check \ 94 -command {if {!$dict_loaded} load_dict} \ 95 -anchor w 96pack .dict -fill x -padx 2 -pady 2 97 98 99button .quit -text quit -command exit 100button .help_button -text help -command help 101pack .quit .help_button -side left -expand 1 -fill x -padx 2 -pady 2 102 103proc help {} { 104 if {[catch {toplevel .help}]} return 105 message .help.text -text \ 106"tkpasswd - written by Don Libes, NIST, 10/1/93. 107 108Click on passwd (local users) or yppasswd (NIS users).\ 109Select user using mouse (or keys - see below).\ 110Enter password or press ^G to generate a random password.\ 111(Press ^A to adjust the generation parameters.)\ 112Press return to set the password.\ 113If the dictionary is enabled and the password is in it,\ 114the password is rejected. 115 116You must be root to set local passwords besides your own.\ 117If you are not root, you must also enter an old password\ 118when requested. 119 120You do not have to move mouse into password field(s) to enter password.\ 121^U clears password field.\ 122^N and ^P select next/previous user.\ 123M-n and M-p select next/previous user with no password.\ 124(Users with no passwords are highlighted.)" 125 126 button .help.ok -text "ok" -command {destroy .help} 127 pack .help.text 128 pack .help.ok -fill x -padx 2 -pady 2 129} 130 131# get list of local users 132proc get_users {} { 133 global sort_cmd passwd_cmd 134 global nopasswords ;# line numbers of entries with no passwords 135 global last_line ;# last line of text box 136 global selection_line 137 138 .names delete 1.0 end 139 140 set file [open "|[lindex $passwd_cmd 1] $sort_cmd"] 141 set last_line 1 142 set nopasswords {} 143 while {[gets $file buf] != -1} { 144 set buf [split $buf :] 145 if {[llength $buf]>2} { 146 # normal password entry 147 .names insert end "[format "%-8.8s %5d" [lindex $buf 0] [lindex $buf 2]]\n" 148 if {0==[string compare [lindex $buf 1] ""]} { 149 .names tag add nopassword \ 150 {end - 2 line linestart} \ 151 {end - 2 line lineend} 152 lappend nopasswords $last_line 153 } 154 } else { 155 # +name style entry 156 .names insert end "$buf\n" 157 } 158 incr last_line 159 } 160 incr last_line -1 161 close $file 162 set selection_line 0 163} 164 165proc feedback {msg} { 166 global password 167 168 set password $msg 169 .password select from 0 170 .password select to end 171 update 172} 173 174proc load_dict {} { 175 global dict dict_loaded 176 177 feedback "loading dictionary..." 178 179 if {0==[catch {open /usr/dict/words} file]} { 180 foreach w [split [read $file] "\n"] {set dict($w) ""} 181 close $file 182 set dict_loaded 1 183 feedback "dictionary loaded" 184 } else { 185 feedback "dictionary missing" 186 .dict deselect 187 } 188} 189 190# put whatever security checks you like in here 191proc weak_password {password} { 192 global dict dict_check 193 194 if {$dict_check} { 195 feedback "checking password" 196 197 if {[info exists dict($password)]} { 198 feedback "sorry - in dictionary" 199 return 1 200 } 201 } 202 return 0 203} 204 205proc password_set {} { 206 global password passwd_cmd selection_line 207 208 set new_password $password 209 210 if {$selection_line==0} { 211 feedback "select a user first" 212 return 213 } 214 set user [lindex [.names get selection.first selection.last] 0] 215 216 if {[weak_password $password]} return 217 218 feedback "setting password . . ." 219 220 set cmd [lindex $passwd_cmd 0] 221 spawn -noecho $cmd $user 222 log_user 0 223 set last_msg "error in $cmd" 224 while {1} { 225 expect { 226 -nocase "old password:" { 227 exp_send "[get_old_password]\r" 228 } "assword*:" { 229 exp_send "$new_password\r" 230 } -re "(.*)\r\n" { 231 set last_msg $expect_out(1,string) 232 } eof break 233 } 234 } 235 set status [wait] 236 if {[lindex $status 3]==0} { 237 feedback "set successfully" 238 } else { 239 feedback $last_msg 240 } 241} 242 243# defaults for generating passwords 244set length 9 245set minnum 2 246set minlower 5 247set minupper 2 248set distribute 0 249 250proc parameter_filename {} { 251 set file .tkpasswd.rc 252 if {[info exists env(DOTDIR)]} { 253 set file "$env(DOTDIR)/$file" 254 } 255 return ~/$file 256} 257 258catch {source [parameter_filename]} 259 260# save parameters in a file 261proc save_parameters {} { 262 global minnum minlower minupper length 263 264 if {[catch {open [parameter_filename] w} f]} { 265 # should never happen, so don't bother with window code 266 puts "tkpasswd: could not write [parameter_filename]" 267 return 268 } 269 puts $f "# This is the .tkpasswd.rc file. Do not edit it by hand as" 270 puts $f "# it is automatically maintained by tkpasswd. Any manual" 271 puts $f "# modifications will be lost." 272 puts $f "" 273 puts $f "set length $length" 274 puts $f "set minnum $minnum" 275 puts $f "set minupper $minupper" 276 puts $f "set minlower $minlower" 277 close $f 278} 279 280# insert char into password at a random position 281proc insert {pvar char} { 282 upvar $pvar p 283 284 set p [linsert $p [rand [expr 1+[llength $p]]] $char] 285} 286 287# given a size, distribute between left and right hands 288# taking into account where we left off 289proc psplit {max lvar rvar} { 290 upvar $lvar left $rvar right 291 global isleft 292 293 if {$isleft} { 294 set right [expr $max/2] 295 set left [expr $max-$right] 296 set isleft [expr !($max%2)] 297 } else { 298 set left [expr $max/2] 299 set right [expr $max-$left] 300 set isleft [expr $max%2] 301 } 302} 303 304proc password_generate {} { 305 global password length minnum minlower minupper 306 global lpass rpass initially_left isleft 307 global distribute 308 309 if {$distribute} { 310 set lkeys {q w e r t a s d f g z x c v b} 311 set rkeys {y u i o p h j k l n m} 312 set lnums {1 2 3 4 5 6} 313 set rnums {7 8 9 0} 314 } else { 315 set lkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} 316 set rkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} 317 set lnums {0 1 2 3 4 5 6 7 8 9} 318 set rnums {0 1 2 3 4 5 6 7 8 9} 319 } 320 set lkeys_length [llength $lkeys] 321 set rkeys_length [llength $rkeys] 322 set lnums_length [llength $lnums] 323 set rnums_length [llength $rnums] 324 325 # if there is any underspecification, use additional lowercase letters 326 set minlower [expr $length - ($minnum + $minupper)] 327 328 329 set lpass "" ;# password chars typed by left hand 330 set rpass "" ;# password chars typed by right hand 331 set password "" ;# merged password 332 333 # choose left or right starting hand 334 set initially_left [set isleft [rand 2]] 335 336 psplit $minnum left right 337 for {set i 0} {$i<$left} {incr i} { 338 insert lpass [lindex $lnums [rand $lnums_length]] 339 } 340 for {set i 0} {$i<$right} {incr i} { 341 insert rpass [lindex $rnums [rand $rnums_length]] 342 } 343 344 psplit $minlower left right 345 for {set i 0} {$i<$left} {incr i} { 346 insert lpass [lindex $lkeys [rand $lkeys_length]] 347 } 348 for {set i 0} {$i<$right} {incr i} { 349 insert rpass [lindex $rkeys [rand $rkeys_length]] 350 } 351 352 psplit $minupper left right 353 for {set i 0} {$i<$left} {incr i} { 354 insert lpass [string toupper [lindex $lkeys [rand $lkeys_length]]] 355 } 356 for {set i 0} {$i<$right} {incr i} { 357 insert rpass [string toupper [lindex $rkeys [rand $rkeys_length]]] 358 } 359 360 # merge results together 361 if {$initially_left} { 362 regexp "(\[^ ]*) *(.*)" "$lpass" x password lpass 363 while {[llength $lpass]} { 364 regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass 365 regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass 366 } 367 if {[llength $rpass]} { 368 append password $rpass 369 } 370 } else { 371 regexp "(\[^ ]*) *(.*)" "$rpass" x password rpass 372 while {[llength $rpass]} { 373 regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass 374 regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass 375 } 376 if {[llength $lpass]} { 377 append password $lpass 378 } 379 } 380} 381 382proc rand {m} { 383 expr {int($m*rand())} 384} 385 386proc gen_bad_args {msg} { 387 if {![llength [info commands .parameters.errmsg]]} { 388 message .parameters.errmsg -aspect 300 389 pack .parameters.errmsg 390 } 391 .parameters.errmsg configure -text "$msg\ 392 Please adjust the password generation arguments." 393} 394 395 396# tell tab what window to move between 397set parm_tabList {} 398 399# The procedure below is invoked in response to tabs in the entry 400# windows. It moves the focus to the next window in the tab list. 401# Arguments: 402# 403# list - Ordered list of windows to receive focus 404 405proc Tab {list} { 406 set i [lsearch $list [focus]] 407 if {$i < 0} { 408 set i 0 409 } else { 410 incr i 411 if {$i >= [llength $list]} { 412 set i 0 413 } 414 } 415 focus [lindex $list $i] 416} 417 418# adjust args used in password generation 419proc adjust_parameters {} { 420 global parm_tabList 421 set parm_tabList {} 422 423 toplevel [set w .parameters] 424 425 message $w.text -aspect 300 -text \ 426"These parameters control generation of random passwords. 427 428It is not necessary to move the mouse into this window to operate it.\ 429Press <tab> to move to the next entry.\ 430Press <return> or click the <ok> button when you are done." 431 432 foreach desc { 433 {length {total length}} 434 {minnum {minimum number of digits}} 435 {minupper {minimum number of uppercase letters}} 436 {minlower {minimum number of lowercase letters}}} { 437 set name [lindex $desc 0] 438 set text [lindex $desc 1] 439 frame $w.$name -bd 1 440 entry $w.$name.entry -relief sunken -width 2 -textvar $name 441 bind $w.$name.entry <Tab> "Tab \$parm_tabList" 442 bind $w.$name.entry <Return> "destroy_parm_window" 443 label $w.$name.text -text $text 444 pack $w.$name.entry -side left 445 pack $w.$name.text -side left 446 lappend parm_tabList $w.$name.entry 447 } 448 frame $w.2 -bd 1 449 checkbutton $w.2.cb -text "alternate characters across hands" \ 450 -relief flat -variable distribute 451 pack $w.2.cb -side left 452 453 button $w.ok -text "ok" -command "destroy_parm_window" 454 pack $w.text -expand 1 -fill x 455 pack $w.length $w.minnum $w.minupper $w.minlower $w.2 -expand 1 -fill x 456 pack $w.ok -side left -fill x -expand 1 -padx 2 -pady 2 457 458 set oldfocus [focus] 459 tkwait visibility $w.length.entry 460 focus $w.length.entry 461 tkwait window $w 462 focus $oldfocus 463 save_parameters 464} 465 466proc isnumber {n} { 467 regexp "^\[0-9\]+$" $n 468} 469 470# destroy parm window IF all values are legal 471proc destroy_parm_window {} { 472 global minnum minlower minupper length 473 474 set mustbe "must be a number greater than or equal to zero." 475 476 # check all variables 477 if {![isnumber $length]} { 478 gen_bad_args "The total length $mustbe" 479 return 480 } 481 if {![isnumber $minlower]} { 482 gen_bad_args "The minimum number of lowercase characters $mustbe" 483 return 484 } 485 if {![isnumber $minupper]} { 486 gen_bad_args "The minimum number of uppercase characters $mustbe" 487 return 488 } 489 if {![isnumber $minnum]} { 490 gen_bad_args "The minimum number of digits $mustbe" 491 return 492 } 493 494 # check constraints 495 if {$minnum + $minlower + $minupper > $length} { 496 gen_bad_args \ 497 "It is impossible to generate a $length-character password with\ 498 $minnum number[pluralize $minnum],\ 499 $minlower lowercase letter[pluralize $minlower], and\ 500 $minupper uppercase letter[pluralize $minupper]." 501 return 502 } 503 504 destroy .parameters 505} 506 507# return appropriate ending for a count of "n" nouns 508proc pluralize {n} { 509 expr $n!=1?"s":"" 510} 511 512 513proc get_old_password {} { 514 global old 515 516 toplevel .old 517 label .old.label -text "Old password:" 518 catch {unset old} 519 entry .old.entry -textvar old -relief sunken -width 1 520 521 pack .old.label 522 pack .old.entry -fill x -padx 2 -pady 2 523 524 bind .old.entry <Return> {destroy .old} 525 set oldfocus [focus] 526 focus .old.entry 527 tkwait visibility .old 528 grab .old 529 tkwait window .old 530 focus $oldfocus 531 return $old 532} 533 534.unsorted select 535.passwd invoke 536 537proc make_selection {} { 538 global selection_line last_line 539 540 .names tag remove selection 0.0 end 541 542 # don't let selection go off top of screen 543 if {$selection_line < 1} { 544 set selection_line $last_line 545 } elseif {$selection_line > $last_line} { 546 set selection_line 1 547 } 548 .names yview -pickplace [expr $selection_line-1] 549 .names tag add selection $selection_line.0 [expr 1+$selection_line].0 550} 551 552proc select_next_nopassword {direction} { 553 global selection_line last_line nopasswords 554 555 if {0==[llength $nopasswords]} { 556 feedback "no null passwords" 557 return 558 } 559 560 if {$direction==1} { 561 # is there a better way to get last element of list? 562 if {$selection_line>=[lindex $nopasswords [expr [llength $nopasswords]-1]]} { 563 set selection_line 0 564 } 565 foreach i $nopasswords { 566 if {$selection_line<$i} break 567 } 568 } else { 569 if {$selection_line<=[lindex $nopasswords 0]} { 570 set selection_line $last_line 571 } 572 set j [expr [llength $nopasswords]-1] 573 for {} {$j>=0} {incr j -1} { 574 set i [lindex $nopasswords $j] 575 if {$selection_line>$i} break 576 } 577 } 578 set selection_line $i 579 make_selection 580} 581 582proc select {w coords} { 583 global selection_line 584 585 $w mark set insert "@$coords linestart" 586 $w mark set anchor insert 587 set first [$w index "anchor linestart"] 588 set last [$w index "insert lineend + 1c"] 589 scan $first %d selection_line 590 591 $w tag remove selection 0.0 end 592 $w tag add selection $first $last 593} 594 595bind Text <1> {select %W %x,%y} 596bind Text <Double-1> {select %W %x,%y} 597bind Text <Triple-1> {select %W %x,%y} 598bind Text <2> {select %W %x,%y} 599bind Text <3> {select %W %x,%y} 600bind Text <B1-Motion> {} 601bind Text <Shift-1> {} 602bind Text <Shift-B1-Motion> {} 603bind Text <B2-Motion> {} 604 605bind .password <Control-n> {incr selection_line 1; make_selection} 606bind .password <Control-p> {incr selection_line -1;make_selection} 607bind .password <Meta-n> {select_next_nopassword 1} 608bind .password <Meta-p> {select_next_nopassword -1} 609bind .password <Control-g> {password_generate} 610bind .password <Control-a> {adjust_parameters} 611bind .password <Control-u> {set password ""} 612bind Entry <Control-c> {exit} 613