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