
#
# <20240712.1729.39>
#
##################### Start of Documentation  ###################################
# Commands:
# ::pwLocker::getPw       Asks for password given Id
# ::pwLocker::putPw       Encripts a password and puts it in the table
# ::pwLocker::patternGet  Returns entries that match a pattern
# ::pwLocker::delete      Deletes one or more entries
# ::pwLocker::init        Sets addresses of en/decript routine,
#                         table address & table save routine

# This is an attempt to provide a password locker to
# keep multiple passwords and recall them by id.
# Most of the time the id will be a VFS address and user.
# However we will not restrict the id so almost anything
# will work. Well, not really. We create password entries
# that start with "protocol" "://" "username" "@" "address"
# However, while we keep all of this, we allow "nil" protocol,
# and address. We replace "nil" address with "localhost" and
# assume that is also kept in the table.
# On fetching a password we decrypt it and pass it back as a result.
#
#
# The saved password then has three parts:
# 1) The ID, must be unique.
# 2) An encrypted password. (This may be 3 parts as well.)
# 3) Part-3, an optional 'list' containing things that may be useful, e.g.
#    comments,
#
# This code does NOT encrypt or decrypt but rather calls
# other code to do that. It is hoped that at some time
# we may have more advanced encrypt/decrypt code.
#
# For password storage we use a provided list of (triplets).
# passed in by name.

# The three parts of the password are:
# a) the password
# b) the identfile
# c) the passphrase
#
# For the most part (always?) only ssh and friends use parts b) and c).
# ssh and friends include ssh, scp, sftp rsync and putty
# Because this is true we will not even provide lines in our GUI to enter
# or modify parts b) and c) unless the 'ID' indicates it is for one of
# ssh and friends.


# To initialize, call:
#
# ::pwLocker::init passwdList encryptRoutine decryptRoutine Save
#
#                  where passwdList is the name of the password list
#                  encryptRoutine and decryptRoutine are commands and
#                  possible leading parms. Save is an optional command to
#                  save a modified "passwdList" and is called whenever the
#                  list is modified (i.e. a new password is saved).
#                  The password of interest will be added to these as 
#                  they are called.
#
#                  The passwordList entry should be an Id (which is an arbitrary
#                  string) followed by the encrypted password followed by an
#                  arbitrary entries. If a password entry is replaced, these
#                  will be saved. The port (i.e. :<num>) is considered part of
#                  the server name an so part of the id.
#
#
# To get a password:
# ::pwLocker::getPw Id args
#
#                        where Id is the id the password is stored under.
#                        The Id is assumed to have URL format and may or may not
#                        contain the user name. Examples:
#                        ftp://user@address      a full url
#                        ftp://@address  (or ftp:://address)  has a null user name
#                        ://user@host   a null protocol used for user
#                        ://            null protocol, user &  host
#                                       (host taken as localhost)
#                        user           All null except user name, taken to mean
#                                       ://user@localhost or, more concisely
#                                       user@localhost
#                        ftp://*@address Any user name (glob characters may be used)
#                        Null protocol assumes a non-protocol related request such as
#                        might be used with "sudo".
#                        Id may be a pattern which is used to search for entries. This
#                        may result in more than one (or even all) entries to be
#                        returned as a list.

#                        If the user name is supplied and the id is found
#                        the password is returned. Otherwise, if "noprompt" is false
#                        a GUI is presented to ask for the password. If the username
#                        is changed as part of that response and no password is
#                        provided, the URL with the name modified is looked up
#                        (as if a new call). If a password is entered in the GUI then
#                        it is returned (even if the username is changed). In this
#                        case the caller has no clue that the name was changed.
#                       
#                        If "noprompt" is true -1 is returned on failure.
#                        If "returnall" is true, sucess returns the password and
#                        failure will return all fields from the GUI responce.

#                        If found and the "use pattern" fails to find
#                        a satisfying proc, an error is thrown.

# Args is a (possibly empty) set of doublets with the following meaning:

