Dodan parametar za paljenje DEBUG ispisa (-d ili --debug) , dodani

uvjeti na sve relevantne ispise, default je silent.

diff --git a/imunes.tcl b/imunes.tcl
index 3376f505d48fefcbf2768eba3601d9140b7effce..c90b51a86e816a7d4c2466cc1958008a2aa91a07 100755 (executable)
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -48,6 +48,9 @@
 set execMode interactive
 set eid_base i[format %04x [pid]]
 
+# debug output to shell
+set debug false
+
 while { [string index [lindex $argv 0] 0] == "-" } {
     switch -exact -- [lindex $argv 0] {
        "-b" -
@@ -59,6 +62,16 @@ while { [string index [lindex $argv 0] 0] == "-" } {
        "--eid" {
            set eid_base [lindex $argv 1]
            set argv [lrange $argv 2 end]
+       }
+       "-d" -
+       "--debug" {
+       # debug output to shell
+           set debug "true"
+           set argv [lrange $argv 1 end]
+           if { $debug } {
+           puts "DEBUG == $debug"
+       }
+           
        }
        default {
            puts "unrecognized option: [lindex $argv 0]"
@@ -262,7 +275,9 @@ set exec_sockets_opened false
 #*****
 
 set remote_exec true
-puts "user je $tcl_platform(user)"
+if { $debug } {
+    puts "user is $tcl_platform(user)"
+}
 if { $gui_unix && $tcl_platform(user) == "root" } {
     set remote_exec false
 }

diff --git a/linkcfg.tcl b/linkcfg.tcl
index a94f574050812a0c49afa28ad5201a67f2e82456..696dd4790233d86570314c206ba83707a26bd31f 100755 (executable)
--- a/linkcfg.tcl
+++ b/linkcfg.tcl
@@ -690,9 +690,11 @@ proc newLink { lnode1 lnode2 } {
     set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
     lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
 
-    puts "Create link"
-    puts "  nodetype 1: [nodeType $lnode1]"
-    puts "  nodetype 2: [nodeType $lnode2]"
+    if { $debug } {
+        puts "Create link"
+        puts "  nodetype 1: [nodeType $lnode1]"
+        puts "  nodetype 2: [nodeType $lnode2]"
+    }
     
     lappend $link "nodes {$lnode1 $lnode2}"
     if { ([nodeType $lnode1] == "lanswitch" || \

diff --git a/linux/exec.tcl b/linux/exec.tcl
index 70315643a4a77efb53b35cb0b38914e924470c56..85922178d1d18863faed44d3cd9123e373f1388d 100755 (executable)
--- a/linux/exec.tcl
+++ b/linux/exec.tcl
@@ -52,6 +52,7 @@ set eid_base [pid]
 proc nexec { args } {
     global remote_exec editor_only
     global execSock
+    global debug
 
     if { $remote_exec } {
        if { ![info exists execSock] || $execSock == "" } {
@@ -67,10 +68,12 @@ proc nexec { args } {
     }
 
     if { $remote_exec } {
-       rexec $execSock $args   
+       rexec $execSock $args   
     } else {
-       puts "  -- running: $args"
-       eval exec $args
+        if { $debug } {
+               puts "  -- running: $args"
+        }
+       eval exec $args
     }
 }
 
@@ -225,7 +228,7 @@ proc statline {line} {
     global execMode
 
     if {$execMode == "batch"} {
-       puts $line
+    puts $line
     } else {
        .bottom.textbox config -text "$line"
        animateCursor
@@ -252,7 +255,10 @@ proc statline {line} {
 #   * name -- the name of the new interface
 #****
 proc createIfc { eid type hook } {
-    puts "usli u createIfc $eid $type $hook"
+    global debug
+    if { $debug } {
+        puts "usli u createIfc $eid $type $hook"
+    }
 }
 
 
@@ -273,8 +279,10 @@ proc createIfc { eid type hook } {
 #   * node -- node id
 #****
 proc l3node.instantiate { eid node } {
-
-       puts "\nl3node.INSTANTIATE $eid $node"
+    global debug
+    if { $debug } {
+       puts "\nl3node.INSTANTIATE $eid $node"
+    }
 
        upvar 0 ::cf::[set ::curcfg]::[set node]::node_id node_id
        upvar 0 ::cf::[set ::curcfg]::[set node]::ve_id ve_id
@@ -362,8 +370,11 @@ proc l3node.nghook { eid node ifc } {
 proc l3node.start { eid node } {
     global remote_exec execSock
     global viewcustomid
+    global debug
     
+    if { $debug } {
        puts "\nl3node.START $eid $node"
+    }
     
        upvar 0 ::cf::[set ::curcfg]::[set node]::node_id node_id
     upvar 0 ::cf::[set ::curcfg]::[set node]::ve_id ve_id
@@ -377,12 +388,14 @@ proc l3node.start { eid node } {
 # nam omoguci razne korisne stvari tipa proc filesystem itd
     upvar 0 ::cf::[set ::curcfg]::[set node]::ve_dir ve_dir
     set ve_boot_done "$ve_dir/tmp/imunes-boot-done"
-    puts -nonewline "   Waiting for VE $node ($ve_id) to actually start "
-    while { ! [ file exists $ve_boot_done ] } {
-        after 300
-        puts -nonewline "."
+    if { $debug } {
+        puts -nonewline "   Waiting for VE $node ($ve_id) to actually start "
+        while { ! [ file exists $ve_boot_done ] } {
+            after 300
+            puts -nonewline "."
+        }
+        puts "  detected VE $ve_id done"
     }
-    puts "  detected VE $ve_id done"
     file delete $ve_boot_done
 
 # OpenVZ zahtijeva da VE bude started za --netif_add
@@ -397,9 +410,10 @@ proc l3node.start { eid node } {
        set ifid "e${node_id}_${ifc}"
 
                set peer [peerByIfc $node $ifc]
-
-               puts "  Interface $ifc at $node links to $peer"
-
+        
+        if { $debug } {
+               puts "  Interface $ifc at $node links to $peer"
+        }
 
                    # vzctl ne prima ako nije properly padded
                    set ether 40:00:aa:aa:[format %02x $mac_byte4]:[format %02x $mac_byte5]
@@ -484,23 +498,31 @@ proc l3node.start { eid node } {
        set bootcfg [[typemodel $node].cfggen $node]
        set bootcmd [[typemodel $node].bootcmd $node]
     }
-    puts "  typemodel = [typemodel $node]"
-    puts "  bootcmd = $bootcmd"
-    puts "  bootcfg = $bootcfg"
+    if { $debug } {
+        puts "  typemodel = [typemodel $node]"
+        puts "  bootcmd = $bootcmd"
+        puts "  bootcfg = $bootcfg"
+    }
     if { ! $remote_exec } {
         if { $bootcmd != "/bin/sh" } {
-               puts "  writing $node_dir/boot.conf"
+            if { $debug } {
+               puts "  writing $node_dir/boot.conf"
+            }
                set fileId [open $node_dir/boot.conf w]
-               foreach line $bootcfg {
-                   puts $fileId $line
-               }
+           if { $debug } {
+               foreach line $bootcfg {
+                   puts $fileId $line
+               }
+            }
                close $fileId
         }
     } else {
                nexec create_conf_file $node_dir/boot.conf
-               foreach line $bootcfg {
-                   puts $execSock $line
-       }
+        if { $debug } {
+               foreach line $bootcfg {
+                   puts $execSock $line
+               }
+        }
        nexec close_conf_file
     }
 
@@ -513,9 +535,10 @@ proc l3node.start { eid node } {
                 # Ispravno izvedene naredbe u OpenVZ VE vracaju jedan prazan red
                 # pa ih se ignorira. Ako se preda prazan red kao naredba, takodjer je
                 # vracen jedan prazan red pa se i to ignorira.
-                   if { $ret != "TCL_OK" && $ret != ""} {
-                    puts "  =>Command \"$command\" executed on $node returned: \
-                       \"$ret\""
+                   if { $ret != "TCL_OK" && $ret != ""} {               
+                           if { $debug } {
+                        puts "  =>Command \"$command\" executed on $node returned: \"$ret\""
+                    }
                        # TODO: batch mode handling
                        set str "Command \n\n \"$command\"\n\n executed on $node returned: \
                        \n\n\"$ret\"\n\n"
@@ -527,16 +550,21 @@ proc l3node.start { eid node } {
     } else {
         # quagga i drugi mogu imati svoje custom skripte za bootanje koja se prepoznaje po
         # bootcmdu (interpreteru) koji nije obican shell
-        puts "  placing $bootcmd in $node_dir"
+        if { $debug } {
+            puts "  placing $bootcmd in $node_dir"
+        }
                set bootfile [file tail $bootcmd]
         file copy $bootcmd "$node_dir/$bootfile"
                set command "/$bootfile boot.conf"
-        puts "  will now execute $command in $node_id"
+        if { $debug } {
+            puts "  will now execute $command in $node_id"
+        }
 #       catch nexec vimage $node_id $bootcmd $node_dir/boot.conf >& $node_dir/out.log &"
            catch { nexec vzctl exec $node_id $command } ret
            if { $ret != "TCL_OK" && $ret != ""} {
-            puts "  =>Command \"$command\" executed on $node returned: \
-               \"$ret\""
+            if { $debug } {
+                puts "  =>Command \"$command\" executed on $node returned: \"$ret\""
+            }    
                # TODO: batch mode handling
                set str "Command \n\n \"$command\"\n\n executed on $node returned: \
                \n\n\"$ret\"\n\n"
@@ -561,8 +589,11 @@ proc l3node.start { eid node } {
 #****
 proc l3node.shutdown { eid node } {   
        upvar 0 ::cf::[set ::curcfg]::[set node]::node_id node_id
-   
-    puts "  Stopping VE $node ($node_id)"
+    global debug
+    
+    if { $debug } {   
+        puts "  Stopping VE $node ($node_id)"
+    }
     statline "Stopping VE $node ($node_id)"
     nexec vzctl stop $node_id
 }
@@ -584,6 +615,7 @@ proc l3node.shutdown { eid node } {
 proc l3node.destroy { eid node } {
 
        upvar 0 ::cf::[set ::curcfg]::[set node]::node_id node_id
+       global debug
 
 # TODO serial interface support
 #    foreach ifc [ifcList $node] {
@@ -597,7 +629,9 @@ proc l3node.destroy { eid node } {
 #    }
 
     set msg "Destroying VE $node ($node_id)"
-    puts "  $msg"
+    if { $debug } {
+        puts "  $msg"
+    }
     statline $msg
     nexec vzctl destroy $node_id
 }
@@ -623,8 +657,11 @@ proc deployCfg {} {
     global mac_byte4 mac_byte5
     global remote_exec
     global eid_base
-
-       puts "\n= deployCfg starts ="
+    global debug
+    
+    if { $debug } {
+       puts "\n= deployCfg starts ="
+    }
 
     set mac_byte4 0
     set mac_byte5 0
@@ -714,11 +751,13 @@ proc deployCfg {} {
                        #jedan od nodeova je sigurno L2, sad provjerava da li se radi o vezi izmedju
                        #dva L2 uredjaja
                        if { [[typemodel $lnode1].layer] == "LINK" && [[typemodel $lnode2].layer] == "LINK" } {
-                               #slucaj kad su spojena dva huba!!
-                               puts "\n\n*********************************************************************"
-                               puts "****        Panic! Panic! Spojena su dva huba, nemogu ja to!!        ***\n"   
-                               puts "*********************************************************************\n\n"
-                               puts "Klikni Eksperiment -> Terminate za uredan cleanup."
+                if { $debug } {
+                               #slucaj kad su spojena dva huba!!
+                               puts "\n\n*********************************************************************"
+                               puts "****        Panic! Panic! Spojena su dva huba, nemogu ja to!!        ***\n"   
+                               puts "*********************************************************************\n\n"
+                               puts "Klikni Eksperiment -> Terminate za uredan cleanup."
+                       }
                        } else {
                                # za slucaj kad se L3 spaja na L2 treba detektirati koji je koji te dodati
                                # L3 host side interface u odgovarajuci bridge
@@ -755,9 +794,13 @@ proc deployCfg {} {
                        }
 
                        if { $bridgefound == true } {
-                               puts "\nBridge $bridge (L2 hub emulation) already exists."
+                       if { $debug } {
+                               puts "\nBridge $bridge (L2 hub emulation) already exists."
+                       }
                        } else {
-                               puts "\nCreating bridge $bridge (L2 hub emulation)"
+                       if { $debug } {
+                                   puts "\nCreating bridge $bridge (L2 hub emulation)"
+                               }
                                nexec brctl addbr $bridge
                                lappend bridges $bridge
                        }
@@ -766,15 +809,18 @@ proc deployCfg {} {
                        if { [nodeType $bridge_node] == "rj45" } {
                                set bridge_name [getNodeName $bridge_node]
                                nexec brctl addif $bridge $bridge_name
-                               puts "  RJ45 emulacija, spojen na $bridge_name na hostu."
+                           if { $debug } {
+                               puts "  RJ45 emulacija, spojen na $bridge_name na hostu."
+                       }
                        }
                
                #dodaje interface
                        nexec brctl addif $bridge $port_if
                #dize bridge, interesantno ne baca error ako je bridge vec dignut
                        nexec ip link set up dev $bridge
-
-                       puts "  L2 device $bridge is up, added interface $port_if"
+            if { $debug } {          
+                       puts "  L2 device $bridge is up, added interface $port_if"
+               }
 
                } else {
                # Slucaj kad se radi link izmedju dva L3 uredjaja (standardno)
@@ -783,22 +829,27 @@ proc deployCfg {} {
                        set bridge "b$eid$lname"
                        set bridge_node $lname
 
-                       puts "\nCreating bridge $bridge"        
+            if { $debug } {
+                           puts "\nCreating bridge $bridge"    
+                       }
 
                        nexec brctl addbr $bridge
                        lappend bridges $bridge
                        nexec brctl addif $bridge $host_if_a
                        nexec brctl addif $bridge $host_if_b
                        nexec ip link set up dev $bridge
-                       puts "  Bridge $bridge is up, added interface $host_if_a and $host_if_b"
+                   if { $debug } {
+                           puts "  Bridge $bridge is up, added interface $host_if_a and $host_if_b"
+                       }
                }
 
        }
     set msg "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $node_list] nodes and [llength $link_list] links)."
     statline $msg
-    puts "\n$msg"
-    
-    puts "\n= deployCfg end ="
+    if { $debug } {
+        puts "\n$msg"   
+        puts "\n= deployCfg end ="
+    }
 }
 
 
@@ -814,26 +865,37 @@ proc deployCfg {} {
 proc vimageCleanup { eid } {
     global .c
     global execMode
-
-       puts "\n= Cleanup $eid start ="
+    global debug
+    
+    if { $debug } {
+       puts "\n= Cleanup $eid start ="
+    }
 
     set t_start [clock seconds]
 
-       puts "\nBridge cleanup in main host"
+    if { $debug } {
+       puts "\nBridge cleanup in main host"
+    }
        upvar 0 ::cf::[set ::curcfg]::bridges bridges
        if { [ info exists bridges ] && [ llength $bridges ] } {
                foreach bridge $bridges {
-                   puts "  Cleaning up bridge $bridge..."
+            if { $debug } {
+                   puts "  Cleaning up bridge $bridge..."
+               }
                        nexec ip link set down dev $bridge
                        nexec brctl delbr $bridge
                }
        }
-    puts "  Done.\n"  
+    if { $debug } {
+        puts "  Done.\n"  
+    }
     
     # OpenVZ - samo nam treba popis nodeova za pogasiti
     upvar 0 ::cf::[set ::curcfg]::node_list node_list
 
-    puts "Stopping all VEs..."
+    if { $debug } {
+        puts "Stopping all VEs..."
+    }
     foreach node $node_list {
            if { [[typemodel $node].layer] != "LINK" } {
                [typemodel $node].shutdown $eid $node
@@ -842,11 +904,11 @@ proc vimageCleanup { eid } {
            # bridge suceljem a ne VEom iako su u $node_list, stoga nema se sto gasiti
            }
     }
-    puts "  Done.\n"
-
-#    puts " nexec rm -f /usr/local/etc/quagga/Quagga.conf "
+    if { $debug } {
+        puts "  Done.\n"
+        puts "Destroying VE private enviroments..."
+    }
 
-    puts "Destroying VE private enviroments..."
     foreach node $node_list {
            if { [[typemodel $node].layer] != "LINK" } {
                [typemodel $node].destroy $eid $node
@@ -855,13 +917,14 @@ proc vimageCleanup { eid } {
            # bridge suceljem a ne VEom iako su u $node_list, stoga nema se sto gasiti
            }
     }
-    puts "  Done.\n"
-
     set msg "Cleanup completed in [expr [clock seconds] - $t_start] seconds."
-    statline $msg
-    puts "  $msg"
+    statline $msg   
 
-       puts "\n= Cleanup $eid end ="
+    if { $debug } {
+        puts "  $msg"
+        puts "  Done.\n"
+               puts "\n= Cleanup $eid end ="
+    }
 }
 
 
@@ -881,8 +944,11 @@ proc vimageCleanup { eid } {
 #   qdisc -- queuing discipline
 #****
 proc execSetIfcQDisc { eid node ifc qdisc } {
-
-       puts "execSetIfcQDisc $eid $node $ifc $qdisc"
+    global debug
+    
+    if { $debug } {
+       puts "execSetIfcQDisc $eid $node $ifc $qdisc"
+    }
        return
        
     set target [linkByIfc $node $ifc]
@@ -923,8 +989,11 @@ proc execSetIfcQDisc { eid node ifc qdisc } {
 #   qdrop -- queue dropping policy
 #****
 proc execSetIfcQDrop { eid node ifc qdrop } {
-
-       puts "execSetIfcQDrop $eid $node $ifc $qdrop"
+    global debug
+    
+    if { $debug } {
+       puts "execSetIfcQDrop $eid $node $ifc $qdrop"
+    }
        return
 
     set target [linkByIfc $node $ifc]
@@ -964,8 +1033,11 @@ proc execSetIfcQDrop { eid node ifc qdrop } {
 #   qlen -- new queue's length
 #****
 proc execSetIfcQLen { eid node ifc qlen } {
-
-       puts "execSetIfcQLen $eid $node $ifc $qlen"
+    global debug
+    
+    if { $debug } {
+           puts "execSetIfcQLen $eid $node $ifc $qlen"
+       }
        return
 
     set target [linkByIfc $node $ifc]
@@ -1001,8 +1073,11 @@ proc execSetIfcQLen { eid node ifc qlen } {
 #   link -- link id
 #****
 proc execSetLinkParams { eid link } {
+    global debug
 
-       puts "execSetLinkParams $eid $link"
+    if { $debug } {
+       puts "execSetLinkParams $eid $link"
+    }
        return
 
     set lnode1 [lindex [linkPeers $link] 0]

diff --git a/linux/quagga.tcl b/linux/quagga.tcl
index 10aa0cbee647fd899ce90dd8c0ad4229ae138178..38c54944f3783ad8f264e87ccd15b56fb6b9bf44 100755 (executable)
--- a/linux/quagga.tcl
+++ b/linux/quagga.tcl
@@ -223,6 +223,8 @@ proc $MODULE.instantiate { eid node } {
 #****
 proc $MODULE.start { eid node } {
 
+    global debug
+    
     # OpenVZ catch: prije startanja bootcmda moramo upaliti capabilities
     # jer bez toga quagga uopće ne radi
     upvar 0 ::cf::[set ::curcfg]::[set node]::node_id node_id
@@ -245,8 +247,9 @@ proc $MODULE.start { eid node } {
     
     # TODO: IPv6 Quagga support
     #    nexec vzctl exec $node_id sysctl -w net/ipv6/conf/all/forwarding=1
-
-    puts " $eid $node ima aktivan IPv4 forwarding"
+    if { $debug } {
+        puts " $eid $node ima aktivan IPv4 forwarding"
+    }
 
 }