#!/bin/sh
# This is TkPasMan version 2.2a.
# Where do you wish to go today?\
test -z "$DISPLAY" &&\
	exec '/usr/pkg/bin/tclsh' "$0" "$@";\
	exec '/usr/pkg/bin/wish'  "$0" "$@"

package require Tcl 8.3

set state(X) [info exists tk_version]
if {$state(X)} {

  package require Tk 8.3

  # Disable remote control via X
  rename send {}
}

set Version {2.2a}
set ConfigFile {~/.tkpasmanrc}

# Default user config. This array is saved.
array set conf {
  file			{~/.tkpasman}
  readonly		0
  confirm-save-on-quit	1
  confirm-remove-site	1
  enable-dump-to-stdout	0
  dump-formatstring	{%s	%s	%s}
  show-passwd		0
  show-menu		1
  show-status		1
  save-windowsize	0
  geometry		{}
  skin			{}
  selection-delay	800
  onquit-save-options	0
}

# Command line state init. 
# This array is also used for other purposes. This array is not saved.
array set state {
  enable-dump		0
  enable-selection	1
  use-encryption	0
  readonly		0
  do-dump		0
  old-config		0
}
set Help {
TkPasMan --

A simple but (at least I think...) useful personal password manager.

You can store usernames and passwords with understandable descriptions,
and put them in the X selection in many ways, so you can easily paste
what you need in your applications.


                      -----%---%--%-%-%--%---%-----


How To Use TkPasMan:

A. Entering a new site.

  1. Choose `Add site' from the Edit menu to add a new site you want to
     store your password for.

  2. Type a clear description, and press <Enter>.

  3. Now you can type your username and/or password in the fields on the
     right.

  4. Use the checkbuttons to adjust the way username and/or password will
     be copied into the primary X selection when you select a
     description.  Most times, you will want to select the first two
     options, i.e. `Username' and `Password'.



B. Selecting username and password and pasting them elsewhere.

  1. Point your mouse to one of the descriptions in the list on the left.
  
  2. Just press your left mouse button, and, depending on your
     configuration of the checkbuttons, TkPasMan will select a username
     or password for you.

  3. Now, point your mouse to the application you want to paste your
     username in.

  4. Just press the middle mouse, and voil, the item will be pasted!
     TkPasMan will automagically put the next item (most times a password)
     in the X selection, so, after you pasted a username somewhere, just
     go to the place you want to paste the password, and again
     middle-click to put the password on its place.



C. Special possibilities.

  1. You can tell TkPasMan to paste the usernames or passwords for a site
     with newlines appended (using the `Append Newlines' checkbox).  This
     is useful for terminal sessions, like telnet.

  2. You can tell TkPasMan to paste the password twice.  This comes in
     handy when you for example have to confirm a password.



D. Encryption.

  TkPasMan can use OpenSSL (if installed) to encrypt its password file.
  You will then have to enter a master password every time you run
  TkPasMan.  The file on your hard drive will then be very difficult to
  read for other people.
  
  Note, however, that when you aren't being careful with your login,
  other people still might be able to delete your file!  Whether or not
  you are using encryption, the password file is only readable by you.

  1. To use encryption, check `Options->Encryption->Use Encryption'.  Now
     you will be prompted to enter a password.  You have to enter it twice,
     to prevent typing mistakes.
  
  2. After entering the password twice (and don't forget it!!) you will be
     prompted to save your file.  If you don't, the encryption will be
     cancelled.

  3. When encryption has been enabled, you can just continue to use
     TkPasMan as before.  But when you want to switch off encryption, or
     change the master password, you will have to enter the master
     password again.

  Normally, the site descriptions and associated usernames and passwords
  are saved in a file .tkpasman in your home directory.  When you use
  encryption, the encryption algorithm name (by default blowfish (`bf'))
  is appended to the filename, like this: .tkpasman.bf



E. The Options Menu.

  The Options Menu has lots of nice config options:
  
  Read only:  When checked, changing the contents of the password file is
     no longer allowed.  This is mainly to prevent accidental changes.

  Confirm Save on Quit:  When checked, TkPasMan will ask you, when you
     quit, is you want to save your password file.  When unchecked,
     TkPasMan will save your data without asking.

  Confirm Remove site:  When checked, TkPasMan will ask you a
     confirmation when you delete a site from the list.

  Encryption:  Use this submenu to enable or disable encryption, or to
     change the master password used to encrypt your file with.

  Show Passwords:  When checked, passwords are readable in the entries on
     the right.  This is only useful if you must paste a password that's
     normally not pasted, but don't want to change your file.  When the
     passwords are readable, you can select the text in the entry with
     your mouse and the paste it, bypassing TkPasMan's own selection
     system.

  Show Menubar:  When checked, a menubar is visible on top of the
     TkPasMan window. Unless you are longing for the good old
     TkPasMan-1.0 days, I won't recommend unchecking it.

  Show Statusbar:  When checked, a status bar is visible on the bottom of
     the main TkPasMan window.  This statusbar provides very precise
     status feedback, about what exactly is currently in the X selection,
     so I won't recommend unchecking it.

  Remember Window size:  When checked, TkPasMan will remember it's main
     window size when you save your config options.  (Not it's absolute
     location, however.)

  Skin:  A very important option.  Actually quite a bit, so you can make
     your TkPasMan window, lurking somewhere around your desktop very,
     very recoqnizable.  The Pale-pink skin is particularly recommended
     ;-) Never leave TkPasMan running at your desk when you leave!

  Save Options on Quit:  Subject says all.
  
  Save Options Now:  When you want the current settings to be default,
     first uncheck the previous entry, then choose this entry.



F. Miscellaneous Notes.

  *  Any adjustments you make in the fields on the right, are immediately
     stored! There is no `undo' option.  So be careful in typing
     passwords.

  *  All changes will be saved when you quit the program, using a backup
     file.  When you do not want to store your changes, please make sure
     you highlight the `Confirm Save on Quit' from the Options menu, exit
     the program and choose not to save.

  *  When you do not regularly add sites, you can lock the file using the
     `Read only' option in the Options menu.  That prevents you from
     accidentally changing your file.  Also you can use chmod to write
     protect the file really (chmod 0400 ~/.tkpasman).

  *  During execution of the program, a lockfile is present to prevent
     several instances of TkPasMan from changing the password file. When
     the tkpasman executable accidentally gets killed, you might need to
     remove the lockfile (by default ~/.tkpasman.lock) manually.



G. Commandline Options.

  --help:  Displays this help screen, then exits.  See the README file,
     the built-in help or use the --fullhelp option for more information.

  --fullhelp:  Dumps the full built-in help to the console and exits.

  --version:  Displays version number, then exits.

  --readonly:  Opens the password file readonly, so you can't make any
     changes.

  --dump:  Directly dumps the content of the password file to the console
     and exits.

  --disable-selection:  Disables the selection mechanism.  Useful when
     you only want to maintain a password file and not accidentally use
     it.



H. Some Quirks.

  *  The dynamic selection mechanism does not work well when other
     applications (like KDE's klipper or Downloader for X) periodically
     scan the selection.  So then you should paste things by selecting
     them from the `Username' or `Password' entry, or temporary disable
     the selection scanning in the other applications.  From version 2.1
     on, TkPasMan can warn you if it thinks an application is requesting
     the selection (by determining how fast the request arrives).

  *  A totally superfluous skin-change function is present in the Options
     menu, to make TkPasMan suit your desperate desktop theming needs.  In
     the future  the simple self-contained cooltk library might grow out
     to a cool tcl/tk application framework.


                      -----%---%--%-%-%--%---%-----


When you have any feature suggestions or comments, feel free to mail me at
wbsoft@xs4all.nl.

                       Enjoy!
                       Wilbert Berendsen, April 4, 2001



This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place, Suite 330, Boston, MA  02111-1307  USA .
}
namespace eval cooltk {
namespace export {[a-z]*}
variable skinResetCommand {
option clear
option add *Label.anchor w
option add *Radiobutton.anchor w
option add *Checkbutton.anchor w
}
variable widgetAttributes
array set widgetAttributes {
-activebackground All
-activeborderwidth All
-activeforeground All
-activerelief All
-anchor All
-background All
-borderwidth All
-cursor All
-disabledforeground All
-elementborderwidth All
-font All
-foreground All
-highlightbackground All
-highlightcolor All
-highlightthickness All
-insertbackground All
-insertborderwidth All
-insertofftime All
-insertontime All
-insertwidth All
-justify All
-padx All
-pady All
-relief All
-selectbackground All
-selectborderwidth All
-selectcolor All
-selectforeground All
-troughcolor All
-width Scrollbar
}
variable textTags
array set textTags {
title All
url All
p All
}
variable textAttributes
array set textAttributes {
-background All
-font All
-foreground All
-justify All
-relief All
-underline All
}
variable menuModifiers {
ctrl Control
ctl Control
^ Control
alt Alt
m Meta
meta Meta
shft Shift
shift Shift
~ Shift
}
variable menuKeys {
esc Escape
enter Return
tab Tab
bs BackSpace
del Delete
\\ backslash
/ slash
, comma
. period
}
}
proc cooltk::skinSetResetCommand {{resetCommand none}} {
variable skinResetCommand
switch -- $resetCommand {
none { return $skinResetCommand }
default { set skinResetCommand $resetCommand }
}
}
proc cooltk::skinList {} {
return [lsort -dict [namespace eval skin {info procs}]]
}
proc cooltk::skinSet skin {
variable skinResetCommand
eval $skinResetCommand
switch -- $skin {
none {}
default {catch cooltk::skin::$skin}
}
skinReconfigure .
}
proc cooltk::skinReconfigure w {
variable widgetAttributes
foreach widget [winfo children $w] {
skinReconfigure $widget
}
foreach confList [$w configure] {
upvar 0 widgetAttributes([lindex $confList 0]) attr
if {[info exists attr] && ( [string equal $attr All] || [lsearch -exact $attr [winfo class $w]] != -1 )} {
foreach {item dbase class default cur} $confList break
set value [option get $w $dbase $class]
if {[string equal $value {}]} {
set value $default
}
$w configure $item $value
}
}
switch -- [winfo class $w] {
Text {
eval {skinConfigureDefaultTextTags $w} [$w tag names]
}
}
}
proc cooltk::skinConfigureDefaultTextTags {w args} {
variable textTags
variable textAttributes
foreach tag $args {
if {[info exists textTags($tag)]} {
foreach attr [$w tag configure $tag] {
upvar 0 textAttributes([lindex $attr 0]) a
if {[info exists a] && ( [string equal $a All] || [lsearch -exact $a $tag] != -1 )} {
set Attr [string totitle [string range [lindex $attr 0] 1 end]]
set value [option get $w $tag$Attr $textTags($tag)$Attr]
if {[string equal $value {}]} {
set value [lindex $attr 3]
}
$w tag configure $tag [lindex $attr 0] $value
}
}
}
}
}
namespace eval cooltk::skin {
proc Default {} {
set p userDefault
option add *foreground black $p
option add *background rgb:c/c/c $p
option add *highlightBackground rgb:c/c/c $p
option add *highlightColor black $p
option add *activeBackground rgb:d/d/d $p
option add *activeForeground black $p
option add *selectForeground black $p
option add *selectBackground rgb:b/b/b $p
option add *disabledForeground rgb:9/9/9 $p
option add *troughColor rgb:b/b/b $p
option add *insertBackground black $p
option add *selectColor rgb:d/3/6 $p
option add *insertWidth 2 $p
option add *insertBorderWidth 0 $p
option add *Listbox.font {helvetica 12} $p
option add *Entry.background rgb:e/e/e $p
option add *Listbox.background rgb:e/e/e $p
option add *Text.background rgb:e/e/e $p
option add *StatusBar.Entry.background rgb:c/c/c $p
option add *StatusBar.Entry.foreground blue $p
option add *StatusBar.Button.padY 0 $p
option add *urlForeground blue $p
}
proc Dark {} {
set p userDefault
option add *foreground white $p
option add *background rgb:3/3/3 $p
option add *highlightBackground rgb:3/3/3 $p
option add *highlightColor rgb:9/9/9 $p
option add *activeBackground rgb:4/4/4 $p
option add *activeForeground white $p
option add *selectForeground white $p
option add *selectBackground rgb:5/9/f $p
option add *disabledForeground rgb:a/a/a $p
option add *troughColor rgb:2/2/2 $p
option add *insertBackground white $p
option add *selectColor red $p
option add *insertWidth 2 $p
option add *insertBorderWidth 0 $p
option add *Listbox.font {helvetica 12} $p
option add *Entry.background rgb:4/4/4 $p
option add *Listbox.background rgb:4/4/4 $p
option add *Text.background rgb:4/4/4 $p
option add *StatusBar.Entry.background rgb:3/3/3 $p
option add *StatusBar.Entry.foreground rgb:5/9/f $p
option add *StatusBar.Button.padY 0 $p
option add *urlForeground rgb:5/9/f $p
}
proc Pale-pink {} {
set p userDefault
option add *foreground white $p
option add *background rgb:d0/70/f0 $p
option add *highlightBackground rgb:d0/70/f0 $p
option add *highlightColor white $p
option add *activeBackground rgb:d/7/f $p
option add *activeForeground white $p
option add *selectForeground white $p
option add *selectBackground rgb:d/7/f $p
option add *disabledForeground rgb:7/4/8 $p
option add *troughColor rgb:b/6/d $p
option add *insertBackground white $p
option add *selectColor yellow $p
option add *insertWidth 2 $p
option add *insertBorderWidth 0 $p
option add *selectBorderWidth 1 $p
option add *elementBorderWidth 1 $p
option add *Scrollbar.borderWidth 1 $p
option add *Menu.borderWidth 1 $p
option add *Menu.activeBorderWidth 1 $p
option add *Entry.borderWidth 1 $p
option add *Listbox.borderWidth 1 $p
option add *Text.borderWidth 1 $p
option add *Button.borderWidth 1 $p
option add *Radiobutton.borderWidth 1 $p
option add *Checkbutton.borderWidth 1 $p
option add *Scrollbar.width 10 $p
option add *font {lucida 12} widgetDefault
option add *Text.font {lucidatypewriter 12} $p
option add *AllFont {lucida 12} $p
option add *titleFont {lucida 18} $p
option add *Entry.background rgb:9/5/b $p
option add *Listbox.background rgb:9/5/b $p
option add *Text.background rgb:9/5/b $p
option add *StatusBar.Entry.background rgb:d/7/f $p
option add *StatusBar.Entry.foreground white $p
option add *StatusBar.Entry.font {lucida 12 italic} $p
option add *StatusBar.Button.padY 0 $p
option add *urlForeground lightskyblue $p
option add [winfo class .].Label.anchor center 
option add [winfo class .].Label.padY 4 
option add [winfo class .].Radiobutton.padY 4 
option add [winfo class .].Checkbutton.padY 4 
option add *Button.background rgb:c/c/c $p
option add *Button.activeBackground rgb:d/d/d $p
option add *Button.foreground black $p
option add *Button.activeForeground black $p
option add *Button.font {lucida 12 bold} $p
}
proc Goldenrod {} {
set p userDefault
set c rgb:e8/b0/25
option add *foreground white $p
option add *background goldenrod $p
option add *highlightBackground goldenrod $p
option add *highlightColor white $p
option add *activeBackground rgb:9/9/9 $p
option add *activeForeground white $p
option add *selectBackground rgb:9/9/9 $p
option add *selectForeground white $p
option add *disabledForeground darkgoldenrod $p
option add *troughColor rgb:8/8/8 $p
option add *insertBackground white $p
option add *selectColor red $p
option add *Scrollbar.background rgb:9/9/9 $p
option add *Scrollbar.activeBackground rgb:a/a/a $p
option add *Button.background rgb:9/9/9 $p
option add *Button.activeBackground rgb:a/a/a $p
option add *Button.disabledForeground rgb:7/7/7 $p
option add *insertWidth 2 $p
option add *insertBorderWidth 0 $p
option add *selectBorderWidth 1 $p
option add *elementBorderWidth 1 $p
option add *Menu.borderWidth 1 $p
option add *Menu.activeBorderWidth 1 $p
option add *Entry.borderWidth 1 $p
option add *Listbox.borderWidth 1 $p
option add *Text.borderWidth 1 $p
option add *Button.borderWidth 1 $p
option add *Radiobutton.borderWidth 1 $p
option add *Checkbutton.borderWidth 1 $p
option add *Scrollbar.borderWidth 1 $p
option add *Scrollbar.width 10 $p
option add *font {helvetica 12} widgetDefault
option add *Text.font {-adobe-courier-medium-r-normal-*-*-120-*} $p
option add *urlForeground blue $p
option add [winfo class .].Label.font {helvetica 12 {bold italic}}
option add [winfo class .].Label.anchor center
option add [winfo class .].Label.padY 4
option add *Listbox.background $c $p
option add *Entry.background $c $p
option add *Text.background $c $p
option add *StatusBar.borderWidth 2 $p
option add *StatusBar.relief ridge $p
option add *StatusBar.Entry.borderWidth 0 $p
option add *StatusBar.Entry.background goldenrod $p
option add *StatusBar.Button.padY 0 $p
}
}
proc cooltk::menuSetLabelAccel {m bindTo} {
for {set i 0} {$i <= [$m index end]} {incr i} {
switch [$m type $i] {
cascade {
eval $m entryconfig $i [menuLabelUnderline [$m entrycget $i -label]]
menuSetLabelAccel [$m entrycget $i -menu] $bindTo
}
separator -
tearoff {}
default {
eval $m entryconfig $i [menuLabelUnderline [$m entrycget $i -label]]
set ac [$m entrycget $i -accel]
if {[string compare $ac {}]} {
bind $bindTo [menuParseAccel $ac] [list $m invoke $i]
}
}
}
}
}
proc cooltk::menuLabelUnderline label {
if {[regsub & $label {} l]} {
return [list -label $l -underline [string first & $label]]
} else {
return [list -label $label]
}
}
proc cooltk::menuParseAccel ac {
variable menuModifiers
variable menuKeys
set binding {}
foreach event [split $ac] {
set eventFields [split $event +-]
set key [string map -nocase $menuKeys [lindex $eventFields end]]
append binding "<"
foreach mod [lreplace $eventFields end end] {
append binding [string map $menuModifiers [string tolower $mod]]-
}
if {[string length $key] == 1 && ![regexp Shift $binding]} {
set key [string tolower $key]
}
append binding "Key-$key>"
}
return $binding
}
proc cooltk::ScrollbarSet {row col stick scrollBar offset size} {
if {$offset != 0 || $size != 1} {
grid $scrollBar -row $row -column $col -sticky $stick
}
$scrollBar set $offset $size
}
proc cooltk::scrollListbox {w args} {
frame $w -class ScrollListbox
eval {listbox $w.l} $args
scrollbar $w.y -orient vert -command [list $w.l yview]
scrollbar $w.x -orient hori -command [list $w.l xview]
$w.l config -yscrollcommand [list cooltk::ScrollbarSet 0 1 ns $w.y]
$w.l config -xscrollcommand [list cooltk::ScrollbarSet 1 0 we $w.x]
grid $w.l -sticky news
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
return $w
}
proc cooltk::scrollText {w args} {
frame $w -class ScrollText
eval {text $w.t} $args
scrollbar $w.y -orient vert -command [list $w.t yview]
scrollbar $w.x -orient hori -command [list $w.t xview]
$w.t config -yscrollcommand [list cooltk::ScrollbarSet 0 1 ns $w.y]
$w.t config -xscrollcommand [list cooltk::ScrollbarSet 1 0 we $w.x]
grid $w.t -sticky news
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
return $w
}
proc cooltk::statusBar {w args} {
variable statusBar$w
upvar 0 statusBar$w statusBar
set statusBar(persistentMessage) {}
set statusBar(delay) 5000
set statusBar(display) {}
frame $w -class StatusBar
foreach {option value} $args {
switch -- $option {
-button {
foreach {name text command} $value break
pack [button $w.$name -text $text -command $command] -side right
}
-delay {
set statusBar(delay) $value
}
}
}
pack [entry $w._cooltk_stBar -textvar [namespace current]::statusBar${w}(display) -state disabled] \
-side left -fill x -expand 1
bind $w._cooltk_stBar <Destroy> [namespace code "
variable statusBar$w
if {\[info exists statusBar${w}(afterId)\]} {
after cancel \${statusBar${w}(afterId)}
}
unset statusBar$w
"]
return $w
}
proc cooltk::statusMessage {w args} {
variable statusBar$w
upvar 0 statusBar$w statusBar
set opt -temp
if {[llength $args] > 1} {
set opt [lindex $args 0]
}
set string [lindex $args end]
if {[info exists statusBar(afterId)]} {
after cancel $statusBar(afterId)
unset statusBar(afterId)
}
switch -glob -- $opt {
-temp* {
set statusBar(afterId) [after $statusBar(delay) [namespace code "
variable statusBar$w
set statusBar${w}(display) \${statusBar${w}(persistentMessage)}
unset statusBar${w}(afterId)
"]]
}
-pers* {
set statusBar(persistentMessage) $string
}
}
set statusBar(display) $string
}
proc cooltk::center {w {place ""} {anchor ""}} {
wm withdraw $w
update idletasks
set checkBounds 1
if {[string equal -len [string length $place] $place "pointer"]} {
if {[string equal -len [string length $anchor] $anchor "center"]} {
set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
} else {
set x [winfo pointerx $w]
set y [winfo pointery $w]
}
} elseif {[string equal -len [string length $place] $place "widget"] && \
[winfo exists $anchor] && [winfo ismapped $anchor]} {
set x [expr {[winfo rootx $anchor] + \
([winfo width $anchor]-[winfo reqwidth $w])/2}]
set y [expr {[winfo rooty $anchor] + \
([winfo height $anchor]-[winfo reqheight $w])/2}]
} else {
set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
set checkBounds 0
}
if {$checkBounds} {
if {$x < 0} {
set x 0
} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
}
if {$y < 0} {
set y 0
} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
}
}
wm geometry $w +$x+$y
wm deiconify $w
}
proc cooltk::seeToplevel w {
if {[winfo exists $w]} {
if {[regexp iconic|withdrawn [wm state $w]]} {
wm deiconify $w
} else {
raise $w
}
return 1
}
return 0
}
proc cooltk::homify file {
if {[string equal [file pathtype $file] absolute] &&
[string match ~* [file rootname $file]]} {
set f [file split $file]
return [eval file join [lreplace $f 0 0 [glob [lindex $f 0]]]]
} else {
return $file
}
}
proc cooltk::wilbertsBirthDay {} {
foreach {day year} [clock format [clock seconds] -format "%d%m %Y"] break
return [expr {[string equal "0703" $day] ? $year - 1971 : 0}]
}
proc Dump {} {
global conf PW
foreach name [lsort [array names PW]] {
puts stdout [format $conf(dump-formatstring) \
$name [lindex $PW($name) 0] [lindex $PW($name) 1]]
}
}
proc PWChanged {yn args} {
global PW state
set state(changed) $yn
trace [string map {
0 variable
1 vdelete
} $yn] PW wu {PWChanged 1}
}
proc Save {} {
global ssl conf state PW
if {$state(use-encryption)} {
set outf $conf(file).$ssl(enc)
} else {
set outf $conf(file)
}
while 1 {
set backupf "${outf}-tmp[expr {int (rand() * 4194304)}]"
if {! [file exists $backupf]} break
}
if {[file readable $outf]} {
if {[catch {file copy $outf $backupf}]} {
SaveErrorMsg "Creating backup failed.\
Perhaps your filesystem is full, or [file dirname $outf]/\
is not writable."
return 1
}
}
set f [open $outf w 0600]
if {$state(use-encryption)} {
close $f
set cmd [list |$ssl(cmd) $ssl(enc)]
eval lappend cmd $ssl(salt)
lappend cmd -e -pass stdin > $outf
set f [open $cmd w]
puts $f $ssl(passwd)
}
foreach el [array names PW] {
if {[catch {puts $f [array get PW $el]}]} {
catch {close $f}
if {[file exists $backupf] && [catch {file copy $backupf $outf}]} {
SaveErrorMsg "Writing to the password file failed.\
Restoring the backup failed as well! This should not happen.\
I have left the backup in '$backupf'"
return 1
} else {
file delete -force $backupf
SaveErrorMsg "Writing to the password file failed.\
Perhaps your filesystem is full.\
I have restored the old file."
return 1
}
}
}
if {[catch {close $f}]} {
if {[catch {file copy $backupf $outf}]} {
SaveErrorMsg "Closing the password file failed.\
Restoring the backup failed as well! This should not happen.\
I have left the backup in '$backupf'"
return 1
} else {
file delete -force $backupf
SaveErrorMsg "Closing the password file failed.\
Perhaps your filesystem is full.\
I have restored the old file."
return 1
}
}
PWChanged 0
file delete -force $backupf
return 0
}
proc SaveErrorMsg msg {
tk_messageBox -type ok -icon error -title "TkPasMan: Save Error" -parent . \
-message "Could not save password file:\n\n$msg.\n\nPlease retry."
}
proc Open {} {
global ssl conf state PW
set state(use-encryption) 0
set file $conf(file)
if {[array exists ssl] && [file readable $file.$ssl(enc)]} {
set state(use-encryption) 1
set file $file.$ssl(enc)
} elseif {! [file readable $file]} {
array set PW {}
set f [open $file w 0600]
close $f
}
if {! $state(readonly) && [file writable $file] && ! [Locked $file] } {
if {[Lock $file]} {
set state(readonly) 1
tk_messageBox -type ok -icon warning -parent . -title "TkPasMan: Warning" \
-message "Locking the password file failed. Session made read-only."
} else {
set state(readonly) 0
}
} else {
set state(readonly) 1
}
if {$state(use-encryption)} {
set cmd [list |$ssl(cmd) $ssl(enc) -d -in [homify $file] -pass stdin]
eval lappend cmd $ssl(salt)
if {$state(X)} {
set passwd [InputPassword "TkPasMan: Enter Password" \
"Please enter the master password for ${file}:" {}]
} else {
puts -nonewline stderr "Please enter the master password for ${file}: "
flush stderr
set passwd [exec sh -c {read -s line ; echo $line}]
puts stderr ""
} 
if {[string equal $passwd {}]} {
Unlock $file
return 1
}
set f [open $cmd r+]
puts $f $passwd
flush $f
if {[catch {array set PW [read $f]}] + [catch {close $f}]} {
array unset PW *
Unlock $file
if {$state(X)} {
OpenErrorMsg "Error reading encrypted file! You probably supplied a\
wrong password."
} else {
puts stderr "tkpasman: error: Error reading encrypted file!\nYou\
probably supplied a wrong password."
}
return 1
}
set ssl(passwd) $passwd
} else {
set f [open $file r]
if {[catch {array set PW [read $f]}] + [catch {close $f}]} {
array unset PW *
Unlock $file
if {$state(X)} {
OpenErrorMsg "Error reading password file!"
} else {
puts stderr "tkpasman: error: Error reading password file!"
}
return 1
}
}
set old 0
foreach el [array names PW] {
if {[llength $PW($el)] == 3} {
set old 1
set PW($el) [eval lreplace {$PW($el)} end end [string map {
0 {0 0 0 0}
1 {1 0 0 0}
2 {0 1 0 0}
3 {1 1 0 0}
4 {1 1 0 1}
} [lindex $PW($el) end]]]
}
}
if {$old} {
if {$state(X)} {
tk_messageBox -type ok -icon warning -title "TkPasMan: Warning" -parent .\
-message "Warning: The file format of the password file has\
changed since TkPasMan 2.2. I have imported the file, but when\
you save the password file, old versions of TkPasMan might not\
read it correctly."
} else {
puts stderr "tkpasman: warning: password file in old format"
}
} 
PWChanged 0
return 0
}
proc OpenErrorMsg msg {
tk_messageBox -type ok -icon error -parent . -title "TkPasMan: Open Error" \
-message "Could not open password file:\n\n$msg\n\nPlease retry."
}
proc Lock file {
expr {[catch {set f [open $file.lock w 0600]}] +
[catch {puts $f [format %10d [pid]]}] +
[catch {close $f}]}
}
proc Unlock file {
global state
if {! $state(readonly)} {
return [catch {file delete $file.lock}]
} else {
return 0
}
}
proc Locked file {
file exists $file.lock
}
proc Close {} {
global state conf ssl
set retval 0
if {$state(changed)} {
if {! $conf(confirm-save-on-quit)} {
set retval [Save]
} else {
switch -- [tk_messageBox \
-parent . -icon question -title Save? \
-message {The file has changed. Do you want to save?} \
-type yesnocancel -default yes] {
yes {
set retval [Save]
}
no {}
cancel {
set retval 1
}
}
}
}
if {! $retval} {
if {! $state(readonly)} {
if {$state(use-encryption)} {
Unlock $conf(file).$ssl(enc)
set ssl(passwd) {}
} else {
Unlock $conf(file)
}
}
} else {
Hint "Password file NOT saved"
}
return $retval
}
proc Quit {} {
global conf
if {![Close]} {
if {$conf(onquit-save-options)} SaveConfig
exit
}
}
proc SetPassword {} {
global ssl state
if {! [array exists ssl]} return
set passwd [Input2Passwords "New Password" \
"Please enter new password:" {}]
if {[string equal $passwd {}]} {
tk_messageBox -type ok -icon warning -parent . -title Warning \
-message "Setting of password cancelled!"
return 1
}
switch [tk_messageBox -type okcancel -default ok -icon question \
-parent . -title "Caution!" -message \
"You MUST save your password file right now, in order\
to keep the new password persistent.\n\nChoose OK to save the file\
now.\n\nIf you choose Cancel, the new password will NOT be set."] {
ok {
set ssl(passwd) $passwd
set state(use-encryption) 1
PWChanged 1
return [Save]
}
default {
tk_messageBox -type ok -icon warning -parent . -title Warning \
-message "Setting of password cancelled!"
return 1
}
}
}
proc AskPassword message {
global ssl
if {! [array exists ssl]} {return 0}
if {[string compare $ssl(passwd) {}]} {
set passwd [InputPassword \
"TkPasMan: Enter Password" $message {}]
if {[string compare $passwd $ssl(passwd)]} {
if {[string compare $passwd {}]} {
tk_messageBox -type ok -icon error -parent . -title Error \
-message "Wrong password. Please retry."
}
return 1
}
}
return 0
}
proc ChangePassword {} {
global ssl state
if {! [array exists ssl] || ! $state(use-encryption)} {return 0}
if {[AskPassword \
"Before you are allowed to change the master\
password, you have to enter the old password:"]} {
return 1
}
return [SetPassword]
}
proc EnableEncryption {} {
global state ssl conf
if {$state(use-encryption)} {
switch [tk_messageBox -type okcancel -icon question -parent .\
-title "Enable Encryption" -message \
"To enable encryption, you will now be asked to enter a\
password.\n\nChoose OK to continue." -default ok] {
cancel {
set state(use-encryption) 0
Hint "Enabling Encryption cancelled"
}
ok {
if {[SetPassword]} {
set state(use-encryption) 0
file delete -force $conf(file).$ssl(enc)
tk_messageBox -type ok -icon warning -parent . -title Warning \
-message "Enabling Encryption failed! File is NOT encrypted."
} else {
Lock $conf(file).$ssl(enc)
Unlock $conf(file)
file delete $conf(file)
Hint "Encryption is now enabled"
}
}
}
} else {
switch [tk_messageBox -type okcancel -icon question -parent .\
-title "Disable Encryption" -message \
"To disable encryption, you must first enter the master\
password.\n\nChoose OK to continue." -default ok] {
cancel {
set state(use-encryption) 1
Hint "Disabling Encryption cancelled"
}
ok {
if {[AskPassword "Please enter the master password:"]} {
set state(use-encryption) 1
Hint "Disabling Encryption failed"
} else {
if {[Save]} {
set state(use-encryption) 1
file delete -force $conf(file)
tk_messageBox -type ok -icon error -parent . -title Error \
-message "Disabling Encryption failed! Encryption remains active."
} else {
Lock $conf(file)
Unlock $conf(file).$ssl(enc)
file delete $conf(file).$ssl(enc)
Hint "Encryption is now disabled"
}
}
}
}
}
}
proc SaveConfig {} {
global conf ConfigFile Version
set conf(geometry) "[winfo width .]x[winfo height .]"
set f [open $ConfigFile w 0600]
puts $f "# TkPasMan-$Version"
foreach el [lsort [array names conf]] {
puts $f [array get conf $el]
}
close $f
}
proc Hint args {
eval statusMessage .status $args
}
proc Input {title message value} {
toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
wm title $w $title
wm iconname $w "[wm title .]: $title"
wm transient $w .
wm protocol $w WM_DELETE_WINDOW "$w.can invoke"
pack [message $w.l -text $message]
pack [entry $w.e -textvar $w] -pady 8 -fill x -expand 1
pack [button $w.ok -text Ok -command "destroy $w" -default active] -side left
pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right
focus $w.e
bind $w.e <Return> "$w.ok invoke"
bind $w.e <Escape> "$w.can invoke"
set ::$w $value
center $w widget .
grab $w
tkwait window $w
set ::$w
}
proc InputPassword {title message value} {
toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
wm title $w $title
wm iconname $w "[wm title .]: $title"
wm transient $w .
wm protocol $w WM_DELETE_WINDOW "$w.can invoke"
pack [message $w.l -text $message]
pack [entry $w.e -textvar $w -show *] -pady 8 -fill x -expand 1
pack [button $w.ok -text Ok -command "destroy $w" -default active] -side left
pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right
focus $w.e
bind $w.e <Return> "$w.ok invoke"
bind $w.e <Escape> "$w.can invoke"
set ::$w $value
center $w widget .
grab $w
tkwait window $w
set ::$w
}
proc Input2Passwords {title message value} {
toplevel [set w .inputwindow] -class Input -bd 8 -relief flat
wm title $w $title
wm iconname $w "[wm title .]: $title"
wm transient $w .
wm protocol $w WM_DELETE_WINDOW "$w.can invoke"
pack [message $w.l1 -text $message]
pack [entry $w.e1 -textvar $w.1 -show *] -pady 8 -fill x -expand 1
pack [message $w.l2 -text "Re-enter password:"]
pack [entry $w.e2 -textvar $w.2 -show *] -pady 8 -fill x -expand 1
pack [button $w.ok -text Ok -default active] -side left
pack [button $w.can -text Cancel -command "set $w {}; destroy $w"] -side right
$w.ok configure -command \
"if {\[string equal \${$w.1} \${$w.2}\]} {
set {$w} \${$w.1}
destroy $w
} else {
set {$w.1} {}
set {$w.2} {}
tk_messageBox -type ok -parent {$w} -icon error -title Error \
-message {Ambiguous passwords! Please enter again.}
focus $w.e1
}"
focus $w.e1
bind $w.e1 <Return> "focus $w.e2"
bind $w.e2 <Return> "$w.ok invoke"
bind $w <Escape> "$w.can invoke"
set ::$w.1 $value
set ::$w.2 $value
center $w widget .
grab $w
tkwait window $w
set ::$w
}
proc Help {} {
global Help
set w .help
if {![seeToplevel $w]} {
toplevel $w -class Help
wm title $w "TkPasMan Help"
wm iconname $w "TkPasMan Help"
pack [button $w.b -text Close -command "wm withdraw $w" -default active] -side bottom
pack [scrollText $w.t -wrap none] -padx 4 -pady 4 -fill both -expand 1
set t $w.t.t
bind $w <Key-Escape> "wm withdraw $w"
bind $w <Key-Up> "$t yview scroll -1 units"
bind $w <Key-Down> "$t yview scroll 1 units"
bind $w <Key-Prior> "$t yview scroll -1 pages"
bind $w <Key-Next> "$t yview scroll 1 pages"
bind $w <Key-Home> "$t see 1.0"
bind $w <Key-End> "$t see end"
bind $w <Key-Return> "$t yview scroll 1 units"
$t insert end $Help
$t config -state disabled
$t see 1.0
}
}
proc About {} {
global Version
set w .about
if {![seeToplevel $w]} {
toplevel $w -class About
wm title $w "About TkPasMan"
wm iconname $w "About TkPasMan"
pack [button $w.b -text Close -command "wm withdraw $w" -default active] -side bottom
pack [text $w.t -width 50 -height 13 -wrap word] -fill both -expand 1 -padx 8 -pady 8
bind $w <Key-Escape> "wm withdraw $w"
$w.t tag configure title -spacing1 3m -spacing3 5m
$w.t tag configure p -spacing3 3m
$w.t tag configure url -spacing3 3m
skinConfigureDefaultTextTags $w.t title p url
$w.t insert end \
"TkPasMan version $Version\n" title \
"TkPasMan was written by Wilbert Berendsen <" p \
wbsoft@xs4all.nl url \
"> in Tcl/Tk. This program is Free Software,\
distributed under the GNU General Public\
License.\nA copy of the license is included\
in the distribution.\nHomepage of TkPasMan: see " p \
http://www.xs4all.nl/~wbsoft/linux url \
.\n p
$w.t configure -state disabled
center $w widget
}
}
proc SaveHint {} {
if {[Save]} {
Hint "Password file NOT saved"
} else {
Hint "Password file saved"
}
}
proc CreateMainGUI {} {
global state conf
wm protocol . WM_DELETE_WINDOW Quit
set m [menu .menu -tearoff no]
set s [menu $m.file]
$m add cascade -menu $s -label &File
$s add command -label &Save -command SaveHint -accel Ctrl+S
$s add command -label &Quit -command Quit -accel Ctrl+Q
set s [menu $m.edit]
$m add cascade -menu $s -label &Edit
$s add command -label {&Add site} -command Add -accel Ctrl+A
$s add command -label {&Edit description} -command Edit -accel Ctrl+E
$s add command -label {&Remove site} -command Remove -accel Ctrl+D
set s [menu $m.opts]
$m add cascade -menu $s -label &Options
$s add check -label {&Read only} -var conf(readonly) -command ShowLocked
$s add check -label {Confirm S&ave on Quit} -var conf(confirm-save-on-quit)
$s add check -label {&Confirm Remove site} -var conf(confirm-remove-site)
global ssl ; if {[array exists ssl]} {
set k [menu $s.ssl]
$s add cascade -label Encr&yption -menu $k
$k add check -label {Use Encr&yption (using openssl)} -var state(use-encryption) -command EnableEncryption
$k add command -label {Change &Master Password} -command ChangePassword
}
$s add sep
$s add check -label {Show &Passwords} -var conf(show-passwd) -command ShowPassWords
$s add check -label {Show &Menubar} -var conf(show-menu) -command ShowMenuBar -accel Ctrl+M
$s add check -label {Show &Statusbar} -var conf(show-status) -command ShowStatusBar
$s add check -label {Remember &Window size} -var conf(save-windowsize)
if {[llength [skinList]]} {
set k [menu $s.skin]
$s add cascade -label S&kin -menu $k
$k add radio -label None -var conf(skin) -value none -command {skinSet none}
$k add sep
foreach skin [skinList] {
$k add radio -label $skin -var conf(skin) -value $skin -command [list skinSet $skin]
}
}
$s add sep
$s add check -label {Save &Options on Quit} -var conf(onquit-save-options)
$s add command -label {Save Options &Now} -command SaveConfig
set s [menu $m.help]
$m add cascade -menu $s -label &Help
$s add command -label &Help -command Help -accel F1
$s add command -label &About... -command About
menuSetLabelAccel $m .
pack [scrollListbox .l -listvar state(listVar) -exportsel 0 -selectm browse] \
-side left -fill both -expand 1
pack [label .lu -text Username:] [entry .u -textvar Entry(username)] \
[label .lp -text Password:] [entry .p -textvar Entry(password)] \
[label .ls -text Selection:] \
[checkbutton .1 -var Entry(sel-user) -text {Username}] \
[checkbutton .2 -var Entry(sel-pass) -text {Password}] \
[checkbutton .3 -var Entry(sel-pas2) -text {Repeat Password}] \
[checkbutton .4 -var Entry(sel-newl) -text {Append Newlines}] \
-fill x
statusBar .status -button {quit Quit Quit}
bind . <3> {tk_popup .menu %X %Y}
bind .l.l <3> {ListboxSelect [%W index @%x,%y]}
bind .l.l <<ListboxSelect>> {ListboxSelectCallback}
Hint -persistent "Press F1 for Help"
if {[set age [wilbertsBirthDay]]} { 
Hint [format "Today it's Wilbert's birthday! (He's now %d)" $age]
}
trace variable state(changed) w UpdateWindowTitle
ShowMenuBar 0
ShowStatusBar
ShowPassWords
UpdateGlobalState
UpdateWindowTitle
UpdateListbox
UpdateSelection
selection handle -type UTF8_STRING . SelectionHandler
selection handle -type STRING . SelectionHandler
}
proc UpdateListbox {} {
global PW state
set state(listVar) [lsort -dict [array names PW]]
}
proc ListboxSelect index {
.l.l selection clear 0 end
.l.l selection set $index
.l.l see $index
.l.l activate $index
UpdateSelection
}
proc ListboxSelectCallback {} {
global conf state Entry
UpdateSelection
if {[string compare $state(selected) {}] && $state(enable-selection)} {
if {$Entry(sel-newl)} {
set newline \n
set p { (with newline)}
} else {
set newline {}
set p {}
}
set state(currentSelection) {}
foreach {selvar var selmsg pastemsg} {
sel-user username
"Username selected"
"Username pasted"
sel-pass password
"Password selected"
"Password pasted"
sel-pas2 password
"Password still selected"
"Password pasted"
} {
if {$Entry($selvar)} {
lappend state(currentSelection) \
[list $Entry($var)$newline $selmsg $pastemsg$p]
}
}
if {[llength $state(currentSelection)]} {
set state(selectionTimer)\
[after $conf(selection-delay) {catch {unset state(selectionTimer)}}]
set ind [lindex $state(currentSelection) 0]
Hint -persistent "[lindex $ind 1]"
selection own -command SelectionLose .
}
}
}
proc SelectionLose {} {
Hint -persistent ""
Hint "Selection lost"
}
proc SelectionHandler {from count} {
global conf state
if {[info exists state(inWarning)]} {return {}}
if {$from == 0} {
if {[info exists state(selectionTimer)]} {
set state(inWarning) 1
catch { after cancel $state(selectionTimer)
unset state(selectionTimer) }
switch [tk_messageBox -icon warning -title Warning\
-type yesno -default no -parent .\
-message "Warning! An application has requested the selection\
too fast, within $conf(selection-delay) ms. Is pasting allowed?"] {
no {
unset state(inWarning)
selection clear
return {}
}
yes {
unset state(inWarning)
if {[string compare . [selection own]]} {
Hint "Selection lost anyway"
return {}
}
}
}
}
if {[llength $state(currentSelection)]} {
set ind [lindex $state(currentSelection) 0]
set state(currentSelection) [lrange $state(currentSelection) 1 end]
if {[llength $state(currentSelection)]} {
Hint -persistent [lindex [lindex $state(currentSelection) 0] 1]
} else {
Hint -persistent ""
selection clear
}
set state(selectionString) [lindex $ind 0]
Hint [lindex $ind 2]
}
}
return [string range $state(selectionString) $from [expr {$from + $count - 1}]]
}
proc UpdateSelection {} {
global PW state conf Entry
set s [.l.l curselection]
if {[llength $s]} {
trace vdelete Entry w TraceEntry
set state(selected) [lindex $state(listVar) $s]
foreach {
Entry(username)
Entry(password)
Entry(sel-user)
Entry(sel-pass)
Entry(sel-pas2)
Entry(sel-newl)
} $PW($state(selected)) break
trace variable Entry w TraceEntry
set State normal
} else {
trace vdelete Entry w TraceEntry
set state(selected) {}
foreach {
Entry(username)
Entry(password)
Entry(sel-user)
Entry(sel-pass)
Entry(sel-pas2)
Entry(sel-newl)
} [list {} {} 0 0 0 0] break
set State disabled
}
if {$conf(readonly) || $state(readonly)} {
set State disabled
set AddState disabled
} else {
set AddState normal
}
foreach w {.u .p .1 .2 .3 .4} {
$w config -state $State
}
set e .menu.edit
set E [string equal tearoff [$e type 0]]
$e entryconfig $E -state $AddState
$e entryconfig [incr E] -state $State
$e entryconfig [incr E] -state $State
global ssl
if {[array exists ssl]} {
set e .menu.opts.ssl
set E [string equal tearoff [$e type 0]]
$e entryconfig $E -state $AddState
$e entryconfig [incr E] -state $AddState
}
}
proc UpdateGlobalState {} {
global state
set f .menu.file
set F [string equal tearoff [$f type 0]]
$f entryconfig $F -state [expr {$state(readonly) ? "disabled" : "normal"}]
}
proc TraceEntry args {
global PW state Entry
set PW($state(selected)) [list \
$Entry(username) \
$Entry(password) \
$Entry(sel-user) \
$Entry(sel-pass) \
$Entry(sel-pas2) \
$Entry(sel-newl) \
]
}
proc UpdateWindowTitle args {
global state conf Version
set State {}
if {$state(readonly)} { lappend State readonly } else {
if {$state(changed)} { lappend State changed }
if {$conf(readonly)} { lappend State locked }
}
set title "TkPasMan-$Version"
if {[llength $State]} { append title " ([join $State {, }])" }
wm title . $title
wm iconname . $title
}
proc ShowMenuBar {{hint 1}} {
global conf
if {$conf(show-menu)} {
. config -menu .menu
} else {
. config -menu {}
if {$hint} {
Hint "Use right hand mouse button to popup menu"
}
}
}
proc ShowStatusBar {} {
global conf
if {$conf(show-status)} {
pack .status -side bottom -fill x -before .l
} else {
pack forget .status
}
}
proc ShowPassWords {} {
global conf
if {$conf(show-passwd)} {
.p configure -show {}
} else {
.p configure -show *
}
}
proc ShowLocked {{hint 1}} {
global conf state
UpdateWindowTitle
UpdateSelection
if {$hint} {
if {$state(readonly)} {
Hint "File not writable at all"
} elseif {$conf(readonly)} {
Hint "File write protected"
} else {
Hint "File is writable"
}
}
}
proc Remove {} {
global PW conf state
if {$conf(confirm-remove-site) ? [string equal yes \
[tk_messageBox -title Alert! \
-message {Do you really want to remove this site?} \
-type yesnocancel -default cancel -icon warning -parent .]] : 1} {
if {[string equal . [selection own]]} { selection clear }
unset PW($state(selected))
.l.l selection clear 0 end
UpdateListbox
UpdateSelection
Hint "Site removed"
} else {
Hint "Remove cancelled"
}
}
proc Add {} {
global PW state
set Site [Input {Add site} "Please enter hostname or description:" {}]
if {[string compare $Site {}]} {
if {[lsearch -exact $state(listVar) $Site] == -1} {
set PW($Site) [list {} {} 1 1 0 0]
UpdateListbox
}
ListboxSelect [lsearch -exact $state(listVar) $Site]
}
}
proc Edit {} {
global PW state
set Site [Input {Edit description} \
"Please enter new hostname\nor description:" $state(selected)]
if {![string equal $Site $state(selected)] && ![string equal $Site {}]} {
if {[lsearch -exact $state(listVar) $Site] == -1} {
set PW($Site) $PW($state(selected))
unset PW($state(selected))
UpdateListbox
ListboxSelect [lsearch -exact $state(listVar) $Site]
} else {
if {[string equal [
tk_messageBox -title Alert! -message {Description already exists!} \
-type retrycancel -default retry -parent .] retry]} {
after idle Edit
}
}
}
}
namespace import cooltk::*
if {$state(X)} {
wm withdraw .
}
if {[llength $argv]} {
foreach arg $argv {
switch -exact -- $arg {
--dump {
set state(do-dump) 1
set state(readonly) 1
}
--disable-selection {
set state(enable-selection) 0
}
--readonly {
set state(readonly) 1
}
--version {
puts stdout "TkPasMan version $Version"
exit 0
}
--help {
regexp -lineanchor {(^[\t ]*?--help:.*?\n)\n\n} $Help {} usage
puts stdout \
"This is TkPasMan version $Version, written by Wilbert Berendsen
<wbsoft@xs4all.nl>. This is Free Software, distributed under the GNU General
Public License. It comes with absolutely NO WARRANTY.\n
Usage: tkpasman \[options\]\n\n$usage"
exit 0
}
--fullhelp {
puts stdout $Help
exit 0
}
default {
puts stderr "tkpasman: error: Unknown command line option: \"$arg\""
exit 1
}
}
}
}
if {[file readable $ConfigFile]} {
set f [open $ConfigFile r]
gets $f line
if {[string compare -nocase $line "# TkPasMan-2.1"] < 1} {
set state(old-config) 1
eval [read $f]
catch {unset conf(onquit-save)}
catch {unset conf(allow-two-pastes)}
set conf(onquit-save-options) 0
} else {
array set conf [read $f]
}
close $f
}
if {$state(X)} {
if {$conf(save-windowsize)} {
wm geometry . $conf(geometry)
}
if {[string equal $conf(skin) {}]} {
set conf(skin) [expr {[regexp color [winfo visual .]] ? "Default" : "none"}]
}
set s {
option clear
option add *Label.anchor w
option add *Radiobutton.anchor w
option add *Checkbutton.anchor w
option add *StatusBar*takeFocus 0
option add *StatusBar.Button.padY 0
option add *Scrollbar.takeFocus 0
option add *ScrollListbox.Listbox.width 30
option add *Scrollbar.width 12
option add *Input.Entry.width 30
option add *Input.Message.font {Times 18}
option add *Input.Message.aspect 400
option add *About*AllJustify center
option add *About*AllFont {helvetica 12} widgetDefault
option add *About*titleFont {helvetica 18 bold} widgetDefault
option add *About*urlUnderline 1 widgetDefault
}
if {[regexp color [winfo visual .]]} {
append s {
option add *About*urlForeground blue widgetDefault
}
}
skinSetResetCommand $s ; unset s
skinSet $conf(skin)
}
if {$state(old-config)} {
if {$state(X)} {
tk_messageBox -type ok -icon warning -title Warning -parent . \
-message "Warning: an old configuration file for\
[string range $line 2 end] was found.\n\nI have imported your\
options, but when you save your config, you will not be able\
to use it with an old version of TkPasMan."
} else {
puts stderr "tkpasman: warning: old configfile found, importing"
}
}
if {$state(do-dump)} {
if {[Open]} {
puts stderr "tkpasman: error: could not open password file -- exit for now"
exit 1
}
Dump
exit
}
if {! $state(X)} {
puts stderr "tkpasman: To get the user interface, you must run tkpasman from within X!\nType `tkpasman --help' for info."
exit 1
} 
if {[Open]} {
puts stderr "tkpasman: error: could not open password file -- exit for now"
exit 1
}
CreateMainGUI
wm deiconify .