#    key:     value:
#    newpassword <bool>  If true an entry window will be displayed. In general if
#                        this is true the only other option should be 'prompt'
#                        (which is optional). The prompt window will be dynamic
#                        (only asking for three part passwords for ssh and sftp
#                        entries). 
#    user   <username>   If the Id has a null name, this is used. This is also
#                        be part of the requested input in the GUI.
#    newuser <bool>      If true, a new user name is allowed. If neither the Id
#                        or the "user" (above) is provided, this is defaulted to
#                        true, otherwise the default is false.
#    abort   <bool> or string  If string, throw error "<string>" if Cancel or window
#                        destroyed.
#                        If 1 throw "User aborted request" on Cancel or window
#                        destroyed.
#                        If 0 (default) return -1 on Cancel of window destroyed.
#    full     <bool>     If true, return all 3 parts of the password
#                        {password identfile passphrase} default is to just
#                        return the password part. This also affects the
#                        GUI prompt if no password is found. If true all three
#                        parts are requested, if false, only the password part.
#                        Default is false.
#    prompt   {info}     If prompting for a password, include {info} in the request.
#                        If 'prompt' is present and not {}, a prompt is forced even
#                        if a password is present. This should be the second call
#                        once it is found that the first password has failed.
#    startwith <list>    If prompting, use these <list> hints. <list> is taken as
#                        the three parts of a password (password, disk,
#                        passphrase). This would usually be
#                        used where a prior request failed to "open" the resource.
#                        If this option is coded, pwLocker goes immediately to
#                        the GUI prompt without looking for an existing entry in
#                        the locker.
#    comment   <list>    When prompting for a password this <list> will be taken
#                        as a starter for the comment field. If not supplied and
#                        the given 'Id' exists the comment field from that entry
#                        will be used. If supplied and <list> is '{}' a blank
#                        comment field will be used.
#    useport   <bool>    Usually the port is excluded from the id search. If this
#                        is true, the port will be included. In any case, if
#                        port is in the id it will be included in any saved
#                        password id. The port string is ":<n>" where <n> is
#                        a decimal number of at least 1 digit.
#    noprompt <binary>   Do not prompt if no password found, just return -1
#    nocase   <binary>   (default true) If true, do a 'nocase' search.
#    display  <ops>      <ops> should be a dictionary with 'key' name followed by the
#                        starting value. Each entry will result in a display of 
#                        with the value given. E.G. display {z: {} newname foo}
#                        would give two entrys "z:" <blank> and "newname" foo.
#                        It is an error to use one of the return keys (see below)
#                        as an <ops> key.
#                        The returnall option will return these values.
#    returnall <bool>    If true, and a prompt was used (i.e. a GUI was presented)
#                        all the detail will be returned as a dict list
#                        see below.
#                        In this case the password is saved or not depending on
#                        the presence of the "display" option and the "keep"
#                        option from the GUI result. If "keep" is true and "display"
#                        is not coded, the keep is honored. Otherwise, it is
#                        expected that the "display" results need to be examined
#                        and/or used by the caller to do the save.

#                        If 'returnall' is true and the password exists (or is
#                        created from a gui prompt) all its details are returned
#                        as a dict. list with the following 'keys' and values:

#                        id          <full id i.e. type://name@address:port>,
#                        user        <name>,
#                        type        <type>    (the part of fullid before the :),
#                        address     <address>
#                        port        <port>,
#                        password    <full 3 part password> (as a list),
#                        disk        <disk address part of password>,
#                        passphrase  <third part of password>,
#                        comment     <the comment list>,
#                         the following keys are only include if 'display' is set
#                        keep        <the keep boolean>
#                        (ops-keys)  <display options list> (only if 'display' is set)
#                                    this is returned using the callers keys
#    returnlist <bool>  If true return is a list of {id password comment}. This
#                        allows the user to respond to id changes as needed.

#  keys may be abbreviated (to any unique set of one or more letter(s)
#
#  Note that a -1 return is used for "no password" on a prompt. If 'returnall' is true
#  in this case, the returned password will be an empty string.
#  This is to allow a nil password as a possible return.
#  A -2 indicates a "Cancel" result.

# The following two routines are intended mainly to be used for maintance of the
# password locker.

# To get passwords using a pattern:
#
# ::pwLocker::patternGet pattern args
#
#                        The 'pattern' is applied to the ID.

