From: Kosta Pribić <kosta.pribic@gmail.com>
Date: Sun, 8 Nov 2009 17:49:48 +0000 (+0100)
Subject: Dodan parametar za paljenje DEBUG ispisa (-d ili --debug) , dodani
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=08fa37a404775ef3ac437500f9672766d3f4837a;p=imunes.git

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 3376f50..c90b51a 100755
--- 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 a94f574..696dd47 100755
--- 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 7031564..8592217 100755
--- 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 10aa0cb..38c5494 100755
--- 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"
+    }
 
 }