1# 2# <20190707.1805.40> 3# 4##################### Start of Documentation ################################### 5# Commands: 6# ::pwLocker::getPw Asks for password given Id 7# ::pwLocker::putPw Encripts a password and puts it in the table 8# ::pwLocker::init Sets addresses of en/decript routine, 9# table address & table save routine 10 11# This is an attempt to provide a password locker to 12# keep multiple passwords and recall them by id. 13# Most of the time the id will be a VFS address and user. 14# However we will not restrict the id so almost anything 15# will work. Well, not really. We create password entries 16# that start with "protocol" "://" "username" "@" "address" 17# However, while we keep all of this, we allow "nil" protocol, 18# and address. We replace "nil" address with "localhost" and 19# assume that is also kept in the table. 20# On fetching a password we decrypt it and pass it back as a result. 21# 22# To provide a bit of security, we require a "use pattern" 23# which must match one of the functions in the call stack 24# or we don't return the password. This means you can not 25# just call up tkcon and call this routine to get the 26# unencrypted password. 27# 28# The saved password then has three parts: 29# 1) The ID, must be unique. 30# 2) An encrypted password. (This may be 3 parts as well.) 31# 3) A "use pattern" which matches (glob match) a tcl 32# function in the call stack. 33# 34# This code does NOT encrypt or decrypt but rather calls 35# other code to do that. It is hoped that at some time 36# we may have more advanced encrypt/decrypt code. 37# 38# For password storage we use a provided list of (triplets). 39# passed in by name. 40 41# The three parts of the password are: 42# a) the password 43# b) the identfile 44# c) the passphrase 45# 46# For the most part (always?) only ssh and friends use parts b) and c). 47# ssh and friends include ssh, scp, sftp rsync and putty 48 49# To initialize, call: 50# 51# ::pwLocker::init passwdList encryptRoutine decryptRoutine Save 52# 53# where passwdList is the name of the password list 54# encryptRoutine and decryptRoutine are commands and 55# possible leading parms. Save is an optional command to 56# save a modified "passwdList" and is called whenever the 57# list is modified (i.e. a new password is saved). 58# The password of interest will be added to these as 59# they are called. 60# 61# The passwordList entry should be an Id (which is an arbitrary 62# string) followed by the encrypted password followed by an 63# arbitrary entries. If a password entry is replaced, these 64# will be saved. As a matter of convience the port (i.e. :<num>) 65# is only considered part of the id if so requested (see below). 66# 67# A small attempt at protection: 68 69# If a ::pwLocker::getPw request is made from a 'level' of less than 2 an 70# "Illegal attempt to access passwordLocker" 71# error is thrown unless the calling proc matches "*MenuInvoke". 72# In filerunner this intercepts command line and tkcon calls to get a password. 73# 74# To get a password: 75# ::pwLocker::getPw Id args 76# 77# where Id is the id the password is stored under. 78# The Id is assumed to have URL format and may or may not 79# contain the user name. Examples: 80# ftp://user@address a full url 81# ftp://@address (or ftp:://address) has a null user name 82# ://user@host a null protocol used for user 83# :// null protocol, user & host 84# (host taken as localhost) 85# user All null except user name, taken to mean 86# ://user@localhost 87# ftp://*@address Any user name (glob characters may be used) 88# Null protocol assumes a non-protocol related request such as 89# might be used with "sudo". 90 91# If the user name is supplied and the id is found 92# the password is returned. Otherwise, if "noprompt" is false 93# a GUI is presented to ask for the password. If the username 94# is changed as part of that response and no password is 95# provided, the URL with the name modified is looked up 96# (as if a new call). If a password is entered in the GUI then 97# it is returned (even if the username is changed). In this 98# case the caller has no clue that the name was changed. 99# 100# If "noprompt" is true -1 is returned on failure. 101# If "returnall" is true, sucess returns the password and 102# failure will return all fields from the GUI responce. 103 104# If found and the "use pattern" fails to find 105# a satisfying proc, an error is thrown. 106 107# Args is a (possibly empty) set of doublets with the following meaning: 108 109# key: value: 110# user <username> If the Id has a null name, this is used. This is also 111# be part of the requested input in the GUI. 112# newuser <bool> If true, a new user name is allowed. If neither the Id 113# or the "user" (above) is provided, this is defaulted to 114# true, otherwise the default is false. 115# abort <bool> or string If string, throw error "<string>" if Cancel or window 116# destroyed. 117# If 1 throw "User aborted request" on Cancel or window 118# destroyed. 119# If 0 (default) return -1 on Cancel of window destroyed. 120# full <bool> If true, return all 3 parts of the password 121# {password identfile passphrase} default is to just 122# return the password part. This also affects the 123# GUI prompt if no password is found. If true all three 124# parts are requested, if false, only the password part. 125# Default is false. 126# prompt {info} If prompting for a password, include {info} in the request. 127# If 'prompt' is present and not {}, a prompt is forced even 128# if a password is present. This should be the second call 129# once it is found that the first password has failed. 130# startwith <list> If prompting, use these <list> hints. <list> is taken as 131# the three parts of a password. This would usually be used 132# where a prior request failed to "open" the resource. 133# If this option is coded, pwLocker goes immediately to 134# the GUI prompt without looking for an existing entry in 135# the locker. 136# useport <bool> Usually the port is excluded from the id search. If this 137# is true, the port will be included. In any case, if 138# port is in the id it will be included in any saved 139# password id. The port string is ":<n>" where <n> is 140# a decimal number of at least 1 digit. 141# noprompt <binary> Do not prompt if no password found, just return -1 142# nocase <binary> It true, do a 'nocase' search. 143# display <ops> <ops> should be a dictionary with name followed by the 144# starting value. Each entry will result in a display of 145# with the value given. E.G. display {z: {} newname foo} 146# would give two entrys "z:" <blank> and "newname" foo. 147# The returnall option will return these values. 148# returnall <bool> If true, all the detail will be returned as a dict list 149# e.g. password <value> op<n> <value> save <bool> name <value> 150# In this case the password is saved or not depending on 151# the presents of the "display" option and the "keep" 152# option from the GUI result. If "keep" is true and "display" 153# is not coded, the keep is honored. Otherwise, it is 154# expected that the "display" results need to be examined 155# and/or used by the caller to do the save. 156 157# keys may be abbreviated (to any unique set of one or more letter(s) 158# 159# Note that a -1 return is used for "no password" including a "Cancel" result 160# on a prompt. This is to allow a nil password as a possible return. 161 162# To put a password: 163# 164# ::pwLocker::putPw newId newPassWord args 165# 166# If 'newId' is already in the password list, that 167# entry is deleted. The new entry is then added to 168# the front of the list (after being encrypted) 169# Here "args" is a list of arbitrary length 170# which this code just appends these to the entry. 171 172##################### End of Documentation ################################### 173# 174# the debug flag turns off the initial clearing of the pwroutines 175# and the security checks... 176set pwLockerDebug 1 177namespace eval pwLocker { 178 # Set to 0 to allow reload for debugging 179 if {$::pwLockerDebug} { 180 variable pwAddress 181 variable encryptRoutine 182 variable decryptRoutine 183 variable saveFun 184 } else { 185 variable pwAddress {} 186 variable encryptRoutine {} 187 variable decryptRoutine {} 188 variable saveFun {} 189 } 190 191 proc init {name encrypt decrypt {SaveFun {}}} { 192 variable encryptRoutine $encrypt 193 variable decryptRoutine $decrypt 194 variable pwAddress $name 195 variable saveFun $SaveFun 196 } 197 198 proc getPw {id args} { 199 variable {} 200 variable pwAddress 201 variable encryptRoutine 202 variable decryptRoutine 203 array unset ::pwLocker:: * 204 # was init called??? 205 foreach par {pwAddress encryptRoutine decryptRoutine} { 206 if {[set $par] == {}} { 207 return -code error\ 208 "pwLocker::getPw detected no or incorrect pwLocker::init call." 209 } 210 } 211 # Ok, lets take a look... 212 set keys {full prompt startwith noprompt nocase newuser 213 abort useport display returnall user} 214 set binKeys {abort full useport noprompt nocase returnall newuser} 215 foreach key $keys { 216 if {$key in $binKeys} { 217 set $key 0 218 } else { 219 set $key {} 220 } 221 } 222 lappend abort "User aborted request." 0 223 while {$args ni {{} {{}}} } { 224 set args [lassign $args opt] 225 frputs args opt 226 # is this a list? 227 if {[llength $opt] > 1} { 228 # yes, break it up and push it ahead of the rest 229 set args [linsert $args 0 {*}$opt] 230 continue 231 } 232 # not a list, get value part... 233 set args [lassign $args value] 234 frputs value 235 set tar [lsearch -glob -all -inline $keys "$opt*"] 236 if {$tar == -1 || [llength $tar] != 1} { 237 error "pwLocker::getPw: option ($opt) must be one of $keys but was $tar" 238 } 239 set ${tar}Provided 1 240 if {$tar in $binKeys} { 241 set $tar $value 242 } else { 243 lappend $tar $value 244 } 245 } 246 set (-full-) $full 247 frputs full (-full-) prompt Id id 248 if {![regexp {(([^:]+)://){0,1}(([^@]+)($|@($|([^/]+)($|/.*$))))} $id ->\ 249 i1 protcol i3 uname i5 i6 addr i8]} { 250 # Very bad news, not one of the id formats we recognize 251 return -code error "Password Locker: unrecognized id format" 252 } 253 # Break the Id apart and fill in the blanks, if possible. We assume we are 254 # either dealing with a URL (protocol://{user@}add{/path} 255 # Or a simple password (user{@add}) 256 # Note that in the simple password the address is optional 257 # while in the URL the user is optional... 258 # 259 if {[IsVFS $id]} { 260 append VFSpro "://" 261 lassign [split $VFSadd @] (user) VFSadd 262 if {$VFSadd == {}} { 263 set VFSadd $(user) 264 set (user) {} 265 } 266 } else { 267 set VFSpro {} 268 lassign [split $id @] (user) VFSadd 269 if {$VFSadd == {}} { 270 set VFSadd "localhost" 271 } 272 } 273 # set len [string length $id] 274 # set eoprot [string first "://" $id] 275 # set protocol [string range $id 0 $eoprot-1] 276 # set eousr [string first "@" $id] 277 # set afterSlash [expr {$eoprot == -1 ? 0 : $eoprot+3}] 278 # if {$eousr == -1} { 279 # set (user) {} 280 # set add [string range $id $afterSlash end] 281 # } else { 282 # set (user) [string range $id $afterSlash $eousr-1] 283 # set add [string range $id $eousr+1 end] 284 # } 285 286 if {$useport != 1} { 287 set adds [regsub {:\d+} $VFSadd {*}] 288 } 289 290 if {$user != {}} { 291 # specified user overrides one in the id 292 set (user) [lindex $user end] 293 } 294 if {$(user) == {} && ![info exists newuserProvided]} { 295 set newuser 1 296 } 297 while {1} { 298 set Id $VFSpro 299 append Id [expr {$(user) == {} ? {} : "$(user)@"}] $adds 300 # we need to special case cifs because the VFS 'path' is really 301 # part of the share 302 if {$VFSpro == "cifs://"} { 303 set end [expr {[set pend [string first / $VFSpath 1]] == -1 ? 304 "end" : $pend -1}] 305 append Id [string range 0 $end] 306 } 307 # Got the options, do the work 308 if {$startwith != {}} { 309 set la {} 310 lassign {*}$startwith (password) (disk) (passphrase) 311 } else { 312 lassign {} (password) (disk) (passphrase) 313 } 314 set la [lsearch -glob -inline -all\ 315 {*}[expr {$nocase ? "-nocase" : ""}]\ 316 -index 0 [set $pwAddress] $Id] 317 frputs la 318 if {[llength $prompt] > 0} { 319 set la {} 320 } 321 frputs la prompt (user) Id 322 switch -exact [llength $la] { 323 0 { 324 # Password not found, here we ask for it with several options... 325 if {$noprompt == 1} { 326 return -1 327 } 328 set la2 {} 329 set pr {} 330 set co 0 331 set mesChoose {} 332 if {$newuser} { 333 incr co 334 lappend pr [list [_ "User name:"] \ 335 [list -textvariable [namespace current]::(user) \ 336 -state [expr {$newuser ? "normal" : "disabled"}]]] 337 } 338 set (-showCount-) $co 339 incr co 340 lappend pr [list [_ "Password:"] \ 341 [list -textvariable [namespace current]::(password)\ 342 -show "*" ]] 343 if {$(-full-) == 1} { 344 incr co 2 345 lappend pr [list [_ "ssh private key disk address:"]\ 346 [list -textvariable [namespace current]::(disk) \ 347 -show "*" ]] 348 lappend pr [list [_ "Pass phrase:"]\ 349 [list -textvariable [namespace current]::(passphrase)\ 350 -show "*" ]] 351 } 352 set opc 0 353 # We use the "-" to avoid collisions with our vars 354 frputs display 355 if {$display != {}} { 356 foreach {val op} {*}$display { 357 incr co 358 set (${val}) $op 359 lappend pr [list $val:\ 360 [list -textvariable [namespace current]::(${val})]] 361 } 362 } 363 #set (name) $user 364 set (-showpw-) 0 365 set (keep) 0 366 set (-user-) $(user) 367 set (-pw-) [list $(password) $(disk) $(passphrase)] 368 incr co 4 369 set dId $VFSpro 370 append dId [expr {$(user) == {} ? $VFSadd : "$(user)@$VFSadd"}] 371 frputs dId (user) VFSadd 372 set (-uni-) [incr ::uni] 373 set rt [smart_dialog .password_entry_dialog$(-uni-) . PassWord \ 374 [concat [list $mesChoose {} [_ "Enter password for %s\n\ 375 \nOK activates, cancel or window-delete cancels."\ 376 $dId] "\n"] {*}$prompt]\ 377 0 $co [list {*}$pr \ 378 [list [_ "Keep Password"] \ 379 [list -variable [namespace current]::(keep)]]\ 380 [list [_ "Show password"] \ 381 [list -variable [namespace current]::(-showpw-)\ 382 -command [namespace current]::PwShow]]\ 383 [list [_ "OK"]]\ 384 [list [_ "Cancel"]]\ 385 ]\ 386 ] 387 frputs "[namespace current] " rt co abort 388 if {$rt == -1 || $rt == ($co -1)} { 389 if {[string is boolean [set v [lindex $abort end]]]} { 390 frputs v 391 if {!$v} { 392 return -1 393 } else { 394 return -code error [lindex $abort 0] 395 } 396 } 397 return -code error "$v" 398 } 399 set pw [list $(password) $(disk) $(passphrase)] 400 # If the username was changed.... 401 # if the pass word was not changed, check for the new user 402 frputs (user) (-user-) (-pw-) pw 403 if {$(user) != $(-user-) && $(-pw-) == $pw} {continue} 404 405 # We have a new user and a new password. 406 if {$(keep) && $display == {}} { 407 append (id) $VFSpro $(user) "@" $VFSadd 408 frputs (id) pw 409 putPw $(id) $pw 410 } 411 if {$returnall} { 412 frputs 413 # build the id based on the new info 414 return [array get ::pwLocker:: {[a-zA-Z]*}] 415 } 416 if {$(-full-) != 1} { 417 return $(password) 418 } 419 return $pw 420 } 421 default { 422 if {[info level] <= 1 && !$::pwLockerDebug} { 423 array set info [info frame -2] 424 if {![string match *MenuInvoke $info(proc)]} { 425 frputs info(proc) 426 return -code error\ 427 "Illegal attempt to access passwordLocker for $id" 428 } 429 } 430 array unset info 431 # We may have more than one. This is Ok only if the resulting 432 # passwords are all the same. 433 434 set pwds {} 435 set pwdCount 0 436 foreach ent $la { 437 set fpw [eval [list {*}$decryptRoutine [lindex $ent 1]]] 438 if {$fpw ni $pwds} { 439 lappend pwds $fpw 440 incr pwdCount 441 } 442 } 443 frputs pwds pwdCount la 444 if {$pwdCount > 1} { 445 return -code error "Password locker found $pwdCount passwords \ 446 for\n$id" 447 } 448 if {$(-full-) == 1} { 449 return [array get {} {[a-zA-Z]}] 450 } 451 return [lindex $fpw 0 0] 452 } 453 } 454 } 455 } 456 proc PwShow {} { 457 variable {} 458 set add $(-showCount-) 459 frputs add 460 set showChar [expr {$(-showpw-) ? {} : {*}}] 461 .password_entry_dialog$(-uni-).$add config -show $showChar 462 if {$(-full-)} { 463 464 .password_entry_dialog$(-uni-).[incr add] config -show $showChar 465 .password_entry_dialog$(-uni-).[incr add] config -show $showChar 466 } 467 } 468 469 # args will be appended to the password entry after the password 470 # for vfs and cifs passwords these are drive and flag words 471 472 proc putPw {newId newPw args} { 473 variable pwAddress 474 variable encryptRoutine 475 variable saveFun 476 set newId [regsub -all {\*} $newId {}] 477 set la [lsearch -exact -index 0 [set $pwAddress] $newId] 478 set extra {} 479 if {$la != -1} { 480 set extra [lrange [lindex [set $pwAddress] $la] 2 end] 481 set $pwAddress [lreplace [set $pwAddress] $la $la] 482 } else { 483 set extra $args 484 } 485 set pw [eval [list {*}$encryptRoutine $newPw]] 486 set $pwAddress [linsert [set $pwAddress] 0 [list $newId $pw {*}$extra]] 487 if {$saveFun != {}} { 488 eval [list {*}$saveFun] 489 } 490 } 491 492} 493