# args are optional key value pairs as follows:
#
#  key       value        meaning
#  pattern2  pattern     This pattern will be applied to the entries part-3
#                        (the optional list). The whole of 'part-3' is treated as a
#                        string for this match.
#  case      <bool>      If true the search is done in a case sensitive manner
#                        (Usuall case is not important thus the default of nocase.)
#  !         0-3         Invert the pattern match sense:
#                        0 does nothing,
#                        1 invert pattern1 match
#                        2 invert pattern2 match (ignored if no pattern2)
#                        3 invert both patterns match
#  regexp    <bool>      If true treat both patterns as regular expressions

# Note that if the user name is nil ({}) there will be no '@' in the id. This is
# easily handled by 'regexp' but not 'glob' patterns.

# The result of ::pwLocker::patternGet pattern args is a list of password entries.
# Each element of the list will be {Id password comment}. Both 'password' and
# 'comment' may be lists ('password' has three part, see above).

# To delete one or more entries:

# ::pwLocker::delete pattern args
#
# args are optional key value pairs the same as ::pwLocker::patternGet


# To put a password:
#
# ::pwLocker::putPw newId newPassWord args
#
#                        If 'newId' is already in the password list, that
#                        entry is deleted. The new entry is then added to
#                        the front of the list (after being encrypted)
#                        Here "args" is a list of arbitrary length
#                        which this code just appends to the entry
#                        as a 'comment' sub list.
#
# The 'comment' value may be obtained with the 'returnall' or the returnlist
# option in the 'comment' entry.
#
#

##################### End of Documentation  ###################################
#
# the debug flag turns off the initial clearing of the pwroutines
# and the security checks...
set pwLockerDebug 1
namespace eval pwLocker {
  
  # Set to 0 to allow reload for debugging
  if {$::pwLockerDebug} {
    variable pwAddress      
    variable encryptRoutine 
    variable decryptRoutine 
    variable saveFun      
    variable keys {full prompt startwith noprompt nocase newuser newpassword
      abort display returnall user comment returnlist}
    variable binKeys {abort full noprompt nocase returnall
      newuser newpassword returnlist} 
  } else {
    variable pwAddress      {}
    variable encryptRoutine {}
    variable decryptRoutine {}
    variable saveFun        {}
  }
  
