Tcl/Tk Error in startup script: too may nested evaluations(infnite loop?)

Tchiarot · 08-31-2015, 10:42 PM

Hi Friends,

I recently try to make a tool for monitoring a ping.

The code is the following:

Code:

#!/usr/bin/wish -f
package require Expect
## Settings del FrontEnd
wm title . Ping_Monitor
wm geometry . 500x400+100+0
####
proc togglelblon lbl {
   $lbl config -bg green
 }
proc togglelbloff lbl {
   $lbl config -bg red
 }
proc togglelabelsdns1 system {
  foreach elem4 [ list bar1 bar2 bar3 bar4 ] {
      after 100
      togglelblon .lbf1.$system$elem4
      update idletask
   }
 }
proc littledaemon matr {
   set argv $matr
   set pidlist {}
   after 100
   set result2 0
   foreach system $argv {
     foreach elem6 [ list bar1 bar2 bar3 bar4 ] {
       .lbf1.$system$elem6 config -bg red
       update idletask
     }
   }
   set result1 0
   set result1 [ exec /home/chiarot/tcl/Project_Tools/myping.exp dns1 ] 
   if { $result1 > 0 } { togglelabelsdns1 dns1 }
  after 2000 [ littledaemon dns1 ]
}
labelframe .lbf1 -text "Herramienta_Monitoreo"
set myrowcounter 0
set high 2
set delta 0
foreach elem1 [ list bar1 bar2 bar3 bar4 ] {
  label .lbf1.dns1$elem1 -padx 2 -pady $high -bg red
  grid .lbf1.dns1$elem1 -column 1 -row 0 -sticky sw -padx $delta -pady 30
  set high [expr {$high + 2 }]
  set delta [expr {$delta + 10}] }
  label .lbf1.dns1 -bg black -fg green -text "dns1?"
  grid .lbf1.dns1 -pady 10 -column 0 -row 0 -padx 30 -pady 30 -sticky s

pack .lbf1
littledaemon dns1

For the ping I use expect:

Code:

#!/usr/bin/expect --
log_user 0
set exthost [ lindex $argv 0 ]
set timeout 4
spawn ping -c 1 -w 2 $exthost
expect {
   "1 received" {
      puts "1"
    }
   "0 received" {
      puts "0"
   }
   timeout {
      puts "0"
   }
}

The code is not the best, I'm not a coder.. but it works, except because in some moment it stops suddenly and show the following error:

Code:

^[]0;chiarot@debianchiarot: ~/tcl/Project_Toolschiarot@debianchiarot:~/tcl/Project_Tools$ ./sepdns1.tcl
Error in startup script: too many nested evaluations (infinite loop?)
    (procedure "togglelblon" line 1)
    invoked from within
"togglelblon .lbf1.$system$elem4"
    (procedure "togglelabelsdns1" line 4)
    invoked from within
"togglelabelsdns1 dns1 "
    (procedure "littledaemon" line 14)
    invoked from within

Now, checking the pid's I can note that it is always increasing and in a moment it reachs the highest value 31212 and for that reason show the error.

I would like to know how can I do a reset for the constantly increasing pid.

Hope could help me ..

Greetings!!

norobro · 09-02-2015, 06:28 PM

Caveat: I know nothing about Tcl/Tk.

In lieu of recursion, what if you call your proc "littledaemon" from a loop in the main part of your script?

Something like:

Code:

. . .
   if { $result1 > 0 } { togglelabelsdns1 dns1 }
#   after 2000 [ littledaemon dns1 ]
}
labelframe .lbf1 -text "Herramienta_Monitoreo"
set myrowcounter 0
set high 2
set delta 0
foreach elem1 [ list bar1 bar2 bar3 bar4 ] {
  label .lbf1.dns1$elem1 -padx 2 -pady $high -bg red
  grid .lbf1.dns1$elem1 -column 1 -row 0 -sticky sw -padx $delta -pady 30
  set high [expr {$high + 2 }]
  set delta [expr {$delta + 10}] }
  label .lbf1.dns1 -bg black -fg green -text "dns1?"
  grid .lbf1.dns1 -pady 10 -column 0 -row 0 -padx 30 -pady 30 -sticky s

pack .lbf1
while 1 {
  littledaemon dns1
  after 2000
}

polaris96 · 09-03-2015, 05:03 PM

I can tell you a few things you probably already know:

The tcl part (ok, the expect part) runs well. The tk widgets are misbehaving.

Unfortunately, I'm not a big tk user. Here's a potential fix though:

Try redesigning the the gui in tkPROe (you can get it from sourceforge http://tkproe.sourceforge.net/ )

Whenever I absolutely MUST have a widget, I use the ide and accept what it gives me.

Honestly, though, your task is REALLY simple in bash. I would do this:

Code:

ping -c 1 -w 4 $1 2> /dev/null; [ $? -eq 0 ]&& echo "Host $1 reachable." || "Host is unreachable;

or

Code:

#!/bin/bash
#this is slightly more sophisticated but it will also tell if you have an internal error.

# ping will return an error code of 0 on success or 2 if the host is unreachable
# $? queries the shell for the exit status of the last action (in this case ping)

ping -c 1 -w 4  $1 2> /dev/null
# send the ping.  it might be better to use -c 3 or more instead of just 1 btw.
# 2> /dev/null redirects the error output so it looks clean on your screen

case in $? 
   0) echo "Host $1 is reachable."
   ;;
   2) echo "Host $1 is unreachable."
   ;;
   *) echo "ping failed with internal error."
   ;;
esac

you could then use the "add launcher" feature from your DE's panel to "add an empty item" and c/p the script into it.

Don't get me wrong, I absolutely love tcl, but you're making a molehill into a mountain.

in pure tcl, your script would be

Code:

#!/usr/bin/tclsh
#catch function will keep the program from halting if ping fails
#tcl global errorCode will hold an error vector (space delimited)
#element 2 of $errorCode is the bash exit code.
#
#ping normally exits with 2 if the host is unreachable.
#
#OK
#tested 20150902 POLARIS



 if { ![catch { exec ping -c 1 -w 4 [lindex $argv 0]}]} {
      
      puts "Host [lindex $argv 0] reachable."
      
      } else {
      
      if { [ lindex [ split $errorCode " " ] 2 ] == 2 } {
          puts "Host [lindex $argv 0] is unreachable."
          } else {
          puts "ping failed with an internal error."
          }
       }

return 0

Best of Luck!