#!/bin/sh
#  -*- tcl -*-
# Executing wish #\
exec wish "$0" "$@"

#######################################################################
#
# SecPanel - Graphical user interface for managing SSH- and
# SCP-connections
#
# Author: Steffen Leich <leich@wiwi.uni-marburg.de>
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#######################################################################

#######################################################################
#
# This is version 0.30 of SecPanel
#
# If you want to give any feedback about the program please send it to
# Steffen Leich <leich@wiwi.uni-marburg.de>
# Information about the program can be found on
# http://www2.wiwi.uni-marburg.de/~leich/soft/secpanel
#
#######################################################################

# The dir for the libs and helper-apps
set libdir "[file dirname [info script]]/../lib/secpanel"
# set libdir "."

global sites; 
global actdirsel;
global questres;
global userres;

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {
    global env sites configs
    set secpaneldir "$env(HOME)/.secpanel"
    if {! [file exists $secpaneldir]} {
	puts "Creating my config-dir $secpaneldir (chmod 700)..."
	file mkdir $secpaneldir
	exec chmod 700 $secpaneldir
    }

    if {! [file exists "$secpaneldir/default.profile"]} {
	puts "Creating my default-profile $secpaneldir/default.profile ..."
	set dpf [open "$secpaneldir/default.profile" w]
	puts $dpf " #\n # SecPanel-Pofile\n # Do not edit, use SecPanel instead\n #\n set title \"Default Profile\"\n set host \"\"\n set user \"\"\n set port \"22\"\n set command \"\"\n set identity \"\"\n set agentforward \"0\"\n set x11forward \"0\"\n set nopriv \"0\"\n set verbose \"0\"\n set quiet \"0\"\n set fork \"0\"\n set gateway \"0\"\n set compress \"0\"\n set algo \"default\"\n set compressval \"6\"\n array set lfs {}\n array set rfs {}"
	close $dpf
    }

    set sitefile "$env(HOME)/.secpanel/sites"
    if [file exists $sitefile] {
	set sf [open $sitefile r]
	while {[gets $sf line] >= 0} {
	    set els [split $line #]
	    set sites([lindex $els 0]) "[lindex $els 1]#[lindex $els 2]"
	}
	close $sf
    }
    
    set configfile "$env(HOME)/.secpanel/config"
    if [file exists $configfile] {
	source $configfile
	initconfigs
    } else {
	initconfigs
    }

    # wenn in configfile farbe gesetzt, dann eigene, ansonsten nichts
    # wenn nichts von innen, nichts von aussen, dann secpanel-defcolors
    # globale berschreiben bei falscher Reihenfolge die speziellen Farbwerte
    
    array set gshorts {fore foreground back background}

    foreach gcolval [array names gshorts] {
	if [info exists configs($gcolval)] {
	    # puts "option add *$gshorts($gcolval) $configs($gcolval)"
	    option add *$gshorts($gcolval) $configs($gcolval)
	}
    }

    array set shorts { \
	    entfore Entry.foreground entback Entry.background \
	    listfore Listbox.foreground listback Listbox.background}

    foreach colval [array names shorts] {
	if [info exists configs($colval)] {
	    # puts "option add *$shorts($colval) $configs($colval)"
	    option add *$shorts($colval) $configs($colval)
	    if {$colval == "listfore"} {
		option add *Text.foreground $configs($colval)		
	    }
	    if {$colval == "listback"} {
		option add *Text.background $configs($colval)		
	    }
	}
    }
}

# Set the initial global configs if nothing is set
proc initconfigs {} {
    global configs
    foreach {bintag binprog} \
	    {sshbin ssh keygenbin ssh-keygen agentbin ssh-agent \
	    addbin ssh-add askpassbin askpass scpbin scp xtermbin xterm} {
	if {! [info exists configs($bintag)]} {
	    set configs($bintag) $binprog
	}
    }
    if {! [info exists configs(sshver)]} {
	set configs(sshver) "OpenSSH"
    }
}

init $argc $argv

# Browse to select the programs for the global configs
proc browsebin {which} {
    global widget
    choosefile $widget([set which]ent) "actdirsel"
}

# Saving the global settings
proc save_globals {mode} {
    global widget env configs
    set conffile [open "$env(HOME)/.secpanel/config" w]
    switch -regexp $mode {
	bins {

	    array set bindefs { \
		    ssh ssh keygen ssh-keygen agent ssh-agent add ssh-add \
		    askpass askpass scp scp xterm xterm}

	    foreach f {ssh keygen agent add askpass scp xterm} {
		if {[$widget([set f]ent) get] == ""} {
		    $widget([set f]ent) insert 0 $bindefs($f)
		}

		puts $conffile "set configs([set f]bin) \"[$widget([set f]ent) get]\""
		set configs([set f]bin) [$widget([set f]ent) get]
	    }
	    puts $conffile "set configs(sshver) \"$configs(sshver)\""
	}
	"color|scp" {
	    foreach f {ssh keygen agent add askpass scp xterm} {
		puts $conffile "set configs([set f]bin) $configs([set f]bin)"
	    }
	    puts $conffile "set configs(sshver) \"$configs(sshver)\""
	}
    }
    foreach col {fore back entfore entback listfore listback} {
	if [info exists configs($col)] {
	    puts $conffile "set configs($col) $configs($col)"
	}
    }

    foreach scpbool {scpstats scppres scpverb scpcomp scpshowhidden} {
	if [info exists configs($scpbool)] {
	    if $configs($scpbool) {
		puts $conffile "set configs($scpbool) \"$configs($scpbool)\""
	    } else {
		puts $conffile "set configs($scpbool) \"$configs($scpbool)\""
	    }
	}
    }

    close $conffile
    showstatus "Global configs saved"
}

proc colorchoose {parent title} {
    set col [tk_chooseColor -parent $parent -title "SecPanel - $title"]
    return $col
}

proc colorman {mode} {
    global env configs \
	    foredef backdef entforedef entbackdef listforedef listbackdef

    foreach {name widg} {fore 37 back 38 entfore 39 \
	    entback 40 listfore 41 listback 42} {
	set colbut[set name] ".top32.fra33.but[set widg]"
    }
    
    set colvals [list fore back entfore entback listfore listback];
    
    switch -exact $mode {
	1 {
	    Window show .top32
	    foreach colval $colvals {
		if [info exists configs($colval)] {
		    [set colbut[set colval]] configure -background $configs($colval)
		} else {
		    set [set colval]def 1
		}
	    }
	}
	save {
	    foreach colval $colvals {
		if {! [set [set colval]def]} {
		    set configs([set colval]) [[set colbut[set colval]] cget -background]
		} else {
		    if [info exists configs([set colval])] {
			unset configs([set colval])
		    }
		}
	    }
	    Window destroy .top32
	    save_globals color
	}
	default {
	    set col [colorchoose .top32 "Foreground Color"]
	    if {$col != ""} {
		[set colbut[set mode]] config \
			-background $col -activebackground $col
		return
	    } else {
		return
	    }
	}
    }
}

proc updateDistLabel {} {
    .top17.fra35.fra17.lab39 config -text \
	    "Dist. to [.top17.fra35.fra17.cpd29.01 get active] as\
	    [.top17.fra35.fra17.fra17.01 get active]"
}


# Show comment for one forwarding-entry
proc showcomm {mode} {
    global widget lfstemp rfstemp
    set actline [$widget([set mode]forwards) get active]
    if [regsub { -> } $actline : out] {
	$widget([set mode]fcomment) config -text [set [set mode]fstemp($out)]
    }
}

# Take the new forwarding to the list
proc add_forw {mode} {
    global widget lfstemp rfstemp
    set fhost [$widget([set mode]fhost) get]
    set fin [$widget([set mode]fin) get]
    set fout [$widget([set mode]fout) get]
    set fcomment [$widget([set mode]fcommentent) get]

    set lhostname "<TARGET-HOST>"
    set rhostname "<LOCAL-HOST>"

    if {$fhost == ""} {
	set fht [set [set mode]hostname]
    } else {
	set fht $fhost
    }

    if {$fin != "" && $fout != ""} {

	$widget([set mode]fcomment) config -text ""	
	foreach an [array names [set mode]fstemp] {
	    if {$an == "$fin:$fht:$fout"} {
		$widget([set mode]fcomment) config -text "Forward exists"
		return
	    }
	}

	$widget([set mode]forwards) insert end "$fin -> $fht:$fout"
	set [set mode]fstemp($fin:$fht:$fout) $fcomment

	$widget([set mode]fin) delete 0 end
	$widget([set mode]fout) delete 0 end
	$widget([set mode]fhost) delete 0 end
	$widget([set mode]fcommentent) delete 0 end

	focus $widget([set mode]fin)
	$widget([set mode]forwards) see end
    }
}

# Delete a forwarding from the list
proc del_forw {mode} {
    global widget lfstemp rfstemp
    set lwin .top43
    set rwin .top51

    if {[selection own] == $widget([set mode]forwards)} {
	set actline [$widget([set mode]forwards) get active]
	if [regsub { -> } $actline : out] {
	    unset [set mode]fstemp($out)
	    $widget([set mode]forwards) delete active
	}
    } else {
	showmessage "No forwarding selected" [set [set mode]win]
    }
    selection clear
}

# Assign a list of forwardings to a profile
proc save_forwards {mode} {
    global widget rfs rfstemp lfs lfstemp
    set lwin .top43
    set rwin .top51

    if [info exists [set mode]fs] {
	unset [set mode]fs
    }

    array set [set mode]fs [array get [set mode]fstemp]
    unset [set mode]fstemp

    Window destroy [set [set mode]win]
}

# Open the forw.-wins ans insert the (temporal) forward-lists
proc open_forwardings {mode} {
    global widget lfs rfs lfstemp rfstemp
    set lwin .top43
    set rwin .top51
    
    Window show [set [set mode]win]
    $widget([set mode]forwards) delete 0 end

    if [info exists [set mode]fstemp] {
	unset [set mode]fstemp
    }

    if [info exists [set mode]fs] {
	array set [set mode]fstemp [array get [set mode]fs]
    }

    foreach fe [array names [set mode]fstemp] {
	if [regsub : $fe { -> } out] {
	    $widget([set mode]forwards) insert end $out
	}
    }
}

# Umswitchen zwischen Panels im Hauptfenster
proc changetab {mode} {
    foreach f {21 27 35 44 46} {
	if {[grid info .top17.fra[set f]] != ""} {
	    grid remove .top17.fra[set f]
	}
    }
    array set frames {connect 46 terminal 44 key 35 ssh 21 scp 27}
    
    grid .top17.fra$frames($mode) -in .top17 \
	    -column 0 -row 1 -columnspan 1 -rowspan 1 \
	    -ipadx 2 -ipady 2 -padx 2 -pady 2 -sticky nesw
    showstatus ""
}

# Allgemeine Aufnahme aus tk_getOpenFile-Dialog in einen Entry
proc choosefile {entry startdir} {
    global actdirsel

    if {$startdir == "actdirsel"} {
	if [info exists actdirsel] {
	    set startdir $actdirsel
	} else {
	    set startdir "/usr/"
	}
    }

    set choice [tk_getOpenFile -initialdir $startdir]
    if {$choice != ""} {
	$entry delete 0 end
	$entry insert 0 $choice
	set actdirsel [file dirname $choice]
    } else {
	return
    }
}

# Update of the Lists for distributing keys and for scp-connections
proc clear_distmenu {} {
    global env widget sites

    $widget(keydisthost) delete 0 end
    $widget(keydistuser) delete 0 end

    $widget(scphosts) delete 0 end
    $widget(scpusers) delete 0 end

    set disthosts [list]
    set distusers [list]

    lappend distusers $env(USER)

    foreach s [array names sites] {
	set he [lindex [split $sites($s) '#'] 0]
	set ue [lindex [split $sites($s) '#'] 1]
	set hfound 0
	set ufound 0

	set usercheck 1
	if {$ue == "<ASKFORUSER>" || $ue == ""} {
	    set usercheck 0
	}

	foreach hd $disthosts {
	    if {$he == $hd} {
		set hfound 1
		break
	    }
	}

	if {$hfound != 1} {
	    lappend disthosts $he
	}

	if {$usercheck} {
	    foreach ud $distusers {
		if {$ue == $ud} {
		    set ufound 1
		    break
		}
	    }
	    if {$ufound != 1} {
		lappend distusers $ue
	    }
	}
    }

    set profiles [glob -nocomplain "$env(HOME)/.secpanel/*.profile"]
    foreach prof $profiles {
	if {[file rootname [file tail $prof]] == "default"} {
	    continue
	}
	source $prof

	set he $host
	set ue $user
	set hfound 0
	set ufound 0

	foreach hd $disthosts {
	    if {$he == $hd} {
		set hfound 1
		break
	    }
	}
	if {$hfound != 1} {
	    lappend disthosts $he
	}

	foreach ud $distusers {
	    if {$ue == $ud} {
		set ufound 1
		break
	    }
	}
	if {$ufound != 1} {
	    lappend distusers $ue
	}
	
	# correct lfs
	unset lfs
    }

    foreach hent [lsort $disthosts] {
	$widget(keydisthost) insert end $hent
	$widget(scphosts) insert end $hent
    }
    foreach uent [lsort $distusers] {
	$widget(keydistuser) insert end $uent
	$widget(scpusers) insert end $uent
    }
}

proc clear_prmenu {} {
    global env widget
    $widget(profiles) delete 0 end
    foreach prof [lsort [glob -nocomplain "$env(HOME)/.secpanel/*.profile"]] {
	$widget(profiles) insert end "[file rootname [file tail $prof]]"
    }
}

proc clear_profiles {} {
    global env widget agentforward x11forward nopriv lfs rfs \
	    verbose quiet fork gateway compress algo compressval \
	    connwait termicon

    foreach b {agentforward x11forward nopriv \
	    verbose quiet fork gateway compress connwait termicon} {
	set [set b] 0
    }
    
    set algo "default"
    set compressval 6

    foreach e {host command title identity user port profile} {
	$widget([set e]ent) delete 0 end
    }
    
    if [info exists lfs] {
	unset lfs
    }

    if [info exists rfs] {
	unset rfs
    }

    $widget(userent) insert 0 "$env(USER)"
    $widget(portent) insert 0 "22"

    if {[winfo exists .top43]} {
	Window destroy .top43
	open_forwardings l
    }

    if {[winfo exists .top51]} {
	Window destroy .top51
	open_forwardings r
    }
}

# Connection
proc connect {mode} {
    global widget sites env configs libdir

    if {$mode == "def"} {
	if {[$widget(defsites) index end] > 0} {
	    source "$env(HOME)/.secpanel/default.profile"
	    set actconn [$widget(defsites) get active]
	    set host [lindex [split $sites($actconn) #] 0]

	    set userentry [lindex [split $sites($actconn) #] 1]

	    if {$userentry == "<ASKFORUSER>"} {
		set user [askforuser]
		if {$user == "#####"} {
		    return
		}
	    } else {
		set user $userentry
	    }

	    set title $actconn
	} else {
	    showmessage "No conncections available, please use \"New\"" ""
	    return
	}
    }

    if {$mode == "spec"} {
	if {[$widget(specsites) index end] > 0} {
	    set actconn [retprof [$widget(specsites) get active]]
	    source "$env(HOME)/.secpanel/$actconn.profile"
	} else {
	    showmessage "No conncections available, please use \"New\"" ""
	    return
	}
    }

    if {[array size lfs] > 0} {
	foreach lf [array names lfs] {
	    if {[regsub {<TARGET-HOST>} [lindex [split $lf :] 1] $host th]} {
		append lf_tag  " -L [lindex [split $lf :] 0]:$th:[lindex [split $lf :] 2] "
	    } else {
		append lf_tag  " -L [lindex [split $lf :] 0]:[lindex [split $lf :] 1]:[lindex [split $lf :] 2] "
	    }
	}
    } else {
	set lf_tag " "
    }

    set localhost [info hostname]
    if {[array size rfs] > 0} {
	foreach rf [array names rfs] {
	    if {[regsub {<LOCAL-HOST>} [lindex [split $rf :] 1] $localhost lh]} {
		append rf_tag  " -R [lindex [split $rf :] 0]:$lh:[lindex [split $rf :] 2] "
	    } else {
		append rf_tag  " -R [lindex [split $rf :] 0]:[lindex [split $rf :] 1]:[lindex [split $rf :] 2] "
	    }
	}
    } else {
	set rf_tag " "
    }

    if {$user != ""} {
	set user_tag "-l $user "
    } else {
	set user_tag " "
    }
    
    if {$port == 22 || $port == ""} {
	set port_tag " "
    } else {
	set port_tag "-p $port "
    }
    
    if {$algo != "default" || $algo == ""} {
	set algo_tag "-c $algo "
    } else {
	set algo_tag " "
    }
    
    if {$identity != ""} {
	set ident_tag "-i $identity "
    } else {
	set ident_tag " "
    }
    
    if {$command != ""} {
	set command_tag "$command"
    } else {
	set command_tag ""
    }
    
    if $compress {
	# openssh
	if {$configs(sshver) == "OpenSSH"} {
	    set compressval_tag "-o \'CompressionLevel [set compressval]\' "
	} else {
	    set compressval_tag "-o CompressionLevel=$compressval "
	}
    } else {
	set compressval_tag " "
    }
    
    array set bools {
	"agentforward" "-a" \
		"x11forward" "-x" \
		"nopriv" "-P"  "verbose" "-v" \
		"quiet" "-q" \
		"fork" "-f" \
		"gateway" "-g" \
		"compress" "-C"
    }
    
    # foreach f [array names $bools]
    foreach f {agentforward x11forward nopriv verbose \
	    quiet fork gateway compress} {
	if [set $f] {
	    set [set f]_tag "$bools($f) "
	} else {
	    set [set f]_tag " "
	}
    }

    # openssh
    if {! $x11forward} {
	if {$configs(sshver) == "OpenSSH"} {
	    set x11forward_tag "-X "
	}
    }

    # Terminal-related
    if [info exists termicon] {
	if $termicon {
	    if {$configs(xtermbin) == "Eterm"} {
		set icontag "--iconic"
	    } else {
		set icontag "-iconic"
	    }
	} else {
	    set icontag ""
	}
    } else {
	set icontag ""
    }

    if [info exists connwait] {
	if $connwait {
	    set waittag "$libdir/secpanel.wait"
	    set woption "\""
	} else {
	    set waittag ""
	    set woption ""
	}
    } else {
	set waittag ""
	set woption ""
    }

    set profilestring "$configs(sshbin) $user_tag \
	    $agentforward_tag $x11forward_tag $port_tag $algo_tag \
	    $ident_tag $nopriv_tag $verbose_tag $quiet_tag \
	    $fork_tag $gateway_tag $compress_tag $compressval_tag \
	    $lf_tag $rf_tag $host $command_tag"

    set connfile [open "$env(HOME)/.secpanel/.connfile" w]
    puts $connfile $profilestring
    close $connfile
    exec chmod +x "$env(HOME)/.secpanel/.connfile"

    set actstring "exec $configs(xtermbin) $icontag -T \"SSH Connection - $title\" \
	    -e $waittag $woption $env(HOME)/.secpanel/.connfile $woption &"

    eval $actstring
}

proc defsiteupdate {} {
    global widget sites
    $widget(defsites) delete 0 end
    foreach s [lsort [array names sites]] {
	$widget(defsites) insert end $s
    }
}

proc probeversion {} {
    global widget configs

    set binstring [$widget(sshent) get]
    if {$binstring == ""} {
	set binstring "ssh"
    }

    catch {exec $binstring -V} ver

    if [regexp -nocase "openssh" $ver] {
	set restext "I guess we have an OpenSSH-Version\n\nFound $ver"
	set configs(sshver) "OpenSSH"
    } elseif {[regexp -nocase "shell 2" $ver] || [regexp -nocase "ssh version 2" $ver]} {
	set restext "I guess we have a SSH.com 2.x-Version\nThat version is not yet supported by SecPanel!\n\nFound $ver"	
    } elseif [regexp -nocase "ssh version 1" $ver] {
	set restext "I guess we have a\nSSH.com 1.x -Version\n\nFound $ver"
	set configs(sshver) "SSH.com"
    } else {
	set restext "I am not sure about what kind of program is this!\n\nMaybe not a SSH-binary?\nOr doesn't exist at all..."
    }	

    showmessage "$restext" .top17
}

proc showconfirm {text parent} {
    global questres

    if {$parent == ""} {
	set p .top17
    } else {
	set p $parent
    }

    set old [focus]
    Window show .top18

    set xcoord [expr [winfo rootx $p] + ([winfo width $p] / 2) - ([winfo width .top18] / 2)]
    set ycoord [expr [winfo rooty $p] + ([winfo height $p] / 2) - ([winfo height .top18] / 2)]
    wm geometry .top18 +$xcoord+$ycoord

    .top18.mes19 config -text "$text"
    tkwait visibility .top18

    focus .top18
    grab .top18
    tkwait variable questres
    grab release .top18
    focus $old
    Window destroy .top18
    if {$questres} {
	return 1
    } else {
	return 0
    }
}

proc getuser {} {
    global widget userres
    set userres [$widget(askeduser) get]
}

proc askforuser {} {
    global questres userres widget
    set old [focus]
    Window show .top21
    tkwait visibility .top21
    focus $widget(askeduser)
    grab .top21
    tkwait variable userres
    grab release .top21
    focus $old
    Window destroy .top21
    return $userres
}

# SCP Transfers
proc scptransfer {mode} {
    global env widget configs scpurl libdir

    set scptransfer "$env(HOME)/.secpanel/.scptransfer"

    set dlr $widget(scpdirsr)
    set flr $widget(scpfilesr)
    set dll $widget(scpdirsl)
    set fll $widget(scpfilesl)

    set lactdir [.top34.fra35.ent45 get]
    set ractdir [.top34.fra37.ent44 get]

    switch -exact $mode {
	cptoremote {
	    if {[selection own] == $dll} {
		set rectag " -r "
		set lr $dll
	    } elseif {[selection own] == $fll} {
		set rectag ""
		set lr $fll
	    } else {
		showmessage "No files or directories selected on the local site" .top34
		return
	    }
	}
	cptolocal {
	    if {[selection own] == $dlr} {
		set rectag " -r "
		set lr $dlr
	    } elseif {[selection own] == $flr} {
		set rectag ""
		set lr $flr
	    } else {
		showmessage "No files or directories selected on the remote site" .top34
		return
	    }
	}
    }
    
    foreach cs [$lr curselection] {
	lappend resslist [$lr get $cs]
    }
    
    array set bools {
	"scpstats" "-q" \
		"scppres" "-p" \
		"scpverb" "-v" \
		"scpcomp" "-C"
    }

    foreach f [array names bools] {
	if [set configs($f)] {
	    set [set f]_tag "$bools($f) "
	} else {
	    set [set f]_tag " "
	}
    }

    set transferfile [open "$scptransfer" w]
    puts -nonewline $transferfile "$configs(scpbin) $scpstats_tag $scppres_tag \
	    $scpverb_tag $scpcomp_tag $rectag "
    
    foreach r $resslist {
	if {$mode == "cptolocal"} {
	    puts -nonewline $transferfile "\"$scpurl:$ractdir/$r\" "
	} else {
	    puts -nonewline $transferfile "\"$lactdir/$r\" "
	}
    }
    
    if {$mode == "cptolocal"} {
	puts $transferfile " \"$lactdir\""
    } else {
	puts $transferfile " \"$scpurl:$ractdir\""
    }

    close $transferfile
    exec chmod +x "$scptransfer"
    exec rxvt -e $libdir/secpanel.wait "$scptransfer" &
}

proc scpAuth {sock} {
    global pass

    gets $sock passandport

    set serverpass [lindex [split $passandport] 1]
    if {$serverpass != $pass} {
	close $sock
	showmessage "Wrong authentication from remote ListServer\nHad to reject connection" .top17
	return
    } else {
	close $sock
	scpman opengui
    }
}

proc Accept {sock addr port} {
    global pass

    fconfigure $sock -buffering line
    fileevent $sock readable "scpAuth $sock"
}

# Managing SCP
proc scpman {mode} {
    global widget configs libdir env scplister scpurl controlserver pass

    switch -exact $mode {
	open {
	    set host [$widget(scphosts) get active]
	    set user [$widget(scpusers) get active]

	    set scpurl "$user@$host"

	    # Launching Control-Server in SecPanel
	    if [info exists controlserver] {
		close $controlserver
	    }
	    set controlserver [socket -server "Accept" -myaddr 127.0.0.1 8810]
	    fconfigure $controlserver -buffering line

	    showstatus "Waiting for ListServer-Callback"

	    # Generating a password
	    set pass [expr {int(rand() * 1000 * [pid])}][expr {int(rand() * 1000 * [pid])}][expr {int(rand() * 1000 * [pid])}]

	    # Launching listserver on remote site
	    set lf [open "$libdir/listserver.tcl" r]
	    set currlf [open "$env(HOME)/.secpanel/.listserver.tcl" w]
	    while {[gets $lf line] >= 0} {
		if [regsub {<PASS-XXXXX>} $line $pass out] {
		    puts $currlf $out
		    continue
		}
		puts $currlf $line
	    }
	    close $currlf
	    close $lf

	    set scpf "$env(HOME)/.secpanel/.scpconnect"
	    set connectfile [open "$scpf" w]
	    puts $connectfile "echo -e \"SecPanel ListServer\n\nIn this shell we get a connection for establishing\na graphical file listing.\n---------------------------------------------------------\n\n\""
	    puts $connectfile "$configs(sshbin) -C \
		    -L 8820:localhost:9920 -R 9910:localhost:8810 \
		    -l $user $host tcl < $env(HOME)/.secpanel/.listserver.tcl"
	    close $connectfile
	    exec chmod +x $scpf
	    exec $configs(xtermbin) -T "SecPanel ListServer" -e $scpf &
	}
	opengui {
	    showstatus "Received CallBack from ListServer"
	    close $controlserver
	    unset controlserver

	    # Launching scp-gui and connecting to listserv-forward
	    set host localhost
	    set port 8820
	    
	    Window show .top34
	    .top34.fra46.lab47 config -text "FileListing for $scpurl"

	    set scplister [socket $host $port]
	    fconfigure $scplister -buffering line
	    showstatus "Connected to ListServer"
	    puts $scplister "auth $pass"
	    
	    scplist $env(HOME) l
	    scplist "++InitListing" r
	}
	close {
	    puts $scplister "++CloseYourSelf"
	    close $scplister
	    Window destroy .top34
	}
    }
}

proc scpswitchdir {y mode} {
    global widget
    switch -exact $mode {
	l {
	    set actdir "[.top34.fra35.ent45 get]"
	    if {$y == "ent"} {
		scplist "$actdir" $mode
		return
	    }
	}
	r {
	    set actdir "[.top34.fra37.ent44 get]"
	    if {$y == "ent"} {
		scplist "$actdir" $mode
		return
	    }
	}
    }
    set dl $widget(scpdirs[set mode])
    set fl $widget(scpfiles[set mode])

    if {$actdir != "/"} {
	scplist "$actdir/[$dl get [$dl nearest $y]]" $mode
    } else {
	scplist "/[$dl get [$dl nearest $y]]" $mode
    }
}

proc scplist {actdir mode} {
    global widget scplister configs

    set dl $widget(scpdirs[set mode])
    set fl $widget(scpfiles[set mode])

    $dl delete 0 end
    $fl delete 0 end
    
    set pe [file split "$actdir"]
    set pl [llength $pe]
    
    if {[lindex $pe [expr $pl - 1]] == ".."} {
	set actdir "[eval file join [lrange $pe 0 [expr $pl - 3]]]"
    }
    
    if {$actdir != "/"} {
	$dl insert end ..
    }

    switch -exact $mode {
	"l" {
	    .top34.fra35.ent45 delete 0 end
	    .top34.fra35.ent45 insert 0 "$actdir"

	    if $configs(scpshowhidden) {
		set gpat "glob -nocomplain \"$actdir/.*\" \"$actdir/*\""
	    } else {
		set gpat "glob -nocomplain \"$actdir/*\""
	    }

	    foreach f [lsort [eval $gpat]] {

		if {[file tail "$f"] == ".." || [file tail "$f"] == "."} {
		    continue
		}
		if [file isdirectory "$f"] {
		    $dl insert end [file tail "$f"]
		} else {
		    $fl insert end [file tail "$f"]
		}
	    }
	}
	"r" {
	    puts $scplister "$actdir\t$configs(scpshowhidden)"
	    
	    # Catching errors from ListServer...
	    set actdir "[string trimleft [gets $scplister] "+"]"

	    .top34.fra37.ent44 delete 0 end
	    .top34.fra37.ent44 insert 0 "$actdir"

	    while 1 {
		gets $scplister line
		if {$line == "+++++"} {
		    break
		}
		if [regsub {^\+\+ } $line "" ls] {
		    $dl insert end [file tail $ls]
		} else {
		    $fl insert end [file tail $ls]
		}
	    }
	}
    }
}

proc updateSCPLabel {} {
    global widget
    .top17.fra27.fra30.but33 config -text \
	    "Connect to [$widget(scpusers) get active]@[$widget(scphosts) get active]"
}

# Display messages
proc showmessage {text parent} {
    if {$parent == ""} {
	set p .top17
    } else {
	set p $parent
    }

    Window show .top22
    .top22.mes23 config -text $text

    set xcoord [expr [winfo rootx $p] + ([winfo width $p] / 2) - ([winfo width .top22] / 2)]
    set ycoord [expr [winfo rooty $p] + ([winfo height $p] / 2) - ([winfo height .top22] / 2)]
    wm geometry .top22 +$xcoord+$ycoord

    focus .top22
    grab .top22
    tkwait window .top22
}


# Delete one connection
proc delconn mode {
    global widget env sites
    switch -exact $mode {
	def {
	    if {[selection own] == $widget(defsites)} {
		set actentry [$widget(defsites) get active]
		if {[showconfirm "Delete $actentry?" ""] == 1} {
		    unset sites($actentry)	    
		    set sitefile [open "$env(HOME)/.secpanel/sites" w]
		    foreach s [array names sites] {
			puts $sitefile "$s#$sites($s)"
		    }
		    close $sitefile
		    defsiteupdate
		    clear_distmenu
		    selection clear
		} else {
		    return
		}
	    } else {
		showmessage "No entry selected" ""
	    }
	}
	spec {
	    if {[selection own] == $widget(specsites)} {
		set actentry [$widget(specsites) get active]
		set delprof [retprof $actentry]
		if {$delprof == "default"} {
		    showmessage "You may not delete the default profile" ""
		    return
		} else {
		    if {[showconfirm "Delete $actentry?" ""] == 1} {
			file delete "$env(HOME)/.secpanel/$delprof.profile"
			specsiteupdate
			clear_prmenu
			clear_distmenu
			selection clear
		    } else {
			return
		    }
		}    
	    } else {
		showmessage "No entry selected" ""
	    }
	}
    }
}

# Delete one profile from the specedit-panel
proc delete_profile {} {
    global env widget
    set act [$widget(profileent) get]
    if {$act == ""} {
	showmessage "To delete a profile first load it" ""
	return
    }
    if {$act == "default"} {
	showmessage "You may not delete the default profile" ""
	return
    }
    if {[showconfirm "Delete $act?" ""] == 1} {
	file delete "$env(HOME)/.secpanel/$act.profile"
	clear_prmenu
	clear_profiles
	specsiteupdate
	clear_distmenu
    }
}

# Distribute public-keys to remote hosts
proc distkey {} {
    global env widget libdir configs

    set user [$widget(keydistuser) get active]

    if {$user == ""} {
	set user $env(USER)
    }

    set host [$widget(keydisthost) get active]
    set identfile [$widget(keydistkey) get]

    if {$identfile == ""} {
	showmessage "No key for distribution selected" ""
	return
    }
    
    exec xterm -title "SecPanel Key-Distribution" \
	    -e $libdir/secpanel.dist $host $user $identfile $configs(sshbin) &
}

# Management of the known_hosts (kostkeys)
proc hostkey {mode} {
    global env widget
    set khfile "$env(HOME)/.ssh/known_hosts"
    switch -exact $mode {
	edit {
	    if [file exists $khfile] {
		Window show .top50
		$widget(knownhosts) delete 0 end
		set hosts [open $khfile r]
		while {[gets $hosts line] >= 0} {
		    lappend hl [lindex [split $line] 0]
		}

		foreach h [lsort $hl] {
		    $widget(knownhosts) insert end $h
		}

		close $hosts
		return
	    } else {
		showmessage "No $khfile found" ""
		return
	    }
	}
	view {
	    set actk [$widget(knownhosts) get active]
	    if [file exists $khfile] {
		Window show .top19
		set hosts [open $khfile r]
		while {[gets $hosts line] >= 0} {
		    set kparts [split $line]
		    if {[lindex $kparts 0] == $actk} {
			$widget(hostkeyview) delete 1.0 end
			$widget(hostkeyview) insert end "[lindex $kparts 1] [lindex $kparts 2] [lindex $kparts 3]"
			break
		    }
		}
		close $hosts
		return
	    }
	}
	export {
	    if {[selection own] != $widget(knownhosts)} {
		showmessage "No hostkey selected!" ".top50"
		return
	    }
	    set actk [$widget(knownhosts) get active]
	    set hkf [tk_getSaveFile -initialdir "$env(HOME)"]
	    if {$hkf == ""} {
		return
	    } else {
		set hkfout [open "$hkf" w]
		
		set hosts [open $khfile r]
		while {[gets $hosts line] >= 0} {
		    set kparts [split $line]
		    if {[lindex $kparts 0] == $actk} {
			puts $hkfout $line
			break
		    }
		}
		close $hosts

		close $hkfout
		return
	    }		
	}
	delete {
	    if {[selection own] != $widget(knownhosts)} {
		showmessage "No hostkey selected!" ".top50"
		return
	    }
	    set actk [$widget(knownhosts) get active]
	    if {[showconfirm "Delete $actk?" ".top50"] == 1} {
		if [file exists $khfile] {
		    set hosts [open $khfile r]
		    # read lines
		    while {[gets $hosts line] >= 0} {
			lappend klines $line
		    }
		    close $hosts
		    # write lines
		    set hosts [open $khfile w]
		    foreach line $klines {
			set kparts [split $line]
			if {[lindex $kparts 0] != $actk} {
			    puts $hosts $line
			}
		    }
		    close $hosts
		    hostkey edit
		    selection clear
		    return
		}
	    } else {
		return
	    }
	}
    }
}

proc insprot {nr mode} {
    global widget
    $widget([set mode]fout) delete 0 end
    $widget([set mode]fout) insert 0 $nr
}

# Managing the keypair on the local host
proc keygen {mode} {
    global env widget configs pwtextmode libdir

    if {[$widget(identpath) get] == ""} {
	set kf "$env(HOME)/.ssh/identity"
    } else {
	set kf [$widget(identpath) get]
    }
    
    switch -exact $mode {
	gen {
	    # possible ways of giving the user a new key:
	    # - dialog incl. new passwords is a problem because listed in ps
	    # - complete textmode in an xshell most secure
	    # - dialog for file, password etc. and execute by expect
	    set actstring "exec $configs(xtermbin) -T \"SecPanel ssh-keygen\" \
		    -e $libdir/secpanel.wait \"$configs(keygenbin) -f $kf\" &"
	    eval $actstring
	}
	1 {
	    if {[$widget(identpath) get] == ""} {
		if {! [file exist $env(HOME)/.ssh/identity]} {
		    showmessage "No key given and\n$env(HOME)/.ssh/identity not found" ""
		    return
		} else {
		    set kf "$env(HOME)/.ssh/identity"
		}
	    } else {
		set kf [$widget(identpath) get]
	    }
	    if [set pwtextmode] {
		set actstring "exec $configs(xtermbin) -T \"SecPanel - \
			change password for $kf\" \
			-e $libdir/secpanel.wait \"$configs(keygenbin) -p -f $kf\" &"
		eval $actstring
	    } else {		
		Window show .top20
		$widget(proplabel) config -text $kf
	    }
	}
	chpwd {
	    set oldp [.top20.fra21.ent26 get]
	    set newp1 [.top20.fra21.ent30 get]
	    set newp2 [.top20.fra21.ent31 get]

	    if {$newp1 != $newp2} {
		showmessage "New password and repeated new password don't match" ""
		return
	    }

	    if [catch {exec $configs(keygenbin) -p -f $kf \
		    -P $oldp -N $newp1} err] {
		showmessage $err ""
		return
	    }
	    Window destroy .top20
	}
	chpath {
	    choosefile $widget(identpath) $env(HOME)/.ssh
	}
    }
}

proc load_profile {mode} {
    global env widget agentforward x11forward nopriv \
	    verbose quiet fork gateway compress algo \
	    compressval lfs rfs connwait termicon

    # first clear them all
    foreach var {agentforward x11forward nopriv \
	    verbose quiet fork gateway compress algo \
	    compressval lfs rfs connwait termicon} {
	if [info exists [set var]] {
	    unset $var
	}
    }

    if {$mode == "ssh"} {
	set profile [$widget(profiles) get active]
    } elseif {$mode == "connects"} {
	set profile [retprof [$widget(specsites) get active]]
    }

    source $env(HOME)/.secpanel/$profile.profile

    foreach f {title host user port command identity profile} {
	$widget([set f]ent) delete 0 end
	$widget([set f]ent) insert 0 [set $f]
    }

    # Umwandlung der Listen in Arrays
    if {! [array exists lfs] && $lfs != ""} {
	set lfsnew [set lfs]
	unset lfs
	foreach listelem $lfsnew {
	    array set lfs \
		    "[lindex [split $listelem :] 0]:<TARGET-HOST>:[lindex [split $listelem :] 1] \
		    {Local forward vom old Version of SecPanel}"
	}
    }

    if {[winfo exists .top43]} {
	open_forwardings l
    }

    if {[winfo exists .top51]} {
	open_forwardings r
    }
}

# Control the SSH-Agent
proc manage_agent {mode} {
    global env widget configs
    switch -exact $mode {
	launch {
	    
	    if {[info exists env(SSH_AGENT_PID)] && [info exists env(SSH_AUTH_SOCK)]} {
		if {[showconfirm "There seems to be another SSH-Agent. Start anyway?" ""] == 0} {
		    return
		}
	    }

	    # Start ssh-agent and read envs
	    set agentout [open "| $configs(agentbin) -c" r]
	    while {[gets $agentout line] >= 0} {
		if [string match "setenv SSH*" $line] {
		    set env([lindex [split $line] 1]) \
			    [string trimright [lindex [split $line] 2] \;]
		}
	    }
	    close $agentout
	    $widget(statusagent) config -text "Agent active" -bg green -fg black
	}
	kill {
	    if {[showconfirm "Kill SSH-agent?" ""] == 1} {
		exec $configs(agentbin) -k
		# Envs are to be killed explicitly
		unset env(SSH_AGENT_PID)
		unset env(SSH_AUTH_SOCK)
		$widget(statusagent) config -text "No Agent" -bg red -fg white
		$widget(idents) delete 0 end
	    } else {
		return
	    }
	}
	addident {
	    set fname [tk_getOpenFile -initialdir "$env(HOME)/.ssh/"]
	    if {$fname != ""} {
		
		# openssh
		if {$configs(sshver) == "OpenSSH"} {
		    set env(SSH_ASKPASS) $configs(askpassbin)
		}

		catch {exec $configs(addbin) $fname < /dev/null} err
		if [string match "Bad key file*" $err] {
		    showmessage "Bad key file" ""
		    return
		}
		set found 0
		foreach ent [$widget(idents) get 0 end] {
		    if {$ent == $fname} {
			set found 1
			break
		    }
		}
		if {! $found} {
		    $widget(idents) insert end $fname
		}
	    } else {
		return
	    }
	}
	remident {
	    if {[selection own] != $widget(idents)} {
		showmessage "No Identity selected" ""
		return
	    } else {
		catch {exec $configs(addbin) -d [$widget(idents) get active]}
		$widget(idents) delete active
		selection clear
	    }
	}
    }
}

# Adding one default connection
proc newconn {mode state} {
    global widget env sites askuserdef
    switch -exact $mode {
	def {
	    switch -exact $state {
		1 {
		    Window show .top40
		    $widget(newuser) insert 0 $env(USER)
		    grab .top40
		}
		2 {
		    set newtit [$widget(newtit) get]
		    set newaddr [$widget(newaddr) get]

		    if {$askuserdef} {
			set newuser "<ASKFORUSER>"
		    } else {
			set newuser [$widget(newuser) get]
		    }

		    if {$newtit != "" && $newaddr != ""} {
			set sites($newtit) "$newaddr#$newuser"
			
			set sitefile [open "$env(HOME)/.secpanel/sites" w]
			foreach s [array names sites] {
			    puts $sitefile "$s#$sites($s)"
			}
			close $sitefile
			
			defsiteupdate
			clear_distmenu
			
			Window destroy .top40
		    } else {
			showmessage "Please enter address and title" ""
		    }
		}
	    }
	}
	spec {
	    changetab ssh
	    clear_profiles
	}
    }
}

# Switch to edit-mode of one connection (defs and specs)
proc propconn {spec mode} {
    global widget env sites askuserdef
    switch -exact $spec {
	def {
	    switch -exact $mode {
		1 {
		    if {[$widget(defsites) index end] > 0} {
			set act [$widget(defsites) get active]
			Window show .top40
			$widget(newtit) insert 0 $act
			$widget(newaddr) insert 0 [lindex [split $sites($act) #] 0]

			set userentry [lindex [split $sites($act) #] 1]
			if {$userentry == "<ASKFORUSER>"} {
			    set askuserdef 1
			} else {
			    $widget(newuser) insert 0 $userentry
			    set askuserdef 0
			}

			.top40.fra45.but47 config -command "propconn def 2"
			grab .top40
		    } else {
			showmessage "No conncections available, please use \"New\"" ""
			return
		    }
		}
		2 {
		    unset sites([$widget(defsites) get active])
		    newconn def 2
		}
	    }
	}
	spec {
	    if {[$widget(specsites) index end] > 0} {
		changetab ssh
		load_profile connects
	    } else {
		showmessage "No conncections available, please use \"New\"" ""
		return
	    }
	}
    }
}

# return profile-file by title in spec-list
proc retprof {tit} {
    global env
    foreach f [glob -nocomplain "$env(HOME)/.secpanel/*.profile"] {
	source $f
	if {$title == $tit} {
	    return "[file rootname [file tail $f]]"
	}

	# correct lfs
	unset lfs
    }
}

# Save the configs for one profile
proc save_profile {} {
    global env widget agentforward x11forward  nopriv verbose \
	    quiet fork gateway compress algo compressval lfs rfs \
	    connwait termicon

    set prname [$widget(profileent) get]
    if {$prname == ""} {
	showmessage "Enter a name for the profile" ""
	return
    }

    set title [$widget(titleent) get]
    set host [$widget(hostent) get]
    set user [$widget(userent) get]
    set port [$widget(portent) get]
    set command [$widget(commandent) get]
    
    if {$prname == "default"} {
	if {$title != "Default Profile" || $host != "" \
		|| $user != "" || $command != ""} {
	    showmessage "You may not enter host, user or command for the \
		    default profile and you may not change the title" ""
	    return
	}
    } else {
	if {$title == "" || $host == ""} {
	    showmessage "You must enter at least host and title" ""
	    return
	}
    }
    
    set identity [$widget(identityent) get]

    set prfile [open "$env(HOME)/.secpanel/$prname.profile" w]
    
    puts $prfile "#\n# SecPanel-Pofile\n# Do not edit, use SecPanel instead\n#"
    
    foreach ent {title host user port command identity} {
	puts $prfile "set [set ent] \"[set $ent]\""
    }
    foreach bool {agentforward x11forward nopriv verbose \
	    quiet fork gateway compress connwait termicon} {
	if [info exists [set bool]] {
	    if [set $bool] {
		puts $prfile "set [set bool] \"[set $bool]\""
	    } else {
		puts $prfile "set [set bool] \"[set $bool]\""
	    }
	}
    }
    foreach sel {algo compressval} {
	puts $prfile "set [set sel] \"[set $sel]\""
    }

    if [info exists lfs] {
	puts $prfile "array set lfs {[array get lfs]}"
    } else {
	puts $prfile "array set lfs {}"
    }

    if [info exists rfs] {
	puts $prfile "array set rfs {[array get rfs]}"
    } else {
	puts $prfile "array set rfs {}"
    }

    close $prfile

    specsiteupdate    
    clear_prmenu
    clear_profiles
    clear_distmenu
}

proc seldistkey {} {
    global env widget
    set ftypes {
	{{Public keys} {.pub}}
	{{All files} *}
    }
    $widget(keydistkey) delete 0 end
    $widget(keydistkey) insert 0 \
	    [tk_getOpenFile -initialdir "$env(HOME)/.ssh"  -filetypes $ftypes]
}

# Selection of the connections Identity
proc select_ident {} {
    global env widget
    choosefile $widget(identityent) $env(HOME)/.ssh
}

# Show one manual page
proc showman {man} {
    global configs
    exec $configs(xtermbin) -e man $man &
}

# Update the List of Special-connects
proc specsiteupdate {} {
    global widget env
    $widget(specsites) delete 0 end
    set profiles [glob -nocomplain "$env(HOME)/.secpanel/*.profile"]
    foreach prof [lsort $profiles] {
	if {[file rootname [file tail $prof]] == "default"} {
	    continue
	}
	source $prof
	$widget(specsites) insert end $title

	# correct lfs
	unset lfs
    }
}

proc about {} {
    global libdir
    Window show .top25
}

# with single click in connect-lists show some data about profile
proc showstatus {text} {
    global widget
    $widget(status) config -text $text
    update idletasks
}

proc do_firstinit {} {
    global libdir

    showmessage "You are a first time user of Ver. 0.30.\nWe go to configuration..." .top17
    changetab terminal
}

proc main {argc argv} {
    global widget sites env configs libdir
    clear_prmenu
    clear_profiles
    defsiteupdate
    specsiteupdate
    clear_distmenu
    foreach f {ssh keygen agent add askpass scp xterm} {
	$widget([set f]ent) insert 0 "$configs([set f]bin)"
    }
    foreach b {connects scp keys profiles configs} {
	$widget([set b]but) config -image \
		[image create photo -file $libdir/images/[set b].gif]
    }

    # Init for the first usage of secpanel
    if {! [file exists "$env(HOME)/.secpanel/.init"]} {
	do_firstinit
	exec echo "0.30" > $env(HOME)/.secpanel/.init
    }

    # Launching the SSH-Agent
}

source $libdir/gui.tcl
main $argc $argv