  proc init {name encrypt decrypt {SaveFun {}}} {
    variable encryptRoutine $encrypt
    variable decryptRoutine $decrypt
    variable pwAddress      $name
    variable saveFun        $SaveFun
  }
  # Helper, returns true if (url) starts with one of: ssh, scp, sftp rsync and putty
  variable sshAndFriends {ssh scp sftp rsync putty}
  proc sshNfriends {} {
    variable {}
    variable sshAndFriends
    if {[set colAd [string first ":" $(url)]] >= 3} {
      if {[lsearch -exact $sshAndFriends [string range $(url) 0 $colAd-1]] != -1} {
	return 1
      }
    }
    return 0
  }

    
  proc getPw {id args} {
    variable {}
    variable state "ssl"
    variable pwAddress
    variable encryptRoutine 
    variable decryptRoutine
    variable triPw
    #variable cifsPw
    variable noPw
    variable keys
    variable binKeys
    
    array unset ::pwLocker::
    frputs args (comment) 
    # was init called???
    foreach par {pwAddress encryptRoutine decryptRoutine} {
      if {[set $par] == {}} {
	return -code error\
	    "pwLocker::getPw detected no or incorrect pwLocker::init call."
      }
    }
    # Ok, lets take a look...
    foreach key $keys {
      if {$key in $binKeys} {
	set $key 0
      } else {	
	set $key {}
      }
    }
    lappend abort "User aborted request." 0
    while {$args ni {{} {{}}} } {
      set args [lassign $args opt]
      frputs args opt
      # is this a list?
      if {[llength $opt] > 1} {
	# yes, break it up and push it ahead of the rest
	set args [linsert $args 0 {*}$opt]
	continue
      }
      # not a list, get value part...
      set args [lassign $args value]
      frputs value
      set tar [lsearch -glob -all -inline $keys "$opt*"]
      if {$tar == -1 || [llength $tar] != 1} {
	error "pwLocker::getPw:\
               option \"$opt\" must be one of: \"$keys\" but was \"$tar\""
      }
      set ${tar}Provided 1
      if {$tar in $binKeys} {
	set $tar $value
      } elseif {$value != {}} {
	lappend $tar {*}$value
      }
    }
    frputs (comment) comment
    if {[info exists commentProvided]} {
      set (comment) $comment
    }
    if {![info exists nocaseProvided]} {
      set nocase 1
    }
    if {$newpassword} {
      set newuser 1
    }
    
    set (-full-) $full

    if {[string first "://" $id] == -1} {
      # if no protocol we assume -nil-://localhost
      # which we will set up as nil ("") with name and pw
      lassign {} (url) (type) (address) Id
      set (user) $id
      if {[set isAt [string first "@" $id]] + 1 == [string length $id]\
              && $isAt != -1} {
        set (user) [string range $id 0 end-1]
      } elseif {$isAt != -1} {
        # malformed id
        return -code error "Password Locker: \"$id\" is unrecognized id format."
      }
      #set Id $pro://
      if {$(user) != {}} {
        append Id $(user)
      }
    } else {
      set Id $id
      lassign [URLsplit $Id] (type) (user) (address) (port) path
      if {$(user) == {}} {
        set (user) $user
      }
      set Id $(type)://
      if {$(user) != {}} {
        append Id "$(user)@"
      }
      append Id $(address)
      set (url) $(type)://$(address)
      if {$(port) != {}} {
        append (url) :$(port)
        append Id    :$(port)
      }
      if {$(user) != {}} {
        set newuser 1
      }
    } 
    # rebuild the Id and the url (droping the path if any)
    
    
    # we need to special case cifs because the VFS 'path' is really
    # part of the share (if only because of the mount info in the comment)
    frputs  Id adds (url)
    # if {[string match -nocase $(type)  "cifs"] && $path != {}} {
    #   set end [expr {[set pend [string first / $path 1]] == -1 ?
    #     	     "end" : $pend -1}]
    #   append Id / [set pathOnly [string range $path 0 $end]]
    #   append (url) / $pathOnly
    # }
    # Got the options, do the work
    set la [lsearch -regexp -all\
		{*}[expr {$nocase ? "-nocase" : ""}]\
		-index 0 [set $pwAddress] $Id\($|/.*\)]
    frputs la Id
    if {[llength $la] > 0 && $Id != {}} {
      # We may have more than one. We address this by purging all but one.
      
      set maxPwLen 0
      foreach entIdx $la {
	set ent [lindex [set $pwAddress] $entIdx]
	set fpw [eval [list {*}$decryptRoutine [lindex $ent 1]]]
	set maxPwLen [expr {max ($maxPwLen, [set pwLen [string length $fpw]])}]
	lappend deletList [list $entIdx $pwLen $fpw]
      }
      # we keep the entry with the longest pw (assuming that means something)
      # reverse the list so we won't trip over things we remove earlier.
      foreach entp [lreverse $deletList] {
	lassign $entp idx len
	if {$len == $maxPwLen} {
	  # Keep this one
	  set ent [lindex [set $pwAddress] $idx]
          lassign [set fpw [lindex $entp 2]] (password) (disk) (passphrase)
          if {![info exists (comment)]} {
            set (comment) [lindex $ent 2]
          }
	  set maxPwLen -1
	} else {
	  set $pwAddress [lreplace [set $pwAddress] $idx $idx]
	}
      }
      set noPw 0
    } else {
      # we do not know this pw... set that up
      set fpw {}
      lassign {} (password) (disk) (passphrase)
      set noPw 1
    }
    frputs noPw newpasswprd startwith noprompt
    if {[llength $prompt] > 0 || $newpassword || $startwith != {} ||\
	  ($noPw && !$noprompt)} {
      if {$startwith != {}} {
	lassign $startwith (password) (disk) (passphrase)
      }
    } else {
      if {$noPw} {
	return -1
      } else {
	# We have a pass word and just need to return it as desired.
        if {$returnlist} {
          return [list [lindex $ent 0] $fpw [lindex $ent 2]]
        }
      	if {!$returnall} {
	  if {$(-full-) == 1} {
	    return $fpw
	  }
	  return [lindex $fpw 0 0]
	}
	# set up the returnall stuff
        set (id) [lindex $ent 0]
	set (comment) [lindex $ent 2]
	lassign [URLsplit $(id)] (type) user (address) (port) path

	lassign $fpw passwd (disk) (passphrase)
	# Make sure we allow "@" in the name...
	# if {[set namEnd [string last "@" $VFSadd]] != -1} {
	#   lappend result name [string range $VFSadd 0 $namEnd-1]
	# } else {
	#   set namEnd "end"
	# }
      }
      set (keep) 1
      set (url) $(type)://$(address)
      if {$(port) != {}} {
	append (url)  ":$(port)"
      }
      return [array get ::pwLocker:: {[a-zA-Z]*}]

      frputs la Id  end pend
    }
    # On to the gui...
    frputs la prompt (user) Id
    if {[set colAd [string first ":" $Id]] > 3} {
      set trackFullid [string range $Id 0 $colAd]
    }
    set (-showpw-) 0
    set (keep) 1
    while {1} {
      # Password not found or we are to ask for it with several options...
      if {$noprompt == 1} {
	return -1
      }
      set pr {}
      set co 1
      set mesChoose {}
      lappend pr  [list [_ "URL:"]\
		       [list -textvariable [namespace current]::(url)]]
      incr co
      lappend pr  [list [_ "User name:"] \
		       [list -textvariable [namespace current]::(user) \
			    -state [expr {$newuser ? "normal" : "readonly"}]]]
      set (-passWordAdd-) $co
      lappend pr  [list [_ "Password:"] \
		       [list -textvariable [namespace current]::(password)\
			    -show "*" ]]
      lappend pr [list uname \
		      [list -text $triPw\
			   -justify left \
			   -bd 2 -relief solid\
			   -bg $::config(gui,color_bg)\
			   -textvariable [namespace current]::(-subins)]]
      set (-subins) $triPw
      lappend pr [list [_ "Private key file name:"]\
		      [list -textvariable [namespace current]::(disk) \
			   -show "*" ]]
      lappend pr [list [_ "Pass phrase:"]\
		      [list -textvariable [namespace current]::(passphrase)\
			   -show "*" ]]
      lappend pr [list [_ "Comment:"]\
		      [list -textvariable [namespace current]::(comment)]]
      set (-cifsOps-) [incr co 3]
      set opc 0
      # We use the "-" to avoid collisions with our vars
      set (-display-) $display
      frputs display
      # place keepers...
      
      
      if {$display != {}} {
	foreach {val op} $display {
	  if {$op in {id name type address port password keep comment}} {
	    error "pwLocker::getPw: display key \"$op\" is reserved"
	  }
	  set (${val}) $op
	  lappend pr [list $val:\
			  [list -textvariable [namespace current]::(${val})]]
	}
      }
      set co [expr {[llength $pr] + 4}]
      
      # set dId $VFSpro
      # append dId [expr {$(user) == {} ? $VFSadd : "$(user)@$VFSadd"}]
      frputs dId (user)
      set (-uni-) [incr ::uni]
      #trace add variable [namespace current]::(user) write ::pwLocker::wrUser
      trace add variable [namespace current]::(url) write ::pwLocker::wrId
      set rt [smart_dialog .password_entry_dialog$(-uni-) . PassWord {}\
		  0 $co  [list {*}$pr \
			      [list [_ "Keep Password"] \
				   [list -variable [namespace current]::(keep)]]\
			      [list [_ "Show password"] \
				   [list -variable [namespace current]::(-showpw-)\
					-command  [namespace current]::PwShow]]\
			      [list [_ "OK"]\
                                   [list -command \
                                        [list [namespace current]::ok\
                                             .password_entry_dialog$(-uni-)]]]\
			      [list [_ "Cancel"]]\
			     ]\
		  textfun [list [namespace current]::textFun \
			       $mesChoose $prompt]\
		 ]
      frputs "[namespace current] " rt co abort
      if {$rt == ($co -1)} {set rt -2}
      if {$rt < 0} {
	if {[string is boolean [set v [lindex $abort end]]]} {
	  frputs v
	  if {!$v} {
	    return $rt
	  } else {
	    return -code error [lindex $abort 0]
	  }
	}
	return -code error "$v"
      }
      
      set pw $(password)
      # if {$state == "cifs"} {
      #   frputs (comment) 
      #   set (comment)  [list {*}$(disk) {*}$(passphrase) {*}$(comment)]
      # }
      if {$state == "ssl"} {
	lappend pw $(disk) $(passphrase)
      } else {
	lassign {} (disk) (passphrase)
      }
      # If the username was changed....
      # if the pass word was not changed, check for the new user
      frputs (user)   pw
      
      lassign [URLsplit $(url)] (type) user (address) (port) path

      if {$(user) == {}} {
	set (user) $user
      }
      set newId $(type)
        
      set (id) {}
      append (id) $(type) [expr {$(type) != {} ? "://" : ""}]  $(user)\
          [expr {$(user) != {} && $(address) != {} ? "@" : ""}]\
          $(address) [expr {$(port) == {} ? {} : ":$(port)"}]
      
         # [expr {$path == {}  ? "" : "/$path"}]

      frputs (id) pw (user) path (comment)
      if {$(keep) && $display == {}} {
	putPw $(id) $pw {*}$(comment)
      }
      if {$returnlist} {
        return [list $(id) $pw $(comment)]
      }
      if {!$returnall} {
	if {$(-full-) != 1} {
	  return $(password)
	} else {
	  return $pw
	}
      }
      return [array get ::pwLocker:: {[a-zA-Z]*}]
    }
	
  }
  # Come here when 'OK' button pushed
  proc ok {w} {
    variable state
    variable {}

    set ms {}
    lassign [URLsplit $(url)] (type) user (address) (port) path
    frputs state 
    if {$state == "ssl" && $(disk) != {} && ![file exists $(disk)]} {
      set ms "Disk file name \"$(disk)\" does not exist."
    } elseif {$(url) != {} && ($(type) == {} || $(address) == {})} {
      # Ill formed id/ url, lets try again
      set ms "If URL is provided, it must start with a \"type\" such as \"http\" followed by the \"type\" delimiter \"://\" followed by an address."
    }
    if {$ms != {}} {
      PopInfo "${ms}. Please try again"
    } else {
      set ::smart_dialogBut$w.text 2
    }
  }

