script/isdnmanager
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
master
isdnmanager/isdnmanage_30.tcl
Christoph 9fb59b3489 Initial import
2017-02-21 02:30:30 +01:00

1777 lines
44 KiB
Tcl
Executable File
Raw Permalink Blame History

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
set serverdown 0
set lang "de"
set sshUser "dial"
set remoteProg "/home/$sshUser/bin/ipppctrl.sh"
set setProviderProg "sudo /home/$sshUser/bin/setProvider.sh"
set getProviderProg "sudo /home/$sshUser/bin/getProvider.sh"
if { [string first Windows $tcl_platform(os) ] > -1 } {
if { [ catch { set configFile $env(ISDNCONFIG)\\isdnmanage.conf } err ] } {
set configFile isdnmanage.conf
}
#tk_messageBox -icon error -type ok \
# -title "ISDN Conection Error" \
# -parent . -message "config file : $configFile\t\n"
} else {
set configFile $env(HOME)/.isdnmanage
}
if { ! [ file readable $configFile ] } {
tk_messageBox -icon error -type ok \
-title "ISDN Conection Error" \
-parent . -message "\nCan't find readable file: $configFile\t\n"
exit
} else {
if { [ catch {source $configFile } err ] } {
tk_messageBox -icon error -type ok \
-title "ISDN Conection Error" \
-parent . -message "\n$err\t\n"
exit
}
}
if { $lang == "de" } {
set l_title "ISDN Verbindungsmanager"
set l_channel_a "A Kanal:"
set l_channel_b "B Kanal:"
set l_connection "Verbindung:"
set l_onlineTime "verbunden seit:"
set l_hangupTime "autm. Auflegen in:"
set l_traffic "Auslastung - besteh.Verbindung"
set l_ibytes "Rein"
set l_obytes "Raus"
set l_speed "Geschw.:"
set l_settings "Einstellungen"
set l_timeout "Auflegen nach Leerlaufzeit"
set l_useOfChannel_B "B Kanal Nutzung"
set l_dialmode "Wählmodus"
set l_enable "aktiviere"
set l_disable "deaktiviere"
set l_seconds "Sekunden"
set l_sec "Sek."
set l_now "derzeit:"
set l_manual "manuell"
set l_auto "automatisch"
set v_online "verbunden"
set v_down "getrennt"
set v_always_on "immer an"
set v_enabled "aktiv"
set v_disabled "inaktiv"
set v_initializing "Initialisiere ..."
set v_manual "manuell"
set v_auto "automatisch"
set b_dialin "Wählen"
set b_hangup "Auflegen"
set b_options "Optionen..."
set b_exit "Beenden"
set b_shutdown "ISDN-Server Abschalten"
set b_dial_auto "autom. Wahlwiederholung"
set b_stop_dial "Wahlwiederholung stoppen"
set m_wait "Bitte warten ..."
set m_getProvider "Provider geholt"
set m_noISDN "ISDN System nicht geladen"
set m_noDialoutDevice "Dialuotgerät ( ippp<n> ) nicht vorhanden"
set m_noISDNControl "Kein ISDN Cotrolsystem (isdnctrl) gefunden"
set m_noConnection "Keine Verbindung zum Server"
set m_lostConnection "Verbindung zum Server verloren"
set m_try_again "Versuche Verbindung wieder herzustellen .."
set m_dial_again "Bitte neu wählen wenn die neue Verbindung besteht !"
set m_noSSH "SSH-Verbindung fehlgeschlagen"
set m_trySSH "SSH-Verbindung herstellen ..."
set m_lostSSH "SSH-Verbindung unterbrochen"
set m_noPing "( ping fehlgeschlagen )"
set m_unknownError "unbekannter Fehler"
set m_unknownError_long "Trotz korrekter Verbindung liefert der Server keine Ergebnisse\t\nMögliche Ursachen sind:\n\n"
append m_unknownError_long " - das mit der Anwendung korrespondierende Programm \"$remoteProg\" existiert nicht\t\n\n"
append m_unknownError_long " - das mit der Anwendung korrespondierende Programm \"$remoteProg\" ist nicht ausführbar\n"
append m_unknownError_long " ( rwxr-x-r-x = 755 z.Bsp. wäre in Ordnung )\n\n"
append m_unknownError_long " - ??\n\n"
append m_unknownError_long "$m_unknownError\n"
set m_shutdownOK "\nDrücke \"OK\" um den Server auszuschalten\t\n\n"
set m_shutdownWarning_1 "!!! W A R N U N G !!!\n\nEs sind derzeit "
set m_shutdownWarning_2 " Login-Prozesse aktiv. Das heißt der ISDN Server ist noch\t\
\nvon anderen Benutzern in Gebrauch. ( Vielleich ja auch mehrmals von dir selber )\t\t\n"
set m_shutdown "Fahre ISDN-Server runter"
set m_dial_auto "autom. Wählen ..."
set m_stop_dial "stop autom. Wählen ..."
set l_opt_title "ISDN Einstellungen"
set l_opt_timeout "Auszeit ?!"
} else {
set l_title "ISDN Control Panel"
set l_channel_a "Channel A:"
set l_channel_b "Channel B:"
set l_connection "Connection:"
set l_onlineTime "Online Time:"
set l_hangupTime "Estimated Hangup Time:"
set l_traffic "Traffic of the current connection"
set l_ibytes "In"
set l_obytes "Out"
set l_speed "Speed:"
set l_settings "Settings"
set l_timeout "Idle time until hangup:"
set l_useOfChannel_B "Use of Channel B"
set l_dialmode "Dialmode"
set l_enable "enable"
set l_disable "disable"
set l_seconds "Seconds"
set l_sec "Sec."
set l_now "derzeit:"
set l_manual "Set to manual"
set l_auto "Set to auto"
set v_online "online"
set v_down "down"
set v_always_on "always on"
set v_enabled "enabled"
set v_disabled "disabled"
set v_initializing "Initializing ..."
set v_manual "manual"
set v_auto "auto"
set b_dialin "Dial in"
set b_hangup "Hangup"
set b_options "Options..."
set b_exit "Exit"
set b_shutdown "Shutdown ISDN Server"
set b_dial_auto "automatic redialing"
set b_stop_dial "stopping redialing"
set m_wait "Getting Providers ..."
set m_getProvider "Providers in"
set m_noISDN "ISDN Subsystem not loaded"
set m_noDialoutDevice "There is no device for dialout"
set m_noISDNControl "ISDN Cotrolsystem (isdnctrl) not found"
set m_noConnection "Destination Host Unreachable"
set m_lostConnection "Lost Connection to ISDN Server"
set m_try_again "I will try connecting again"
set m_dial_again "Please dial again if a new connection is established !"
set m_trySSH "try to establish SSH connection ..."
set m_noSSH "SSH Connection failed"
set m_lostSSH "Lost SSH Connection"
set m_noPing "( ping failed )"
set m_unknownError "Unknown Error"
set m_unknownError_long "I think there is something wrong. Possible errors are:\n\n"
append m_unknownError_long " - the corresponding script on the server \"$remoteProg\" does not exist\n\n"
append m_unknownError_long " - the corresponding script on the server \"$remoteProg\" is not executable\n"
append m_unknownError_long " ( i.e. rwxr-x-r-x = 755 works fine )\n\n"
append m_unknownError_long " - ??\n\n"
append m_unknownError_long "Unknown error\n"
set m_shutdownOK "\nType \"OK\" to shutdown the ISDN server immediately\t\n\n"
set m_shutdownWarning_1 "!!! W A R N I N G !!!\n\nI recognized "
set m_shutdownWarning_2 " login processes. That means there are others, who\t\n\
uses the ISDN Server at time. ( Maybe you logged in several times )\t\t\n"
set m_shutdown "Shutting down ISDN Server ..."
set m_dial_auto "dialing ..."
set m_stop_dial "stop dialing"
set l_opt_title "ISDN Settings"
set l_opt_timeout "Timeout:"
}
proc destroyWindow { window} {
global fid
catch { puts $fid "killall dial_autm.sh;" }
after 1000
catch { puts $fid "exit;" }
after 1000
destroy $window
}
wm title . "ISDN Control Panel"
wm iconname . "ISDN Control Panel"
wm resizable . 0 0
wm protocol . WM_DELETE_WINDOW { destroyWindow . }
wm withdraw .
#raise .
#focus -force .
# this will show a liitle window while initializing
# the application
#
#set top [ toplevel .initializing ]
#
#wm withdraw $top
#wm overrideredirect $top 1
#
#wm geometry $top +400+300
#
#label .initializing.message -text "\n\t Initializing ISDN Control Panel ...\t\n"
#pack .initializing.message
#wm deiconify $top
#focus -force $top
#update
#
#after 200
if { [string first Windows $tcl_platform(os) ] > -1 } {
set font "-font"
set fontTitle {"MS Sans Serif" 10 bold}
set fontHeadline {"MS Sans Serif" 8 bold}
} else {
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# sorry, no better idea
#
set font "-fg"
set fontTitle "black"
set fontHeadline "black"
}
# Title
#
label .title -pady 2 -fg black -text $l_title $font $fontTitle
pack .title -side top -pady 4
# Status line with actual doing messages and also
# error messages on the bottom of the toplevel window
#
frame .statusline
pack .statusline -side bottom -anchor w
label .statusline.action \
-padx 1m \
-textvariable action \
-width 17 \
-relief sunken \
-takefocus 0 \
-bd 3 \
-anchor w
label .statusline.msg \
-padx 1m \
-fg #BF0000 \
-textvariable msg \
-width 32 \
-relief groove \
-bd 3 \
-anchor w
pack .statusline.action .statusline.msg \
-side left \
-anchor w \
-expand 1 \
-fill x
##############################
# #
# only for testing #
# #
##############################
#set test ""
#label .statusline.test1 \
# -padx 1m \
# -fg #BF0000 \
# -textvariable test \
# -width 49 \
# -relief groove \
# -bd 3 \
# -anchor w
#pack .statusline.test1 -side top
#
##############################
proc initParam {level} {
global channel_B \
curtimeout \
dialmode \
status status_B \
ibytes obytes \
hangup \
intime \
speed \
curprovider \
providers \
serverdown
set channel_B "...?. .."
set curtimeout "...? ..."
set dialmode "...? ..."
set status "...? ..."
set status_B "...? ..."
set ibytes "...?..."
set obytes "...?..."
set hangup "...?..."
set intime "...?..."
set speed "...?..."
set curprovider "...?..."
set providers ""
if { $level > 0 } {
setInactive ".main.right.buttons.hangup"
setInactive ".main.right.buttons.dial"
setInactive ".main.right.buttons.options"
if { $level > 1 } {
setInactive ".shutdown"
} else {
if { $serverdown == 1 } {
setActive ".shutdown"
}
}
}
}
initParam 0
# Variables for controlling the connection
#
set isdn_channel_B ""
set isdn_dialmode ""
set isdn_timeout ""
set timeout ""
set old_timeout ""
set timeout_times {60 120 180 240 300 600}
frame .main -borderwidth 2
pack .main -anchor w
frame .main.left
frame .main.left.status -borderwidth 2
frame .main.left.status.channel_A
label .main.left.status.channel_A.text \
-text $l_channel_a \
-anchor w \
-width 10
label .main.left.status.channel_A.curval \
-textvariable status \
-width 10 \
-anchor w \
-fg "#BF0000"
pack .main.left.status.channel_A.text \
.main.left.status.channel_A.curval \
-side left
pack .main.left.status.channel_A -side top -anchor w
frame .main.left.status.channel_B
label .main.left.status.channel_B.text \
-text $l_channel_b \
-anchor w \
-width 10
label .main.left.status.channel_B.curval \
-textvariable status_B \
-anchor w \
-width 10 \
-fg "#BF0000"
pack .main.left.status.channel_B.text \
.main.left.status.channel_B.curval \
-side left
pack .main.left.status.channel_B -side top -anchor w
pack .main.left.status -side top -anchor w -padx 5 -pady 5
frame .main.left.traffic -borderwidth 2
label .main.left.traffic.headline \
-text $l_connection\
$font $fontHeadline
canvas .main.left.traffic.space -height 2 -width 1
pack .main.left.traffic.headline \
.main.left.traffic.space \
-anchor w
frame .main.left.traffic.onlineTime
label .main.left.traffic.onlineTime.text \
-text $l_onlineTime -anchor w
label .main.left.traffic.onlineTime.curval \
-textvariable intime -width 8 -anchor e
pack .main.left.traffic.onlineTime.text \
.main.left.traffic.onlineTime.curval \
-side left -expand 1 -fill x
pack .main.left.traffic.onlineTime -anchor w -padx 10 -fill x
frame .main.left.traffic.hangupTime
label .main.left.traffic.hangupTime.text \
-text $l_hangupTime -width 20 -anchor w
label .main.left.traffic.hangupTime.curval \
-textvariable hangup -width 8 -anchor e
pack .main.left.traffic.hangupTime.text \
.main.left.traffic.hangupTime.curval \
-side left -expand 1 -fill x
pack .main.left.traffic.hangupTime -anchor w -padx 10 -fill x
canvas .main.left.traffic.space_01 -height 2 -width 1
pack .main.left.traffic.space_01 -anchor w
frame .main.left.traffic.bytes -borderwidth 2 -relief flat -bg white
label .main.left.traffic.bytes.text \
-text $l_traffic -bg white
pack .main.left.traffic.bytes.text -anchor w -padx 10 -fill x
frame .main.left.traffic.bytes.in -bg white
label .main.left.traffic.bytes.in.text \
-text $l_ibytes -width 8 -anchor w -bg white
label .main.left.traffic.bytes.in.bytes \
-textvariable ibytes -width 10 -anchor e -bg white
label .main.left.traffic.bytes.in.unit \
-text "Bytes" -anchor w -bg white
pack .main.left.traffic.bytes.in.text \
.main.left.traffic.bytes.in.bytes \
.main.left.traffic.bytes.in.unit \
-side left
pack .main.left.traffic.bytes.in
frame .main.left.traffic.bytes.out
label .main.left.traffic.bytes.out.text \
-text $l_obytes -width 8 -anchor w -bg white
label .main.left.traffic.bytes.out.bytes \
-textvariable obytes -width 10 -anchor e -bg white
label .main.left.traffic.bytes.out.unit \
-text "Bytes" -anchor w -bg white
pack .main.left.traffic.bytes.out.text \
.main.left.traffic.bytes.out.bytes \
.main.left.traffic.bytes.out.unit \
-side left
pack .main.left.traffic.bytes.out
frame .main.left.traffic.bytes.speed
label .main.left.traffic.bytes.speed.text \
-text $l_speed -width 8 -anchor w -bg white
label .main.left.traffic.bytes.speed.bytes \
-textvariable speed -width 10 -anchor e -bg white
label .main.left.traffic.bytes.speed.unit \
-text "kb/s" -anchor w -bg white
pack .main.left.traffic.bytes.speed.text \
.main.left.traffic.bytes.speed.bytes \
.main.left.traffic.bytes.speed.unit \
-side left
pack .main.left.traffic.bytes.speed
pack .main.left.traffic.bytes
canvas .main.left.traffic.space_02 -height 2 -width 1
pack .main.left.traffic.space_02 -anchor w
pack .main.left.traffic -side top -anchor w -padx 5 -pady 5
frame .main.right -borderwidth 2
frame .main.right.buttons
button .main.right.buttons.dial \
-text $b_dialin \
-command { setConnection -d dialing } \
-width 10 \
-state disabled
pack .main.right.buttons.dial -fill x -pady 11
button .main.right.buttons.hangup \
-text $b_hangup \
-command { setConnection -h hangup } \
-width 10 \
-state disabled
pack .main.right.buttons.hangup
button .main.right.buttons.options \
-text $b_options \
-command { showOptions} \
-width 10 \
-state disabled
pack .main.right.buttons.options -pady 30
pack .main.right.buttons -padx 10
pack .main.left -side left -anchor nw
pack .main.right -side right -anchor ne
bind .main.right.buttons.dial <KeyPress-Return> { setConnection -d dialing }
bind .main.right.buttons.hangup <KeyPress-Return> { setConnection -h hangup }
bind .main.right.buttons.options <KeyPress-Return> { showOptions}
focus .main.right.buttons.dial
frame .settings -borderwidth 1
label .settings.headline \
-text $l_settings \
$font $fontHeadline
canvas .settings.space -height 2 -width 1
pack .settings.headline .settings.space -anchor w
frame .settings.timeout
label .settings.timeout.text \
-text $l_timeout -anchor w -width 22
label .settings.timeout.curval \
-textvariable curtimeout -width 8 -anchor e
pack .settings.timeout.text \
.settings.timeout.curval \
-side left -expand 1 -fill x
pack .settings.timeout -anchor w -padx 10 -fill x
frame .settings.channel_B
label .settings.channel_B.text \
-text $l_useOfChannel_B -anchor w -width 22
label .settings.channel_B.curval \
-textvariable channel_B -width 8 -anchor e
pack .settings.channel_B.text \
.settings.channel_B.curval \
-side left -expand 1 -fill x
pack .settings.channel_B -anchor w -padx 10 -fill x
frame .settings.dialmode
label .settings.dialmode.text \
-text $l_dialmode -anchor w -width 20
label .settings.dialmode.curval \
-textvariable dialmode -width 10 -anchor e
pack .settings.dialmode.text \
.settings.dialmode.curval \
-side left -expand 1 -fill x
pack .settings.dialmode -anchor w -padx 10 -fill x
canvas .settings.space_01 -height 2 -width 1
pack .settings.space_01 -anchor w
pack .settings -anchor w -padx 5 -side top
frame .line -borderwidth 2 -relief groove -height 2
pack .line -side top -fill x -padx 13
button .exit -text "Exit" \
-command { destroyWindow . } \
-width 10
pack .exit -side right -pady 5 -anchor e -padx 13
button .shutdown -text $b_shutdown \
-command { shutdown } -width 20 \
-state disabled
pack .exit .shutdown -pady 5 -anchor w -padx 13
frame .line2 -borderwidth 2 -relief groove -height 2
pack .line2 -side top -fill x -padx 13
#button .stop_dialing -text "Wählen unterbrechen" \
# -command { stopDialing } \
# -width 10
#pack .stop_dialing -side right -pady 5 -anchor e -padx 13
button .dial_autom -text $b_dial_auto \
-command { dialAuto } -width 20
# -state disabled
#pack .dial_autom .stop_dialing -pady 5 -anchor w -padx 13
pack .dial_autom -pady 5 -anchor w -padx 13
bind .exit <KeyPress-Return> {destroyWindow .}
bind .shutdown <KeyPress-Return> { shutdown }
bind .dial_autom <KeyPress-Return> { dialAuto }
# bind .stop_dialing <KeyPress-Return> { stopDialing }
set msg ""
set action ""
# warten auf die ssh Anmeldung
#
# Bem: sollte die antwortzeit des ssh-servers kürzer sein als
# der wert dieser variable, so muß diese hochgesetzt werden. die
# ssh-anmeldung liefert dann noch keinen fehler und es wird "normal"
# weiterverfahren. allerdings taucht dann später (proc resdPipe) ein
# fehler auf. dort wird in diesem falle die variable hochgesetzt
#
set init_ssh_wait 1000
set max_ssh_wait 10000
set ssh_wait $init_ssh_wait
set geholt false
proc init {} {
global msg action manual wait count fatalError halt shutdown ssh_wait geholt
global halt_1 halt_2
global m_noConnection m_noSSH
if { [ checkConnection $m_noConnection] } {
after 3000 init
return
}
global sshProg sshUser sshKey isdnServer remoteProg status status_B fid
set action "Connecting .."
catch { close $fid }
set fid [ securePipe $sshProg $sshUser $isdnServer $sshKey ]
set action ""
if [ regexp {Error} $fid ] {
set action $ssh_wait
if { $halt == 0 } {
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "$fid \n\n$m_noSSH\t\n\n"]
switch -- $answer {
cancel { set halt 1 }
retry ;
}
}
setWidgetColor .statusline.msg #BF0000
set msg "$m_noSSH"
catch { close $fid }
after 3000 init
return
}
set geholt false
getProvider
while { $geholt == "false" } {
after 50
update
}
set manual 0
set wait 0
set count 0
set fatalError 0
set shutdown 0
after 50 controlConnection 2000
return
}
global dialPipe
proc dialAuto {} {
global m_dial_auto b_stop_dial dialPipe action sshProg sshKey sshUser isdnServer msg status test
setInactive ".dial_autom"
setWidgetText .dial_autom $b_stop_dial
update
set dialPipe [ securePipe $sshProg $sshUser $isdnServer $sshKey ]
catch { puts $dialPipe "/home/dial/bin/dial_autm.sh" }
setWidgetCommand .dial_autom "stopDialing"
setActive ".dial_autom"
set msg $m_dial_auto
return
}
proc stopDialing {} {
global m_stop_dial b_dial_auto dialPipe action sshProg sshKey sshUser isdnServer msg status test
setInactive ".dial_autom"
setWidgetText .dial_autom $b_dial_auto
update
catch [ exec $sshProg -i $sshKey -l $sshUser $isdnServer /home/dial/bin/stop_dialing.sh ]
catch { close $dialPipe }
setWidgetCommand .dial_autom "dialAuto"
setActive ".dial_autom"
set msg $m_stop_dial
return
}
proc checkAutoDialing {} {
global msg sshProg sshKey sshUser isdnServer test fid
catch { exec $sshProg -i $sshKey -l $sshUser $isdnServer ps ax | grep -e "/home/dial/bin/dial_autm.sh" | grep -c -v grep } rval
## set msg "rval = $rval"
## after 2000
return $rval
}
proc checkConnection { errmsg } {
global pingFlag pingProg pingArg isdnServer msg action halt
global halt_1 halt_2
global m_noPing
set action "Connecting .."
if { [ catch { exec $pingProg $pingFlag $pingArg $isdnServer } error] } {
set action ""
setWidgetColor .statusline.msg #BF0000
set msg $errmsg
initParam 2
if { $halt } {
return 1
}
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "$errmsg\t\n\n$m_noPing\n" ]
switch -- $answer {
cancel { set halt 1 }
retry ;
}
return 1
}
# Windows ping command ends normally even if there was no response.
# so we have to check the return message from the ping command
#
if [ regexp {Empfangen\ =\ 0} $error ] {
set action ""
setWidgetColor .statusline.msg #BF0000
set msg $errmsg
initParam 2
if { $halt } {
return 1
}
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "$errmsg\t\n\n$m_noPing\n" ]
switch -- $answer {
cancel { set halt 1 }
retry ;
}
set msg $errmsg
initParam 2
return 1
}
set action ""
#set halt 0
return 0
}
proc securePipe { ssh user host key} {
global ssh_wait
if { [ catch {
set fid [ open "|$ssh -i $key ${user}@$host" a+ ]
fconfigure $fid -blocking off
fconfigure $fid -buffering full
;## let ssh settle...
after $ssh_wait
set junk [ read $fid ]
;## now make sure we got authenticated (this will throw
;## a "broken pipe" exception if auth failed).
puts $fid hostname; ; flush $fid ; set junk [read $fid]
flush $fid
after 1000
fconfigure $fid -buffering full
set junk [ read $fid ]
fconfigure $fid -blocking off
fconfigure $fid -buffering line
# fileevent $fid readable [list readPipe $fid]
} err ] } {
catch { close $fid }
return "Error:\n\n $err"
}
return $fid
}
# Pfeiffe stopfen
#
proc writePipe { pipe command } {
global wait
if { $wait == 3 } {
return
}
if { [ catch { puts $pipe "${command};" } err ] } {
catch {close $pipe}
}
catch {flush $pipe}
return $err
}
proc readPipe { pipe } {
global action \
msg \
isdn_channel_B \
isdn_dialmode \
isdn_timeout \
status \
manual \
wait \
count \
fatalError \
halt_1 \
halt_2 \
halt \
shutdown \
m_noISDN \
m_noDialoutDevice \
m_noISDNControl \
m_trySSH
if { $manual == 1 } {
return
}
if { $wait > 1 || $shutdown == 1 } {
catch { read $pipe }
return
}
set wait 2
if { [ catch { read -nonewline $pipe } rvalue ] } {
catch {close $pipe}
set fatalError 1
return
}
set isdn_channel_B ""
set isdn_dialmode ""
set isdn_timeout ""
set action ""
set count 0
if { [ regexp {m_no} $rvalue ] } {
# substitute a newline char "\n" and write
# down the hole error message in one line
#
set errmsg [ set [ lindex $rvalue 0 ] ]
if { $halt_2 == 0 } {
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "Fehler:\n\n$errmsg\t\n" ]
switch -- $answer {
retry ;
cancel { set halt_2 1; set halt 1 }
}
}
setWidgetColor .statusline.msg #BF0000
regsub \n $errmsg " - " msg
# I don't know the real values of the connection. So
# i will reset them to initial (unknown) values
#
initParam 1
set fatalError 1
set wait 3
return
}
set wait 1
global status \
status_B \
channel_B \
timeout \
ibytes \
obytes \
hangup \
intime \
dialmode \
speed \
timeout_unit \
dialmode \
curtimeout \
curprovider
global v_online \
v_down \
v_enabled \
v_disabled \
v_always_on \
l_sec \
v_manual \
v_auto \
ssh_wait \
init_ssh_wait \
max_ssh_wait \
b_stop_dial \
b_dial_auto \
m_dial_auto
# steht in "$rvalue" nichts drin, so kann das auch an einer noch
# nicht etablierten ssh-verbindung liegen. also nochmals probieren
# und ein bischen länger "ssh_wait" auf den response des ssh-servers
# warten.
#
if [ catch { set status [ set [lindex $rvalue 0] ] } err ] {
catch { flush $pipe }
catch { read $pipe }
catch { close $pipe }
set msg $m_trySSH
set action $ssh_wait
if { $halt == 0 } {
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "$err \n\n$m_trySSH\t\n\n"]
switch -- $answer {
cancel { set halt 1 }
retry ;
}
}
# erneut versuchen
#
if { $ssh_wait < $max_ssh_wait } {
incr ssh_wait 1000
} else {
# dann liegst wohl an was anderem
#
set ssh_wait $init_ssh_wait
}
set fatalError 1
return
}
set ssh_wait $init_ssh_wait
set halt 0
catch { checkAutoDialing } autodial
if { $autodial != 1 } {
set msg $status
}
## set msg "hallo $autodial"
## after 3000
if { $v_online == $status } {
setInactive ".main.right.buttons.dial"
if { $autodial != 1 } {
setWidgetColor .statusline.msg #008800
setWidgetColor .main.left.status.channel_A.curval #008800
setActive ".main.right.buttons.hangup"
setInactive ".dial_autom"
} else {
setInactive ".main.right.buttons.hangup"
setInactive ".main.right.buttons.options"
setWidgetText .dial_autom $b_stop_dial
setWidgetCommand .dial_autom "stopDialing"
setActive ".dial_autom"
setWidgetColor .statusline.msg #252D97
setWidgetColor .main.left.status.channel_A.curval #BF0000
}
} else {
setInactive ".main.right.buttons.hangup"
if { $autodial != 1 } {
setWidgetColor .statusline.msg #BF0000
setWidgetColor .main.left.status.channel_A.curval #BF0000
setActive ".main.right.buttons.dial"
setWidgetText .dial_autom $b_dial_auto
setWidgetCommand .dial_autom "dialAuto"
} else {
setInactive ".main.right.buttons.dial"
setInactive ".main.right.buttons.options"
setWidgetText .dial_autom $b_stop_dial
setWidgetCommand .dial_autom "stopDialing"
setWidgetColor .statusline.msg #252D97
setWidgetColor .main.left.status.channel_A.curval #BF0000
}
setActive ".dial_autom"
}
set status_B [ set [lindex $rvalue 1] ]
if { $v_online == $status_B } {
setWidgetColor .main.left.status.channel_B.curval #008800
} else {
setWidgetColor .main.left.status.channel_B.curval #BF0000
}
set channel_B [set [ lindex $rvalue 2 ] ]
set timeout [lindex $rvalue 3]
set ibytes [lindex $rvalue 4]
set obytes [lindex $rvalue 5]
if { "v_always_on" == [lindex $rvalue 6] } {
set hangup $v_always_on
} else {
set hangup [list [lindex $rvalue 6] $l_sec ]
}
set intime [list [lindex $rvalue 7] $l_sec ]
set dialmode [ expr { ( [ lindex $rvalue 8 ] == "manual" ) ? $v_manual : $v_auto } ]
set tmp_value_0 [lindex $rvalue 9]
if { $tmp_value_0 > 0 } {
set tmp_value [ expr { int ( 100 * [lindex $rvalue 9] / 1024.0 ) } ]
set speed [ expr { $tmp_value / 100.0 } ]
} else {
set speed 0
}
# if { $curprovider != [ lindex $rvalue 10 ] } { update }
set curprovider [ lindex $rvalue 10 ]
set action $curprovider
catch { wm state .options } err
if [ string match bad* $err ] {
if { $timeout != "v_disabled" } {
set curtimeout "$timeout $l_sec"
} else {
set curtimeout $v_disabled
}
} else {
initOptions
}
if { $autodial != 1 } {
setActive ".main.right.buttons.options"
}
global serverdown
if { $serverdown == 1 } {
setActive ".shutdown"
}
set halt_1 0
set halt_2 0
set wait 0
}
proc setNormal { widget } {
$widget configure -state normal
}
proc setActive { widget } {
$widget configure -state activ
}
proc setInactive { widget } {
$widget configure -state disabled
}
proc setWidgetColor { widget color } {
$widget configure -fg $color
}
proc setWidgetCommand { widget command } {
$widget configure -command $command
}
proc setWidgetText { widget text } {
$widget configure -text $text
}
proc setProvider { prov } {
global fid setProviderProg providers msg status manual wait
global m_lostConnection m_try_again m_dial_again
set manual 1
set err [ writePipe $fid "$setProviderProg $prov" ]
if { $err != "" } {
set wait 1
setWidgetColor .statusline.msg #BF0000
set msg $m_lostConnection
tk_messageBox -icon error -type ok \
-title "ISDN Conection Error" \
-parent . -message "Dialing failed\n\n$err \n \
\n$m_lostConnection\n
\n$m_try_again \
\n$m_dial_again\n"
initParam 2
#after 1000 init
return
}
catch { read -nonewline $fid }
set manual 0
}
proc getProvider {} {
global fid getProviderProg providers msg status manual wait action
global m_lostConnection m_try_again m_dial_again m_wait
set manual 1
set test "!!! hole Provider !!!"
fileevent $fid readable [list readProvider $fid]
set err [ writePipe $fid "$getProviderProg" ]
if { $err != "" } {
set wait 1
setWidgetColor .statusline.msg #BF0000
set msg $m_lostConnection
tk_messageBox -icon error -type ok \
-title "ISDN Conection Error" \
-parent . -message "Dialing failed\n\n$err \n \
\n$m_lostConnection\n
\n$m_try_again \
\n$m_dial_again\n"
initParam 2
#after 1000 init
return
}
set action $m_wait
}
proc readProvider { fid } {
global providers geholt action m_getProvider
if { [ catch { read -nonewline $fid } providers ] } {
catch {close $fid}
return
}
set geholt true
set action $m_getProvider
return
}
proc setConnection { isdn_opt message } {
global fid remoteProg msg status manual wait
global m_lostConnection m_try_again m_dial_again
set manual 1
set err [ writePipe $fid "$remoteProg $isdn_opt" ]
if { $err != "" } {
set wait 1
setWidgetColor .statusline.msg #BF0000
set msg $m_lostConnection
tk_messageBox -icon error -type ok \
-title "ISDN Conection Error" \
-parent . -message "Dialing failed\n\n$err \n \
\n$m_lostConnection\n
\n$m_try_again \
\n$m_dial_again\n"
initParam 2
#after 1000 init
return
}
set status "${message}..."
catch { checkAutoDialing } autodial
if { $autodial != 1 } {
set msg $status
}
setWidgetColor .statusline.msg #252D97
setWidgetColor .main.left.status.channel_A.curval #252D97
catch { read -nonewline $fid }
set manual 0
}
proc controlConnection {intervall} {
global fid remoteProg isdn_timeout isdn_dialmode isdn_channel_B wait count fatalError action msg halt halt_1 shutdown
global halt_2
global m_lostConnection m_unknownError m_unknownError_long
if { $fatalError == 1 } {
init
return
}
if { $shutdown != 1 } {
if { $wait > 0 } {
after $intervall controlConnection $intervall
return
}
set wait 1
} else {
after 15000 { catch { close $fid } ; init }
return
}
fileevent $fid readable [list readPipe $fid]
set err [ writePipe $fid \
"$remoteProg \
$isdn_timeout \
$isdn_dialmode \
$isdn_channel_B" ]
if { $err != "" } {
initParam 2
#catch { wm state .options } err
#if [ string match *normal* $err ] {
# catch { destroy .options }
#}
if { [ checkConnection $m_lostConnection ] } {
catch { close $fid }
after 1000 init
return
}
set msg $m_lostConnection
setWidgetColor .statusline.msg #BF0000
if { $halt == 0 } {
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message "$err \n\n$msg\t\n\nNa ja" ]
switch -- $answer {
cancel { set halt 1 }
retry ;
}
}
after 1000 init
return
}
if { $count > 14 } {
set wait 2
initParam 2
set action ""
catch { wm state .options } err
if [ string match *normal* $err ] {
catch { destroy .options }
}
if { [ checkConnection $m_lostConnection ] } {
catch { close $fid }
after 1000 init
return
}
setWidgetColor .statusline.msg #BF0000
set msg $m_unknownError
if { $halt_1 == 0 } {
set answer [tk_messageBox -icon error -type retrycancel \
-title "ISDN Conection Error" \
-parent . -message $m_unknownError_long ]
switch -- $answer {
cancel { set halt_1 1 ; set halt 1 }
retry ;
}
}
set wait 0
initParam 1
set count 0
after 200 controlConnection $intervall
return
}
set wait 0
incr count
after $intervall controlConnection $intervall
return
}
proc initOptions {} {
global timeout_times \
old_timeout \
timeout \
curtimeout \
dialmode \
channel_B \
wait \
status
global l_sec \
v_disabled \
l_manual \
l_auto \
v_enabled \
v_manual \
v_online
foreach i $timeout_times {
if { $i == $old_timeout } {
setNormal ".options.control.timeout.s$old_timeout"
}
if { $i == $timeout } {
setInactive ".options.control.timeout.s$timeout"
}
}
set old_timeout $timeout
if { $timeout != "v_disabled" } {
set curtimeout "$timeout $l_sec"
setNormal ".options.control.timeout.sdisabled"
} else {
set curtimeout $v_disabled
setInactive ".options.control.timeout.sdisabled"
}
if { $status == $v_online } {
setInactive ".options.provider.select"
} else {
setActive ".options.provider.select"
}
if {$dialmode == $v_manual} {
set $dialmode $l_manual
setInactive ".options.control.dialmode.manual"
setNormal ".options.control.dialmode.auto"
} else {
set $dialmode $l_auto
setNormal ".options.control.dialmode.manual"
setInactive ".options.control.dialmode.auto"
}
if { $channel_B == $v_enabled } {
.options.control.channel_B.enable configure -state disabled
.options.control.channel_B.disable configure -state normal
} else {
.options.control.channel_B.enable configure -state normal
.options.control.channel_B.disable configure -state disabled
}
set wait 0
return
}
proc showOptions {} {
global timeout \
timeout_times \
isdn_timeout \
channel_B \
old_timeout \
dialmode \
msg \
font \
fontTitle \
fontHeadline
global l_opt_title \
l_opt_timeout \
l_disable \
l_seconds \
l_useOfChannel_B \
v_enabled \
v_disabled \
l_dialmode \
l_manual \
l_auto \
curprovider\
providers
set position [ wm geometry . ]
set firstIndex [string first + $position]
set secondIndex [string last + $position]
set y [ expr [string range $position [expr $secondIndex + 1] end] +20 ]
set x [ expr [string range $position [expr $firstIndex + 1] [expr $secondIndex - 1] ] +20 ]
catch { toplevel .options }
wm transient .options .
wm title .options "ISDN Settings"
wm geometry .options +${x}+${y}
#focus -force .options
# Title
#
label .options.title \
-pady 2 -fg black -text $l_opt_title $font $fontTitle
pack .options.title -side top -pady 4
frame .options.control -borderwidth 2
pack .options.control -padx 2 -pady 5
frame .options.control.timeout -relief groove -borderwidth 2
pack .options.control.timeout -side left -pady 2 -padx 5
frame .options.control.timeout.current
pack .options.control.timeout.current -side top
label .options.control.timeout.current.headline \
-text $l_opt_timeout $font $fontHeadline
canvas .options.control.timeout.current.space \
-height 2 -width 1
pack .options.control.timeout.current.headline \
.options.control.timeout.current.space \
-anchor nw -side top
label .options.control.timeout.current.text -text "now :"
label .options.control.timeout.current.curval \
-textvariable curtimeout -width 13 -anchor w -fg "#BF0000"
pack .options.control.timeout.current.text \
.options.control.timeout.current.curval \
-side left -anchor w
foreach i $timeout_times {
radiobutton .options.control.timeout.s$i \
-text "$i $l_seconds" \
-variable isdn_timeout \
-value "-t $i" \
-relief flat \
-anchor w
pack .options.control.timeout.s$i \
-side top -anchor w -pady 0 -fill x -anchor w
}
radiobutton .options.control.timeout.sdisabled \
-text $l_disable \
-variable isdn_timeout \
-value "-t 0" \
-relief flat \
-anchor w
pack .options.control.timeout.sdisabled \
-side top -anchor w -pady 0 -fill x -anchor w
frame .options.control.channel_B -relief groove -borderwidth 2
pack .options.control.channel_B -side top -anchor nw -padx 5 -pady 2
frame .options.control.channel_B.current
pack .options.control.channel_B.current -side top
label .options.control.channel_B.current.headline \
-text $l_useOfChannel_B \
$font $fontHeadline
canvas .options.control.channel_B.current.space -height 2 -width 1
pack .options.control.channel_B.current.headline \
.options.control.channel_B.current.space \
-anchor nw -side top
label .options.control.channel_B.current.text -text "now :"
label .options.control.channel_B.current.curval \
-textvariable channel_B -width 13 -anchor w -fg "#BF0000"
pack .options.control.channel_B.current.text \
.options.control.channel_B.current.curval \
-side left -anchor w
radiobutton .options.control.channel_B.enable \
-text $v_enabled -variable isdn_channel_B \
-value "-B" \
-relief flat \
-anchor w
radiobutton .options.control.channel_B.disable \
-text $v_disabled \
-variable isdn_channel_B \
-value "-b" \
-relief flat \
-anchor w
pack .options.control.channel_B.enable \
.options.control.channel_B.disable \
-side top -anchor w
frame .options.control.dialmode -relief groove -borderwidth 2
frame .options.control.dialmode.current
label .options.control.dialmode.current.headline \
-text $l_dialmode \
$font $fontHeadline
canvas .options.control.dialmode.current.space \
-height 2 -width 1
pack .options.control.dialmode.current.headline \
.options.control.dialmode.current.space \
-anchor nw -side top
label .options.control.dialmode.current.text -text "now :"
label .options.control.dialmode.current.curval \
-textvariable dialmode -width 13 -anchor w -fg "#BF0000"
pack .options.control.dialmode.current.text \
.options.control.dialmode.current.curval \
-side left -anchor w
pack .options.control.dialmode.current -side top
radiobutton .options.control.dialmode.manual \
-text $l_manual \
-variable isdn_dialmode \
-value "-a manual" \
-relief flat \
-anchor w
radiobutton .options.control.dialmode.auto \
-text $l_auto \
-variable isdn_dialmode \
-value "-a auto" \
-relief flat \
-anchor w
pack .options.control.dialmode.manual \
.options.control.dialmode.auto \
-side top -anchor w -pady 2 -fill x -anchor w
pack .options.control.dialmode \
-side bottom -in .options.control -pady 2 -padx 5
canvas .options.line -width 150 -height 10
.options.line create line 0 9 150 9
pack .options.line
frame .options.provider -relief groove -borderwidth 2
frame .options.provider.current
label .options.provider.current.headline \
-text Provider \
$font $fontHeadline
canvas .options.provider.current.space \
-height 2 -width 1
pack .options.provider.current.headline \
.options.provider.current.space \
-anchor w -side top -in .options.provider.current
label .options.provider.current.text -text "now :"
label .options.provider.current.curval \
-textvariable curprovider -width 13 -anchor w -fg "#BF0000"
pack .options.provider.current.text \
.options.provider.current.curval \
-anchor w -side left -in .options.provider.current
pack .options.provider.current -anchor w -side left -in .options.provider
menubutton .options.provider.select -text "Select Provider" -underline 0 \
-direction above -menu .options.provider.select.menu -relief raised
menu .options.provider.select.menu -tearoff 0
foreach i $providers {
if { $i == $curprovider } {
.options.provider.select.menu add command -label "$i" \
-command "setProvider $i" -state disabled
continue
}
.options.provider.select.menu add command -label "$i" \
-command "changeProviderMenu $i"
}
canvas .options.provider.space \
-height 4 -width 1
pack .options.provider.select -side right -pady 2 -padx 8
pack .options.provider.space -pady 4
pack .options.provider -side top -fill x \
-pady 2 -padx 7
canvas .options.line2 -width 150 -height 10
.options.line2 create line 0 9 150 9
pack .options.line2
initOptions
button .options.weiter -text OK -command { destroy .options } -width 10
pack .options.weiter -pady 5
bind .options.weiter <KeyPress-Return> { destroy .options }
focus .options.weiter
grab set .options
#tkwait window .options
set wait 0
}
proc changeProviderMenu { new } {
global curprovider
setInactive ".options.provider.select"
.options.provider.select.menu entryconfigure $curprovider -state active
setProvider $new
.options.provider.select.menu entryconfigure $new -state disabled
# brauchts nicht. passiert automatisch
#
#after 6000 setActive ".options.provider.select"
}
proc shutdown { } {
global fid sshProg sshUser sshKey isdnServer halt halt_1 halt_2 shutdown wait msg
global m_shutdownWarning_1 m_shutdownWarning_2 m_shutdownOK m_shutdown
set wait 4
#update idletasks
#after 500 {
# catch { read $fid }
# set tmp 1
#}
#vwait tmp
fileevent $fid readable ""
# ISDN-Server runterfahren
#
# weg wgene autom. verbindens statt isdnserver runterfahren
#
catch { puts $fid "ps -x | grep -e \"sh\" | grep -v grep | grep -c -e \"\[?|tty\]\";" }
set users [ lindex [gets $fid] 0 ]
while { ! [ string is integer -strict $users ] } {
set users [ lindex [gets $fid ] 0 ]
}
set infomsg ""
if { $users != 1 } {
append infomsg "$m_shutdownWarning_1 $users $m_shutdownWarning_2"
set icon warning
} else {
set icon question
}
# eingefügt für automatisches Wählen
#
#set icon question
# befehle für
# - automatische Wählen: "/home/dial/bin/dial_autm.sh; exit;"
# - ISDN-Server runterfahren: "sleep 2s; /home/dial/bin/poweroff; exit;"
#
append infomsg $m_shutdownOK
set answer [tk_messageBox -icon $icon -type okcancel \
-title "Shutdown Server -- Dialog" \
-parent . -message $infomsg ]
switch -- $answer {
ok { catch { puts $fid "sleep 2s; /home/dial/bin/poweroff; exit;" }
set shutdown 1
initParam 2
after 500 {
set halt 1
set halt_1 1
set halt_2 1
setWidgetColor .statusline.msg #BF0000
set msg $m_shutdown
}
}
cancel { fileevent $fid readable [list readPipe $fid] ; set wait 0 }
}
}
set halt 1
set halt_1 1
set halt_2 1
set wait 2
wm deiconify .
#destroy $top
set msg "initializing ..."
update
init
Reference in New Issue View Git Blame Copy Permalink