  proc parseAndGetMatches {pattern ops} {
    variable pwAddress
    lassign {{} 0 0 0 0} pattern2 case  ! regexp
    set legal {pattern2 case ! regexp}

    if {[llength $ops] & 1} {
      return -code error "Argument list must have an even number of items"
    }
    foreach {op value} $ops {
      set thisOp [lsearch -inline $legal ${op}*]
      if {$thisOp == {}} {
	return -code error "Bad option found ($op). Must be one of '$legal'."
      }
      set $thisOp $value
    }
    if {![string is boolean $case]} {
      return -code error "Found '$case' for 'case option' must be boolean."
    }
    if {![string is boolean $regexp]} {
      return -code error "Found '$regexp' for 'regexp option' must be boolean."
    }
    if {${!} ni {0 1 2 3}} {
      return -code error "Found '${!}' for '!'. Must be '0, 1 ,2 or 3."
    }
    set case   [expr {!$case   ? "-nocase" : ""}]
    set regexp [expr {$regexp  ? "-regexp" : ""}]
    set not1   [expr {${!} & 1 ? "-not"    : ""}]
    set result {}
    set result [lsearch -all {*}$not1 {*}$regexp {*}$case -index 0\
		    [set $pwAddress] $pattern]
    if {$result == {} || $pattern2 == {}} {return $result}
    # We have a pattern2, run the result through that test

    set result2 {}
    foreach ent $result {
      if {[string match {*}$case {*}$regexp \
	       $pattern2 [lindex [set $pwAddress] $ent 2]] ^ (${!} & 2)} {
	lappend result2 $ent
      }
    }
    return $result2
  }

  proc patternGet {pattern args} {
    variable pwAddress
    variable decryptRoutine
    set indexs [parseAndGetMatches $pattern $args]
    set rtn {}
    foreach ent $indexs {
      lassign [lindex [set $pwAddress] $ent] id pw option
      frputs id pw option rtn
      set fpw [eval [list {*}$decryptRoutine $pw]]
      lappend rtn [list $id $fpw $option]
    }
    return $rtn
  }

  # The pattern delete. This might be coded more efficiently but we want simplicity
  # not speed. We reverse the list of indices's so the following indices's still work.
  
  proc delete {pattern args} {
    variable pwAddress
    variable saveFun
    set count 0
    foreach index [lreverse [parseAndGetMatches $pattern $args]] {
      set $pwAddress [lreplace [set $pwAddress] $index $index]
      incr count
    }
    if {$saveFun != {}} {
      eval [list {*}$saveFun]
    }
    
    return $count
  }
  # These routines service the dialog box
  proc PwShow {} {
    variable {}
    variable state
    set add $(-passWordAdd-)
    frputs add
    set showChar [expr {$(-showpw-) ? {} : {*}}]
    .password_entry_dialog$(-uni-).$add config -show $showChar
    if {$state != "ssl"} {
      set showChar {}
    }
    incr add
    .password_entry_dialog$(-uni-).[incr add] config -show $showChar
    .password_entry_dialog$(-uni-).[incr add] config -show $showChar
  }



  variable triPw "For ssh (and friends) the full password has three parts:\
                \n\"password\", \"private key file name\" and \"pass phrase\".\
                \nAny or all of these may be nil (\"\")."
  
  proc add2L {newState doIt {subin {}}} {
    variable state 
    variable {}
    variable triPw
    variable firstEnt
    frputs state newState doIt
    if {!$doIt && $state != $newState ||\
	    $doIt && $state == $newState} {return $doIt}
    wm withdraw .password_entry_dialog$(-uni-)
    set r {}
    if {$doIt} {
      set state $newState
      lassign $subin (-subins) l1 l2
      .password_entry_dialog$(-uni-).label4 config -text $l1
      .password_entry_dialog$(-uni-).label5 config -text $l2
    } else {
      # if {$state == "cifs"} {
      #   set (comment) [list {*}$(disk) {*}$(passphrase) {*}$(comment)]
      # } 
      set r "remove"
      set state "nil"
    }
    PwShow
    set nLess1 $(-passWordAdd-)
    while {[incr co] < 4} {
      catch {grid {*}$r .password_entry_dialog$(-uni-).[incr nLess1]
	grid {*}$r .password_entry_dialog$(-uni-).label$nLess1} er
      # if {$state == "cifs" && !$::MSW} {
      #   incr nLess1
      #   incr co
      # }
      frputs er
    }
    if {$firstEnt} {
      set firstEnt 0
    } else {

      realWaitForIdle
    }
    wm deiconify .password_entry_dialog$(-uni-)
    return $doIt
  }

  # Populate the text area
  proc textFun {messChoose prompt w} {
    variable {}
    variable triPw
    variable firstEnt 1
    variable state "ssl"
    variable noPw
    if {$noPw || $(user) == {}} {
      append x "Enter new password."
    } else {
       if {$(url) == {}} {
        set dId $(user)
      }
      append x "Edit password for \"[expr {$(url) != {} ? $(url) : $(user)}]\""
    }
    $w insert insert [append x "\nOK activates, cancel or window-delete cancels.\n"]
    frputs prompt
    if {$prompt != {} && [llength $prompt] > 0} {
      $w insert insert {*}$prompt sel
    }
    wrId
  }

   proc wrId {args} {
    variable {}
    variable triPw
 #
 
    add2L ssl [sshNfriends]\
        [list $triPw "Private key file name:" "Pass phrase:"]
   }
  
  proc putPw {newId newPw args} {
    variable pwAddress
    variable encryptRoutine
    variable saveFun
    set newId [regsub -all {\*} $newId {}]
    # Drop any trailing stuff (this also passes single user name Ids)
    set newId [regsub {([^:]:+//[^/]+)(.*)} $newId {\1}]
    set extra {}
    if {[llength $args] != 0 && [lindex $args 0] != {}} {
      set extra $args
    }
    frputs  #2 #3 args [llength $args]
    while {[set la [lsearch -regexp -index 0 -nocase \
                        [set $pwAddress] $newId\($|/.*\) ]] != -1} {
      if {[llength $args] == 0} {
	set extra [lindex [set $pwAddress] $la 2]
      }
      set $pwAddress [lreplace [set $pwAddress] $la $la]
    }
    set pw [eval [list {*}$encryptRoutine $newPw]]
    # we want the actual value, not the list protected value
    # set extra [list [lindex $extra 0] [lindex $extra 1]]
    
    frputs extra args ">[string trim $extra]< " pw
    set $pwAddress [linsert [set $pwAddress] 0 [list $newId $pw $extra]]
    if {$saveFun != {}} {
      eval [list {*}$saveFun]
    }
  }
}
