From e9fba62acb72d85782eb0a419207736e390e467a Mon Sep 17 00:00:00 2001 From: marko Date: Thu, 19 Jul 2007 01:17:05 +0000 Subject: [PATCH] Automated whitespace cleanup. Bug found by: Submitted by: Reviewed by: Approved by: Obtained from: --- annotations.tcl | 312 +++++++++--------- cfgparse.tcl | 172 +++++----- decentralized/memberd.tcl | 12 +- editor.tcl | 664 +++++++++++++++++++------------------- exec.tcl | 116 +++---- exec_server.tcl | 52 +-- filemgmt.tcl | 66 ++-- gpgui.tcl | 24 +- graph_partitioning.tcl | 178 +++++----- host.tcl | 16 +- imunes.tcl | 6 +- initgui.tcl | 10 +- ipsec.tcl | 20 +- ipv4.tcl | 118 +++---- ipv6.tcl | 108 +++---- linkcfg.tcl | 32 +- nodecfg.tcl | 42 +-- pc.tcl | 16 +- static.tcl | 16 +- xorp.tcl | 10 +- 20 files changed, 995 insertions(+), 995 deletions(-) diff --git a/annotations.tcl b/annotations.tcl index f8fee43..2c1cff4 100644 --- a/annotations.tcl +++ b/annotations.tcl @@ -28,18 +28,18 @@ proc annotationConfig { c target } { # set newoval $target switch -exact -- [nodeType $target] { - oval { - popupOvalDialog $c $target "true" $color $label $lcolor - } - rectangle { - popupRectDialog $c $target "true" $color $label $lcolor - } - text { - textConfig $c $target - } - default { - puts "Unknown type [nodeType $target] for target $target" - } + oval { + popupOvalDialog $c $target "true" $color $label $lcolor + } + rectangle { + popupRectDialog $c $target "true" $color $label $lcolor + } + text { + textConfig $c $target + } + default { + puts "Unknown type [nodeType $target] for target $target" + } } redrawAll } @@ -73,7 +73,7 @@ proc popupOvalDialog { c target modify color label lcolor } { # do nothing, return, if coords are empty if { $target == 0 && [$c coords "$newoval"] == "" } { - return + return } set wi .popup catch {destroy $wi} @@ -83,15 +83,15 @@ proc popupOvalDialog { c target modify color label lcolor } { wm resizable $wi 0 0 if { $modify == "true" } { - set windowtitle "Configure oval" + set windowtitle "Configure oval" } else { - set windowtitle "Add a new oval" + set windowtitle "Add a new oval" } wm title $wi $windowtitle frame $wi.lab -borderwidth 4 label $wi.lab.name_label -text "Text for top of oval:" entry $wi.lab.name -bg white -width 16 \ - -validate focus -invcmd "focusAndFlash %W" + -validate focus -invcmd "focusAndFlash %W" $wi.lab.name insert 0 $label pack $wi.lab.name $wi.lab.name_label -side right -padx 4 -pady 4 pack $wi.lab -side top @@ -100,30 +100,30 @@ proc popupOvalDialog { c target modify color label lcolor } { frame $wi.colors -borderwidth 4 label $wi.colors.label -text "Color:" if { $color == "" } { - set color $defOvalColor + set color $defOvalColor } if { $lcolor == "" } { - set lcolor black + set lcolor black } label $wi.colors.color -text $color -width 8 \ - -bg $color -fg $lcolor + -bg $color -fg $lcolor button $wi.colors.fg -text "fg" -command \ - "popupColor fg $wi.colors.color false" + "popupColor fg $wi.colors.color false" button $wi.colors.bg -text "bg" -command \ - "popupColor bg $wi.colors.color true" + "popupColor bg $wi.colors.color true" pack $wi.colors.fg $wi.colors.bg $wi.colors.color $wi.colors.label \ - -side right -padx 4 -pady 4 + -side right -padx 4 -pady 4 pack $wi.colors -side top set applycmd "popupOvalApply $c $wi $target" # Add new oval or modify old one? if { $modify == "true" } { - set cancelcmd "destroy $wi" - set applytext "Modify oval" + set cancelcmd "destroy $wi" + set applytext "Modify oval" } else { - set cancelcmd "destroy $wi; destroyNewoval $c" - set applytext "Add oval" + set cancelcmd "destroy $wi; destroyNewoval $c" + set applytext "Add oval" } frame $wi.butt -borderwidth 6 @@ -134,7 +134,7 @@ proc popupOvalDialog { c target modify color label lcolor } { pack $wi.butt.cancel $wi.butt.apply -side right pack $wi.butt -side bottom after 100 { - grab .popup + grab .popup } return } @@ -173,11 +173,11 @@ proc popupOvalApply { c wi target} { # build the oval object if {$target == 0} { - set object [newObjectId "oval"] - lappend oval_list $object - set coords [$c coords "$newoval"] + set object [newObjectId "oval"] + lappend oval_list $object + set coords [$c coords "$newoval"] } else { - set object $target + set object $target } global $object set $object {} @@ -203,32 +203,32 @@ proc popupOvalApply { c wi target} { proc button3annotation { type c x y } { if { $type == "oval" } { - set procname "Oval" - set item [lindex [$c gettags {oval && current}] 1] + set procname "Oval" + set item [lindex [$c gettags {oval && current}] 1] } elseif { $type == "rectangle" } { - set procname "Rectangle" - set item [lindex [$c gettags {rectangle && current}] 1] + set procname "Rectangle" + set item [lindex [$c gettags {rectangle && current}] 1] } elseif { $type == "label" } { - set procname "Label" - set item [lindex [$c gettags {label && current}] 1] + set procname "Label" + set item [lindex [$c gettags {label && current}] 1] } elseif { $type == "text" } { - set procname "Text" - set item [lindex [$c gettags {text && current}] 1] + set procname "Text" + set item [lindex [$c gettags {text && current}] 1] } else { - # ??? - return + # ??? + return } if { $item == "" } { - return + return } set menutext "$type $item" .button3menu delete 0 end .button3menu add command -label "Configure $menutext" \ - -command "annotationConfig $c $item" + -command "annotationConfig $c $item" .button3menu add command -label "Delete $menutext" \ - -command "deleteAnnotation $c $type $item" + -command "deleteAnnotation $c $type $item" set x [winfo pointerx .] set y [winfo pointery .] @@ -264,16 +264,16 @@ proc drawOval {oval} { set ly [expr ($y1 + 20)] if { $color == "" } { - set color $defOvalColor + set color $defOvalColor } if { $lcolor == "" } { - set lcolor black + set lcolor black } set newoval [.c create oval $x1 $y1 $x2 $y2 \ - -fill $color -width 2 -tags "oval $oval"] + -fill $color -width 2 -tags "oval $oval"] .c raise $newoval background .c create text $lx $ly -tags "oval $oval" -text $label \ - -justify center -font $defOvalLabelFont -fill $lcolor + -justify center -font $defOvalLabelFont -fill $lcolor setNodeCanvas $oval $curcanvas setType $oval "oval" } @@ -283,9 +283,9 @@ proc drawOval {oval} { proc popupColor { type l settext } { # popup color selection dialog with current color if { $type == "fg" } { - set initcolor [$l cget -fg] + set initcolor [$l cget -fg] } else { - set initcolor [$l cget -bg] + set initcolor [$l cget -bg] } set newcolor [tk_chooseColor -initialcolor $initcolor] @@ -304,7 +304,7 @@ proc popupColor { type l settext } { #****f* annotations.tcl/roundRect # NAME # roundRect -- Draw a rounded rectangle in the canvas. -# Called from drawRect procedure +# Called from drawRect procedure # SYNOPSIS # roundRect $w $x0 $y0 $x3 $y3 $radius $args # FUNCTION @@ -315,7 +315,7 @@ proc popupColor { type l settext } { # * x0, y0 -- Coordinates of the upper left corner, in pixels # * x3, y3 -- Coordinates of the lower right corner, in pixels # * radius -- Radius of the bend at the corners, in any form -# acceptable to Tk_GetPixels +# acceptable to Tk_GetPixels # * args -- Other args suitable to a 'polygon' item on the canvas # Example: # roundRect .c 100 50 500 250 $rad -fill white -outline black -tags rectangle @@ -331,10 +331,10 @@ proc roundRect { w x0 y0 x3 y3 radius args } { set maxr 0.75 if { $d > $maxr * ( $x3 - $x0 ) } { - set d [expr { $maxr * ( $x3 - $x0 ) }] + set d [expr { $maxr * ( $x3 - $x0 ) }] } if { $d > $maxr * ( $y3 - $y0 ) } { - set d [expr { $maxr * ( $y3 - $y0 ) }] + set d [expr { $maxr * ( $y3 - $y0 ) }] } set x1 [expr { $x0 + $d }] @@ -354,8 +354,8 @@ proc drawRect {rectangle} { set coords [getNodeCoords $rectangle] if {$coords == ""} { - tk_messageBox -type ok -message "Prazne coords za $rectangle" - return + tk_messageBox -type ok -message "Prazne coords za $rectangle" + return } set x1 [expr {[lindex $coords 0] * $zoom}] @@ -369,18 +369,18 @@ proc drawRect {rectangle} { set ly [expr ($y1 + 20)] if { $color == "" } { - set color $defRectColor + set color $defRectColor } if { $lcolor == "" } { - set lcolor black + set lcolor black } # rounded-rectangle radius set rad 25 set newrect [roundRect .c $x1 $y1 $x2 $y2 $rad \ - -fill $color -outline blue -tags "rectangle $rectangle"] + -fill $color -outline blue -tags "rectangle $rectangle"] .c raise $newrect background .c create text $lx $ly -tags "rectangle $rectangle" -text $label \ - -justify center -font $defRectLabelFont -fill $lcolor + -justify center -font $defRectLabelFont -fill $lcolor setNodeCanvas $rectangle $curcanvas setType $rectangle "rectangle" } @@ -392,7 +392,7 @@ proc popupRectDialog { c rectangle modify color label lcolor } { # do nothing, return, if coords are empty if { $rectangle == 0 && [$c coords "$newrect"] == "" } { - return + return } set wi .popup catch {destroy $wi} @@ -402,15 +402,15 @@ proc popupRectDialog { c rectangle modify color label lcolor } { wm resizable $wi 0 0 if { $modify == "true" } { - set windowtitle "Configure rectangle $rectangle" + set windowtitle "Configure rectangle $rectangle" } else { - set windowtitle "Add a new rectangle" + set windowtitle "Add a new rectangle" } wm title $wi $windowtitle frame $wi.lab -borderwidth 4 label $wi.lab.name_label -text "Text for top of rectangle:" entry $wi.lab.name -bg white -width 16 \ - -validate focus -invcmd "focusAndFlash %W" + -validate focus -invcmd "focusAndFlash %W" $wi.lab.name insert 0 $label pack $wi.lab.name $wi.lab.name_label -side right -padx 4 -pady 4 pack $wi.lab -side top @@ -419,28 +419,28 @@ proc popupRectDialog { c rectangle modify color label lcolor } { frame $wi.colors -borderwidth 4 label $wi.colors.label -text "Color:" if { $color == "" } { - set color $defRectColor + set color $defRectColor } if { $lcolor == "" } { - set lcolor black + set lcolor black } label $wi.colors.color -text $color -width 8 \ - -bg $color -fg $lcolor + -bg $color -fg $lcolor button $wi.colors.fg -text "fg" -command \ - "popupColor fg $wi.colors.color false" + "popupColor fg $wi.colors.color false" button $wi.colors.bg -text "bg" -command \ - "popupColor bg $wi.colors.color true" + "popupColor bg $wi.colors.color true" pack $wi.colors.fg $wi.colors.bg $wi.colors.color $wi.colors.label \ - -side right -padx 4 -pady 4 + -side right -padx 4 -pady 4 pack $wi.colors -side top # Add new oval or modify old one? if { $modify == "true" } { - set cancelcmd "destroy $wi" - set applytext "Modify rectangle" + set cancelcmd "destroy $wi" + set applytext "Modify rectangle" } else { - set cancelcmd "destroy $wi; destroyNewRect $c" - set applytext "Add rectangle" + set cancelcmd "destroy $wi; destroyNewRect $c" + set applytext "Add rectangle" } frame $wi.butt -borderwidth 6 @@ -452,7 +452,7 @@ proc popupRectDialog { c rectangle modify color label lcolor } { pack $wi.butt.cancel $wi.butt.apply -side right pack $wi.butt -side bottom after 100 { - grab .popup + grab .popup } return } @@ -482,13 +482,13 @@ proc popupRectApply { c wi target } { # Prije: set object [newObjectId "rectangle"] set object $target if { $target == 0 } { - # Create a new rectangle object - set target [newObjectId "rectangle"] - global $target - lappend rectangle_list $target - set coords [$c coords $newrect] + # Create a new rectangle object + set target [newObjectId "rectangle"] + global $target + lappend rectangle_list $target + set coords [$c coords $newrect] } else { - set coords [getNodeCoords $target] + set coords [getNodeCoords $target] } set $target {} lappend $iconcoords $coords @@ -515,16 +515,16 @@ proc backgroundImage { c file } { set e_sizey [expr {int($sizey * $zoom)}] if {"$file" == ""} { - return + return } set error [catch "image create photo Photo -file $file" errorMsg] if { $error == "1" } { - after idle {.dialog1.msg configure -wraplength 4i} - tk_dialog .dialog1 "IMUNES error" \ - "Couldn\'t set canvas background image:\n$errorMsg" \ - info 0 Dismiss - return 2 + after idle {.dialog1.msg configure -wraplength 4i} + tk_dialog .dialog1 "IMUNES error" \ + "Couldn\'t set canvas background image:\n$errorMsg" \ + info 0 Dismiss + return 2 } set image_h [image height Photo] set image_w [image width Photo] @@ -533,20 +533,20 @@ proc backgroundImage { c file } { set ry [expr $e_sizey * 1.0/ $image_h] if { $rx < $ry } { - set faktor [expr $rx * 100] + set faktor [expr $rx * 100] } else { - set faktor [expr $ry * 100] + set faktor [expr $ry * 100] } set faktor [expr int($faktor)] if { $faktor > 100 || $image_w > 1280 || $image_h > 1024 } { - after idle {.dialog1.msg configure -wraplength 4i} - tk_dialog .dialog1 "IMUNES error" \ - "Error: image should be >= $e_sizex*$e_sizey and <= 1280*1024 ($file is $image_h*$image_w)" \ - info 0 Dismiss - image delete Photo - return 2 + after idle {.dialog1.msg configure -wraplength 4i} + tk_dialog .dialog1 "IMUNES error" \ + "Error: image should be >= $e_sizex*$e_sizey and <= 1280*1024 ($file is $image_h*$image_w)" \ + info 0 Dismiss + image delete Photo + return 2 } set image [image% Photo $faktor] @@ -592,27 +592,27 @@ proc selectmarkEnter {c x y} { if { $y > [expr $y2-($y2-$y1)/8.0]} { set d 1 } if {$l==1} { - if {$u==1} { - $c config -cursor top_left_corner - } elseif {$d==1} { - $c config -cursor bottom_left_corner - } else { - $c config -cursor left_side - } + if {$u==1} { + $c config -cursor top_left_corner + } elseif {$d==1} { + $c config -cursor bottom_left_corner + } else { + $c config -cursor left_side + } } elseif {$r==1} { - if {$u==1} { - $c config -cursor top_right_corner - } elseif {$d==1} { - $c config -cursor bottom_right_corner - } else { - $c config -cursor right_side - } + if {$u==1} { + $c config -cursor top_right_corner + } elseif {$d==1} { + $c config -cursor bottom_right_corner + } else { + $c config -cursor right_side + } } elseif {$u==1} { - $c config -cursor top_side + $c config -cursor top_side } elseif {$d==1} { - $c config -cursor bottom_side + $c config -cursor bottom_side } else { - $c config -cursor left_ptr + $c config -cursor left_ptr } } @@ -651,30 +651,30 @@ proc drawText {text} { set coords [getNodeCoords $text] if {$coords == ""} { - puts "Empty coordinates for text $text" ;# MM debug - return + puts "Empty coordinates for text $text" ;# MM debug + return } set x [expr {[lindex $coords 0] * $zoom}] set y [expr {[lindex $coords 1] * $zoom}] set color [lindex [lsearch -inline [set $text] "color *"] 1] if { $color == "" } { - set color $defTextColor + set color $defTextColor } set label [lindex [lsearch -inline [set $text] "label *"] 1] set fontfamily [lindex [lsearch -inline [set $text] "fontfamily *"] 1] set fontsize [lindex [lsearch -inline [set $text] "fontsize *"] 1] if { $fontfamily == "" } { - set fontfamily $defTextFontFamily + set fontfamily $defTextFontFamily } if { $fontsize == "" } { - set fontsize $defTextFontSize + set fontsize $defTextFontSize } set newfontsize $fontsize set font [list "$fontfamily" $fontsize] set effects [lindex [lsearch -inline [set $text] "effects *"] 1] set newtext [.c create text $x $y -text $label -anchor w \ - -font "$font $effects" -justify left -fill $color \ - -tags "text $text"] + -font "$font $effects" -justify left -fill $color \ + -tags "text $text"] .c addtag text withtag $newtext .c raise $text background @@ -702,10 +702,10 @@ proc textConfig { c target } { if { [lsearch $effects underline ] != -1} {set textUnderline 1} if { $fontfamily == "" } { - set fontfamily $defTextFontFamily + set fontfamily $defTextFontFamily } if { $fontsize == "" } { - set fontsize $defTextFontSize + set fontsize $defTextFontSize } set wi .popup @@ -730,8 +730,8 @@ proc textConfig { c target } { set sizemenu [tk_optionMenu $wi.prop.font.size fontsize "$fontsize"] pack $wi.prop.font.label \ - $wi.prop.font.menu \ - $wi.prop.font.size -side left -pady 2 + $wi.prop.font.menu \ + $wi.prop.font.size -side left -pady 2 frame $wi.prop.format -relief groove -bd 2 label $wi.prop.format.label -text "Effects:" @@ -739,46 +739,46 @@ proc textConfig { c target } { # color selection if { $color == "" } { - set color $defTextColor + set color $defTextColor } button $wi.prop.format.fg -text "Color" -command \ - "popupColor fg $wi.text false" + "popupColor fg $wi.text false" checkbutton $wi.prop.format.bold -text "Bold" -variable textBold \ - -command [list fontupdate $wi.text bold] + -command [list fontupdate $wi.text bold] checkbutton $wi.prop.format.italic -text "Italic" -variable textItalic \ - -command [list fontupdate $wi.text italic] + -command [list fontupdate $wi.text italic] checkbutton $wi.prop.format.underline -text "Underline" -variable textUnderline \ - -command [list fontupdate $wi.text underline] + -command [list fontupdate $wi.text underline] if {$textBold == 1} { $wi.prop.format.bold select - } else { $wi.prop.format.bold deselect } + } else { $wi.prop.format.bold deselect } if {$textItalic == 1} { $wi.prop.format.italic select - } else { $wi.prop.format.italic deselect } + } else { $wi.prop.format.italic deselect } if {$textUnderline == 1} { $wi.prop.format.underline select - } else { $wi.prop.format.underline deselect } + } else { $wi.prop.format.underline deselect } pack $wi.prop.format.label \ - $wi.prop.format.fg \ - $wi.prop.format.bold \ - $wi.prop.format.italic \ - $wi.prop.format.underline \ - -side left -pady 2 ;# -fill both + $wi.prop.format.fg \ + $wi.prop.format.bold \ + $wi.prop.format.italic \ + $wi.prop.format.underline \ + -side left -pady 2 ;# -fill both $wi.text insert end $label $wi.text configure -font [list "$fontfamily" $fontsize $effects] -fg $color $fontmenu delete 0 foreach f [lsort -dictionary [font families]] { - $fontmenu add radiobutton -value "$f" -label $f \ - -variable fontfamily \ - -command [list fontupdate $wi.text fontfamily $f] + $fontmenu add radiobutton -value "$f" -label $f \ + -variable fontfamily \ + -command [list fontupdate $wi.text fontfamily $f] } $sizemenu delete 0 foreach f {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} { - $sizemenu add radiobutton -value "$f" -label $f \ - -variable fontsize \ - -command [list fontupdate $wi.text fontsize $f] + $sizemenu add radiobutton -value "$f" -label $f \ + -variable fontsize \ + -command [list fontupdate $wi.text fontsize $f] } set applycmd "textConfigApply $c $wi $target " @@ -792,7 +792,7 @@ proc textConfig { c target } { pack $wi.action.apply $wi.action.cancel -side left ;# -fill x after 100 { - grab .popup + grab .popup } return } @@ -805,12 +805,12 @@ proc fontupdate { label type args} { if {"$textItalic"} {set italic "italic"} else {set italic {} } if {"$textUnderline"} {set underline "underline"} else {set underline {} } switch $type { - fontsize { - set fontsize $args - } - fontfamily { - set fontfamily "$args" - } + fontsize { + set fontsize $args + } + fontfamily { + set fontfamily "$args" + } } set f [list "$fontfamily" $fontsize] lappend f "$bold $italic $underline" @@ -832,14 +832,14 @@ proc textConfigApply { c wi target } { # build the oval object if { $target == 0 } { - set target [newObjectId "target"] - global $target - lappend text_list $target - set coords [$c coords $newtext] + set target [newObjectId "target"] + global $target + lappend text_list $target + set coords [$c coords $newtext] } else { - set coords [getNodeCoords $target] + set coords [getNodeCoords $target] } - + set $target {} lappend $iconcoords $coords lappend $target $iconcoords @@ -866,7 +866,7 @@ proc textConfigApply { c wi target } { proc Call_Trace {{file stdout}} { puts $file "*** Tcl Call Trace:" for {set x [expr [info level]-1]} {$x > 0} {incr x -1} { - puts $file " $x: [info level $x]" + puts $file " $x: [info level $x]" } } diff --git a/cfgparse.tcl b/cfgparse.tcl index df2e304..1597357 100755 --- a/cfgparse.tcl +++ b/cfgparse.tcl @@ -1,4 +1,4 @@ -# $Id: cfgparse.tcl,v 1.30 2007/05/12 23:38:37 ana Exp $ +# $Id: cfgparse.tcl,v 1.31 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -102,13 +102,13 @@ proc dumpCfg {method dest} { if { "[lindex $element 0]" == "network-config" } { dumpputs $method $dest " network-config \{" foreach line [lindex $element 1] { - dumpputs $method $dest " $line" + dumpputs $method $dest " $line" } dumpputs $method $dest " \}" } elseif { "[lindex $element 0]" == "custom-config" } { dumpputs $method $dest " custom-config \{" foreach line [lindex $element 1] { - if { $line != {} } { + if { $line != {} } { set str [lindex $line 0] if { $str == "custom-config" } { dumpputs $method $dest " config \{" @@ -122,15 +122,15 @@ proc dumpCfg {method dest} { } } dumpputs $method $dest " \}" - } elseif { "[lindex $element 0]" == "ipsec-config" } { - dumpputs $method $dest " ipsec-config \{" - foreach line [lindex $element 1] { - if { $line != {} } { - dumpputs $method $dest " $line" - } + } elseif { "[lindex $element 0]" == "ipsec-config" } { + dumpputs $method $dest " ipsec-config \{" + foreach line [lindex $element 1] { + if { $line != {} } { + dumpputs $method $dest " $line" + } } dumpputs $method $dest " \}" - } else { + } else { dumpputs $method $dest " $element" } } @@ -162,29 +162,29 @@ proc dumpCfg {method dest} { dumpputs $method $dest "option show \{" if {$showIfNames == 0} { - dumpputs $method $dest " interface_names no" + dumpputs $method $dest " interface_names no" } else { - dumpputs $method $dest " interface_names yes" } + dumpputs $method $dest " interface_names yes" } if {$showIfIPaddrs == 0} { - dumpputs $method $dest " ip_addresses no" + dumpputs $method $dest " ip_addresses no" } else { - dumpputs $method $dest " ip_addresses yes" } + dumpputs $method $dest " ip_addresses yes" } if {$showIfIPv6addrs == 0} { - dumpputs $method $dest " ipv6_addresses no" + dumpputs $method $dest " ipv6_addresses no" } else { - dumpputs $method $dest " ipv6_addresses yes" } + dumpputs $method $dest " ipv6_addresses yes" } if {$showNodeLabels == 0} { - dumpputs $method $dest " node_labels no" + dumpputs $method $dest " node_labels no" } else { - dumpputs $method $dest " node_labels yes" } + dumpputs $method $dest " node_labels yes" } if {$showLinkLabels == 0} { - dumpputs $method $dest " link_labels no" + dumpputs $method $dest " link_labels no" } else { - dumpputs $method $dest " link_labels yes" } + dumpputs $method $dest " link_labels yes" } if {$showIPsecConfig == 0} { - dumpputs $method $dest " ipsec_configs no" + dumpputs $method $dest " ipsec_configs no" } else { - dumpputs $method $dest " ipsec_configs yes" } + dumpputs $method $dest " ipsec_configs yes" } dumpputs $method $dest "\}" dumpputs $method $dest "" } @@ -232,7 +232,7 @@ proc loadCfg { cfg } { lappend canvas_list $object } if {"$class" == "option"} { - # for future use + # for future use lappend prefs $object } continue @@ -246,25 +246,25 @@ proc loadCfg { cfg } { } set value [lindex $line 1] - set line [lreplace $line 0 1] + set line [lreplace $line 0 1] - if {"$class" == "node"} { + if {"$class" == "node"} { switch -exact -- $field { type { lappend $object "type $value" - } + } mirror { lappend $object "mirror $value" - } + } model { lappend $object "model $value" - } + } cpu { lappend $object "cpu {$value}" - } + } interface-peer { lappend $object "interface-peer {$value}" - } + } network-config { set cfg "" foreach zline [split $value { @@ -276,60 +276,60 @@ proc loadCfg { cfg } { } set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] lappend $object "network-config {$cfg}" - } + } custom-enabled { lappend $object "custom-enabled $value" - } + } custom-command { lappend $object "custom-command {$value}" - } + } custom-config { set cfg "" foreach zline [split $value { }] { if { [string index "$zline" 0] == " " } { - set zline [string replace "$zline" 0 0] + set zline [string replace "$zline" 0 0] } lappend cfg $zline } set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] - lappend $object "custom-config {$cfg}" - } - ipsec-enabled { - lappend $object "ipsec-enabled $value" - } + lappend $object "custom-config {$cfg}" + } + ipsec-enabled { + lappend $object "ipsec-enabled $value" + } ipsec-config { set cfg "" - + foreach zline [split $value { }] { if { [string index "$zline" 0] == " " } { - set zline [string replace "$zline" 0 0] + set zline [string replace "$zline" 0 0] } lappend cfg $zline } set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] - lappend $object "ipsec-config {$cfg}" - } + lappend $object "ipsec-config {$cfg}" + } iconcoords { lappend $object "iconcoords {$value}" - } + } labelcoords { lappend $object "labelcoords {$value}" - } + } canvas { lappend $object "canvas $value" - } + } } } elseif {"$class" == "link"} { switch -exact -- $field { nodes { lappend $object "nodes {$value}" - } + } mirror { lappend $object "mirror $value" - } + } bandwidth { lappend $object "bandwidth $value" } @@ -361,49 +361,49 @@ proc loadCfg { cfg } { } elseif {"$class" == "option"} { switch -exact -- $field { interface_names { - if { $value == "no" } { - set showIfNames 0 - } elseif { $value == "yes" } { - set showIfNames 1 - } - } + if { $value == "no" } { + set showIfNames 0 + } elseif { $value == "yes" } { + set showIfNames 1 + } + } ip_addresses { - if { $value == "no" } { - set showIfIPaddrs 0 - } elseif { $value == "yes" } { - set showIfIPaddrs 1 - } - } + if { $value == "no" } { + set showIfIPaddrs 0 + } elseif { $value == "yes" } { + set showIfIPaddrs 1 + } + } ipv6_addresses { - if { $value == "no" } { - set showIfIPv6addrs 0 - } elseif { $value == "yes" } { - set showIfIPv6addrs 1 - } - } + if { $value == "no" } { + set showIfIPv6addrs 0 + } elseif { $value == "yes" } { + set showIfIPv6addrs 1 + } + } node_labels { - if { $value == "no" } { - set showNodeLabels 0 - } elseif { $value == "yes" } { - set showNodeLabels 1 - } - } + if { $value == "no" } { + set showNodeLabels 0 + } elseif { $value == "yes" } { + set showNodeLabels 1 + } + } link_labels { - if { $value == "no" } { - set showLinkLabels 0 - } elseif { $value == "yes" } { - set showLinkLabels 1 - } - } + if { $value == "no" } { + set showLinkLabels 0 + } elseif { $value == "yes" } { + set showLinkLabels 1 + } + } ipsec_configs { - if { $value == "no" } { - set showIPsecConfig 0 - } elseif { $value == "yes" } { - set showIPsecConfig 1 - } - } + if { $value == "no" } { + set showIPsecConfig 0 + } elseif { $value == "yes" } { + set showIPsecConfig 1 + } + } } - } + } } } set class "" @@ -445,7 +445,7 @@ proc newObjectId { type } { set mark [string range [set type] 0 0] set id 0 while {[lsearch [set [set type]_list] "$mark$id"] != -1} { - incr id + incr id } return $mark$id } diff --git a/decentralized/memberd.tcl b/decentralized/memberd.tcl index 49a8837..02cdd9a 100755 --- a/decentralized/memberd.tcl +++ b/decentralized/memberd.tcl @@ -1,4 +1,4 @@ -# $Id: memberd.tcl,v 1.2 2007/05/07 08:43:20 ana Exp $ +# $Id: memberd.tcl,v 1.3 2007/07/19 01:17:06 marko Exp $ #!/usr/local/bin/tclsh8.4 # @@ -205,7 +205,7 @@ proc OpenPeering { so peer port } { if { [catch { puts $so "open $iv" }] } { catch { close $so } } else { - # XXX TODO: Configure TX encription using key + iv + # XXX TODO: Configure TX encription using key + iv AddPeering $so $peer $port } } @@ -330,9 +330,9 @@ proc ReadSocket { peer_id } { if { [gets $so line] < 0} { if { [eof $so] } { - DestroyPeering $peer_id - return - } + DestroyPeering $peer_id + return + } } else { set deadline($peer_id) [clock seconds] set cmd [lindex $line 0] @@ -536,7 +536,7 @@ proc ProcessAnnounce { peer_id host_id path line } { if { [lsearch $host_paths_tbl($host_id) "$peer_id *"] >= 0 } { # Duplicate entry from single peer - this must never happen! VerboseDestroyPeering $peer_id \ - "rcvd duplicate announcement from $peer_id: $path" + "rcvd duplicate announcement from $peer_id: $path" return } set old_best [BestPath $host_id] diff --git a/editor.tcl b/editor.tcl index c22400d..1424ad5 100755 --- a/editor.tcl +++ b/editor.tcl @@ -1,4 +1,4 @@ -# $Id: editor.tcl,v 1.66 2007/07/11 13:19:12 miljenko Exp $ +# $Id: editor.tcl,v 1.67 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -316,12 +316,12 @@ proc drawNode { node } { set x [expr {[lindex $coords 0] * $zoom}] set y [expr {[lindex $coords 1] * $zoom}] if { [nodeType $node] != "pseudo" } { - set labelstr1 [getNodeName $node]; - set labelstr2 [getNodePartition $node]; - set l [format "%s\n%s" $labelstr1 $labelstr2]; + set labelstr1 [getNodeName $node]; + set labelstr2 [getNodePartition $node]; + set l [format "%s\n%s" $labelstr1 $labelstr2]; set label [.c create text $x $y -fill blue \ - -text "$l" \ - -tags "nodelabel $node"] + -text "$l" \ + -tags "nodelabel $node"] } else { set pnode [getNodeName $node] set pcanvas [getNodeCanvas $pnode] @@ -371,7 +371,7 @@ proc drawLink { link } { } else { set newlink [.c create line 0 0 0 0 \ -fill [getLinkColor $link] -width $lwidth \ - -tags "link $link $lnode1 $lnode2"] + -tags "link $link $lnode1 $lnode2"] } # XXX Invisible pseudo-liks global invisible @@ -380,8 +380,8 @@ proc drawLink { link } { } .c raise $newlink background set newlink [.c create line 0 0 0 0 \ - -fill white -width [expr {$lwidth + 4}] \ - -tags "link $link $lnode1 $lnode2"] + -fill white -width [expr {$lwidth + 4}] \ + -tags "link $link $lnode1 $lnode2"] .c raise $newlink background .c create text 0 0 -tags "linklabel $link" -justify center .c create text 0 0 -tags "interface $lnode1 $link" -justify center @@ -489,19 +489,19 @@ proc calcDxDy { lnode } { switch -exact -- [nodeType $lnode] { frswitch { set x [expr {1.8 / $zoom}] - set y [expr {1.8 / $zoom}] + set y [expr {1.8 / $zoom}] } hub { - set x [expr {1.5 / $zoom}] - set y [expr {2.6 / $zoom}] + set x [expr {1.5 / $zoom}] + set y [expr {2.6 / $zoom}] } lanswitch { - set x [expr {1.5 / $zoom}] - set y [expr {2.6 / $zoom}] + set x [expr {1.5 / $zoom}] + set y [expr {2.6 / $zoom}] } router { set x [expr {1 / $zoom}] - set y [expr {2 / $zoom}] + set y [expr {2 / $zoom}] } pc { if { $showIfIPaddrs || $showIfIPv6addrs } { @@ -1203,14 +1203,14 @@ proc spawnShell { node cmd } { set node_id $eid\_$node if { $remote_exec } { - nexec vimageShellServer.sh $node_id 1234 $cmd & - if { $gui_unix } { - exec xterm -sb -rightbar \ + nexec vimageShellServer.sh $node_id 1234 $cmd & + if { $gui_unix } { + exec xterm -sb -rightbar \ -T "IMUNES: [getNodeName $node] (console)" \ -e "nc $exec_host 1234" & - } else { - exec cmd /c nc $exec_host 1234 & - } + } else { + exec cmd /c nc $exec_host 1234 & + } } else { nexec xterm -sb -rightbar \ -T "IMUNES: [getNodeName $node] (console)" \ @@ -1275,8 +1275,8 @@ proc button1 { c x y button } { [nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } { set node [lindex [$c gettags current] 1] set wasselected \ - [expr {[lsearch [$c find withtag "selected"] \ - [$c find withtag "node && $node"]] > -1}] + [expr {[lsearch [$c find withtag "selected"] \ + [$c find withtag "node && $node"]] > -1}] if { $button == "ctrl" } { if { $wasselected } { $c dtag $node selected @@ -1378,16 +1378,16 @@ proc button1-motion { c x y } { } } elseif { $activetool == "select" && $curtype == "nodelabel" \ && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } { - $c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}] - set changed 1 - set lastX $x - set lastY $y + $c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}] + set changed 1 + set lastX $x + set lastY $y } else { foreach img [$c find withtag "selected"] { set node [lindex [$c gettags $img] 1] set img [$c find withtag "selectmark && $node"] $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] - set img [$c find withtag "node && $node"] + set img [$c find withtag "node && $node"] $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] set img [$c find withtag "nodelabel && $node"] $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] @@ -1800,8 +1800,8 @@ proc popupConfigDialog { c } { switch -exact -- $object_type { node { - set type [nodeType $target] - if { $type == "pseudo" } { + set type [nodeType $target] + if { $type == "pseudo" } { # # Hyperlink to another canvas # @@ -1809,22 +1809,22 @@ proc popupConfigDialog { c } { set curcanvas [getNodeCanvas [getNodeMirror $target]] switchCanvas none return - } - set model [getNodeModel $target] - set router_model $model - wm title $wi "$type configuration" - frame $wi.ftop -borderwidth 4 - if { $type == "rj45" } { + } + set model [getNodeModel $target] + set router_model $model + wm title $wi "$type configuration" + frame $wi.ftop -borderwidth 4 + if { $type == "rj45" } { label $wi.ftop.name_label -text "Physical interface:" - } else { + } else { label $wi.ftop.name_label -text "Node name:" - } - entry $wi.ftop.name -bg white -width 16 \ + } + entry $wi.ftop.name -bg white -width 16 \ -validate focus -invcmd "focusAndFlash %W" - $wi.ftop.name insert 0 [getNodeName $target] - pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4 - pack $wi.ftop -side top - if { $type == "router" } { + $wi.ftop.name insert 0 [getNodeName $target] + pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4 + pack $wi.ftop -side top + if { $type == "router" } { frame $wi.model -borderwidth 4 label $wi.model.label -text "Model:" if { $oper_mode == "edit" } { @@ -1835,9 +1835,9 @@ proc popupConfigDialog { c } { } pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0 pack $wi.model -side top - } + } - if { $type != "rj45" } { + if { $type != "rj45" } { foreach ifc [lsort -ascii [ifcList $target]] { labelframe $wi.if$ifc -padx 4 -pady 4 frame $wi.if$ifc.label @@ -1934,9 +1934,9 @@ proc popupConfigDialog { c } { pack $wi.if$ifc.tab $wi.if$ifc.cfg -side left pack $wi.if$ifc -side top -anchor w -fill both } - } + } - if {[lsearch {router pc host} $type] >= 0} { + if {[lsearch {router pc host} $type] >= 0} { # # Static routes # @@ -1960,9 +1960,9 @@ proc popupConfigDialog { c } { pack $wi.statrt.cfg.text -expand yes pack $wi.statrt.tab $wi.statrt.cfg $wi.statrt.tab1 -side left pack $wi.statrt -side top -anchor w -fill both - } + } - if {[lsearch {router pc host} $type] >= 0} { + if {[lsearch {router pc host} $type] >= 0} { # # Custom startup config # @@ -2062,82 +2062,82 @@ proc popupConfigDialog { c } { $wi.cpu.maxl $wi.cpu.maxe \ $wi.cpu.weightl $wi.cpu.weighte -side left pack $wi.cpu -side top -anchor w -fill both - } + } } link { - wm title $wi "link configuration" - frame $wi.ftop -borderwidth 6 - set nam0 [getNodeName $n0] - set nam1 [getNodeName $n1] - label $wi.ftop.name_label -justify left -text \ - "Link from $nam0 to $nam1" - pack $wi.ftop.name_label -side right - pack $wi.ftop -side top - - frame $wi.bandwidth -borderwidth 4 - label $wi.bandwidth.label -anchor e \ - -text "Bandwidth (bps):" - spinbox $wi.bandwidth.value -bg white -justify right -width 10 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.bandwidth.value insert 0 [getLinkBandwidth $target] - $wi.bandwidth.value configure \ - -vcmd {checkIntRange %P 0 1000000000} \ - -from 0 -to 1000000000 -increment 1000 - pack $wi.bandwidth.value $wi.bandwidth.label \ - -side right - pack $wi.bandwidth -side top -anchor e - - frame $wi.delay -borderwidth 4 - label $wi.delay.label -anchor e -text "Delay (us):" - spinbox $wi.delay.value -bg white -justify right -width 10 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.delay.value insert 0 [getLinkDelay $target] - $wi.delay.value configure \ - -vcmd {checkIntRange %P 0 10000000} \ - -from 0 -to 10000000 -increment 5 - pack $wi.delay.value $wi.delay.label -side right - pack $wi.delay -side top -anchor e - - frame $wi.ber -borderwidth 4 - label $wi.ber.label -anchor e -text "BER (1/N):" - spinbox $wi.ber.value -bg white -justify right -width 10 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.ber.value insert 0 [getLinkBER $target] - $wi.ber.value configure \ - -vcmd {checkIntRange %P 0 10000000000000} \ - -from 0 -to 10000000000000 -increment 1000 - pack $wi.ber.value $wi.ber.label -side right - pack $wi.ber -side top -anchor e - - frame $wi.dup -borderwidth 4 - label $wi.dup.label -anchor e -text "Duplicate (%):" - spinbox $wi.dup.value -bg white -justify right -width 10 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.dup.value insert 0 [getLinkDup $target] - $wi.dup.value configure \ - -vcmd {checkIntRange %P 0 50} \ - -from 0 -to 50 -increment 1 - pack $wi.dup.value $wi.dup.label -side right - pack $wi.dup -side top -anchor e - - frame $wi.color -borderwidth 4 - label $wi.color.label -anchor e -text "Color:" - set link_color [getLinkColor $target] + wm title $wi "link configuration" + frame $wi.ftop -borderwidth 6 + set nam0 [getNodeName $n0] + set nam1 [getNodeName $n1] + label $wi.ftop.name_label -justify left -text \ + "Link from $nam0 to $nam1" + pack $wi.ftop.name_label -side right + pack $wi.ftop -side top + + frame $wi.bandwidth -borderwidth 4 + label $wi.bandwidth.label -anchor e \ + -text "Bandwidth (bps):" + spinbox $wi.bandwidth.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.bandwidth.value insert 0 [getLinkBandwidth $target] + $wi.bandwidth.value configure \ + -vcmd {checkIntRange %P 0 1000000000} \ + -from 0 -to 1000000000 -increment 1000 + pack $wi.bandwidth.value $wi.bandwidth.label \ + -side right + pack $wi.bandwidth -side top -anchor e + + frame $wi.delay -borderwidth 4 + label $wi.delay.label -anchor e -text "Delay (us):" + spinbox $wi.delay.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.delay.value insert 0 [getLinkDelay $target] + $wi.delay.value configure \ + -vcmd {checkIntRange %P 0 10000000} \ + -from 0 -to 10000000 -increment 5 + pack $wi.delay.value $wi.delay.label -side right + pack $wi.delay -side top -anchor e + + frame $wi.ber -borderwidth 4 + label $wi.ber.label -anchor e -text "BER (1/N):" + spinbox $wi.ber.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.ber.value insert 0 [getLinkBER $target] + $wi.ber.value configure \ + -vcmd {checkIntRange %P 0 10000000000000} \ + -from 0 -to 10000000000000 -increment 1000 + pack $wi.ber.value $wi.ber.label -side right + pack $wi.ber -side top -anchor e + + frame $wi.dup -borderwidth 4 + label $wi.dup.label -anchor e -text "Duplicate (%):" + spinbox $wi.dup.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.dup.value insert 0 [getLinkDup $target] + $wi.dup.value configure \ + -vcmd {checkIntRange %P 0 50} \ + -from 0 -to 50 -increment 1 + pack $wi.dup.value $wi.dup.label -side right + pack $wi.dup -side top -anchor e + + frame $wi.color -borderwidth 4 + label $wi.color.label -anchor e -text "Color:" + set link_color [getLinkColor $target] tk_optionMenu $wi.color.value link_color \ Red Green Blue Yellow Magenta Cyan Black - pack $wi.color.value $wi.color.label -side right - pack $wi.color -side top -anchor e + pack $wi.color.value $wi.color.label -side right + pack $wi.color -side top -anchor e - frame $wi.width -borderwidth 4 - label $wi.width.label -anchor e -text "Width:" - spinbox $wi.width.value -bg white -justify right -width 10 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.width.value insert 0 [getLinkWidth $target] - $wi.width.value configure \ - -vcmd {checkIntRange %P 1 8} \ - -from 1 -to 8 -increment 1 - pack $wi.width.value $wi.width.label -side right - pack $wi.width -side top -anchor e + frame $wi.width -borderwidth 4 + label $wi.width.label -anchor e -text "Width:" + spinbox $wi.width.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.width.value insert 0 [getLinkWidth $target] + $wi.width.value configure \ + -vcmd {checkIntRange %P 1 8} \ + -from 1 -to 8 -increment 1 + pack $wi.width.value $wi.width.label -side right + pack $wi.width -side top -anchor e } } @@ -2202,7 +2202,7 @@ proc editStartupCfg { node deleted } { set edit 1 if { $deleted == "1" } { - set viewcustomid [lindex $customidlist 0] + set viewcustomid [lindex $customidlist 0] } if { $customidlist == "" } { @@ -2367,23 +2367,23 @@ proc popupConfigApply { wi object_type target phase } { # Node # node { - set type [nodeType $target] - set model [getNodeModel $target] - set name [string trim [$wi.ftop.name get]] - if { $name != [getNodeName $target] } { + set type [nodeType $target] + set model [getNodeModel $target] + set name [string trim [$wi.ftop.name get]] + if { $name != [getNodeName $target] } { setNodeName $target $name set changed 1 - } - if { $oper_mode == "edit" && $type == "router" && \ + } + if { $oper_mode == "edit" && $type == "router" && \ $router_model != $model } { setNodeModel $target $router_model set changed 1 - } + } - # - # Queue config - # - foreach ifc [ifcList $target] { + # + # Queue config + # + foreach ifc [ifcList $target] { if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \ [nodeType $target] != "rj45" } { global ifqdisc$ifc ifqdrop$ifc @@ -2408,180 +2408,180 @@ proc popupConfigApply { wi object_type target phase } { } } - if {[[typemodel $target].layer] == "NETWORK"} { + if {[[typemodel $target].layer] == "NETWORK"} { foreach ifc [ifcList $target] { - # - # Operational state - # - global [subst ifoper$ifc] - set ifoperstate [subst $[subst ifoper$ifc]] - set oldifoperstate [getIfcOperState $target $ifc] - if { $ifoperstate != $oldifoperstate } { - setIfcOperState $target $ifc $ifoperstate - set changed 1 - } - - # - # IPv4 / IPv6 address & MTU - # - set ipaddr [$wi.if$ifc.cfg.ipv4.addrv get] - set oldipaddr [getIfcIPv4addr $target $ifc] - if { $ipaddr != $oldipaddr } { - setIfcIPv4addr $target $ifc $ipaddr - set changed 1 - } - set ipaddr [$wi.if$ifc.cfg.ipv6.addrv get] - set oldipaddr [getIfcIPv6addr $target $ifc] - if { $ipaddr != $oldipaddr } { - setIfcIPv6addr $target $ifc $ipaddr - set changed 1 - } - - set mtu [$wi.if$ifc.label.mtuv get] - set oldmtu [getIfcMTU $target $ifc] - if { $mtu != $oldmtu } { - setIfcMTU $target $ifc $mtu - set changed 1 - } - - } - - set oldIPv4statrtes [lsort [getStatIPv4routes $target]] - set oldIPv6statrtes [lsort [getStatIPv6routes $target]] - set newIPv4statrtes {} - set newIPv6statrtes {} - set i 1 - while { 1 } { - set text [$wi.statrt.cfg.text get $i.0 $i.end] - set rtentry [lrange [split [string trim $text]] 0 2] - if { $rtentry == "" } { - break - } - set dst [lindex $rtentry 0] - set gw [lindex $rtentry 1] - set metric [lindex $rtentry 2] - if { [string is integer $metric] != 1 || \ - $metric > 65535 } { - break - } - if { [checkIPv4Net $dst] == 1 } { - if { [checkIPv4Addr $gw] == 1 } { - lappend newIPv4statrtes \ - [string trim "$dst $gw $metric"] - } else { - break - } - } elseif { [checkIPv6Net $dst] == 1 } { - if { [checkIPv6Addr $gw] == 1 } { - lappend newIPv6statrtes \ - [string trim "$dst $gw $metric"] - } else { - break - } - } else { - break - } - incr i - } - set newIPv4statrtes [lsort $newIPv4statrtes] - if { $oldIPv4statrtes != $newIPv4statrtes } { - setStatIPv4routes $target $newIPv4statrtes - set changed 1 - } - set newIPv6statrtes [lsort $newIPv6statrtes] - if { $oldIPv6statrtes != $newIPv6statrtes } { - setStatIPv6routes $target $newIPv6statrtes - set changed 1 - } - - set oldcustomenabled [getCustomEnabled $target] - if {$oldcustomenabled != $customEnabled} { - setCustomEnabled $target $customEnabled - set changed 1 - } + # + # Operational state + # + global [subst ifoper$ifc] + set ifoperstate [subst $[subst ifoper$ifc]] + set oldifoperstate [getIfcOperState $target $ifc] + if { $ifoperstate != $oldifoperstate } { + setIfcOperState $target $ifc $ifoperstate + set changed 1 + } + + # + # IPv4 / IPv6 address & MTU + # + set ipaddr [$wi.if$ifc.cfg.ipv4.addrv get] + set oldipaddr [getIfcIPv4addr $target $ifc] + if { $ipaddr != $oldipaddr } { + setIfcIPv4addr $target $ifc $ipaddr + set changed 1 + } + set ipaddr [$wi.if$ifc.cfg.ipv6.addrv get] + set oldipaddr [getIfcIPv6addr $target $ifc] + if { $ipaddr != $oldipaddr } { + setIfcIPv6addr $target $ifc $ipaddr + set changed 1 + } + + set mtu [$wi.if$ifc.label.mtuv get] + set oldmtu [getIfcMTU $target $ifc] + if { $mtu != $oldmtu } { + setIfcMTU $target $ifc $mtu + set changed 1 + } + + } + + set oldIPv4statrtes [lsort [getStatIPv4routes $target]] + set oldIPv6statrtes [lsort [getStatIPv6routes $target]] + set newIPv4statrtes {} + set newIPv6statrtes {} + set i 1 + while { 1 } { + set text [$wi.statrt.cfg.text get $i.0 $i.end] + set rtentry [lrange [split [string trim $text]] 0 2] + if { $rtentry == "" } { + break + } + set dst [lindex $rtentry 0] + set gw [lindex $rtentry 1] + set metric [lindex $rtentry 2] + if { [string is integer $metric] != 1 || \ + $metric > 65535 } { + break + } + if { [checkIPv4Net $dst] == 1 } { + if { [checkIPv4Addr $gw] == 1 } { + lappend newIPv4statrtes \ + [string trim "$dst $gw $metric"] + } else { + break + } + } elseif { [checkIPv6Net $dst] == 1 } { + if { [checkIPv6Addr $gw] == 1 } { + lappend newIPv6statrtes \ + [string trim "$dst $gw $metric"] + } else { + break + } + } else { + break + } + incr i + } + set newIPv4statrtes [lsort $newIPv4statrtes] + if { $oldIPv4statrtes != $newIPv4statrtes } { + setStatIPv4routes $target $newIPv4statrtes + set changed 1 + } + set newIPv6statrtes [lsort $newIPv6statrtes] + if { $oldIPv6statrtes != $newIPv6statrtes } { + setStatIPv6routes $target $newIPv6statrtes + set changed 1 + } + + set oldcustomenabled [getCustomEnabled $target] + if {$oldcustomenabled != $customEnabled} { + setCustomEnabled $target $customEnabled + set changed 1 + } if { $showIPsecConfig == 0 } { set ipsecEnabled 0 } - set oldipsecenabled [getIpsecEnabled $target] - if {$oldipsecenabled != $ipsecEnabled} { - setIpsecEnabled $target $ipsecEnabled - set changed 1 - } - - set oldcpuconf [getNodeCPUConf $target] - set newcpuconf {} - set cpumin [$wi.cpu.mine get] - set cpumax [$wi.cpu.maxe get] - set cpuweight [$wi.cpu.weighte get] - if { $cpumin != "" } { - lappend newcpuconf "min $cpumin" - } - if { $cpumax != "" } { - lappend newcpuconf "max $cpumax" - } - if { $cpuweight != "" } { - lappend newcpuconf "weight $cpuweight" - } - if { $oldcpuconf != $newcpuconf } { - setNodeCPUConf $target [list $newcpuconf] - set changed 1 - } - } + set oldipsecenabled [getIpsecEnabled $target] + if {$oldipsecenabled != $ipsecEnabled} { + setIpsecEnabled $target $ipsecEnabled + set changed 1 + } + + set oldcpuconf [getNodeCPUConf $target] + set newcpuconf {} + set cpumin [$wi.cpu.mine get] + set cpumax [$wi.cpu.maxe get] + set cpuweight [$wi.cpu.weighte get] + if { $cpumin != "" } { + lappend newcpuconf "min $cpumin" + } + if { $cpumax != "" } { + lappend newcpuconf "max $cpumax" + } + if { $cpuweight != "" } { + lappend newcpuconf "weight $cpuweight" + } + if { $oldcpuconf != $newcpuconf } { + setNodeCPUConf $target [list $newcpuconf] + set changed 1 + } + } } # # Link # link { - set mirror [getLinkMirror $target] - set bw [$wi.bandwidth.value get] - if { $bw != [getLinkBandwidth $target] } { + set mirror [getLinkMirror $target] + set bw [$wi.bandwidth.value get] + if { $bw != [getLinkBandwidth $target] } { setLinkBandwidth $target [$wi.bandwidth.value get] if { $mirror != "" } { setLinkBandwidth $mirror [$wi.bandwidth.value get] } set changed 1 - } - set dly [$wi.delay.value get] - if { $dly != [getLinkDelay $target] } { + } + set dly [$wi.delay.value get] + if { $dly != [getLinkDelay $target] } { setLinkDelay $target [$wi.delay.value get] if { $mirror != "" } { setLinkDelay $mirror [$wi.delay.value get] } set changed 1 - } - set ber [$wi.ber.value get] - if { $ber != [getLinkBER $target] } { + } + set ber [$wi.ber.value get] + if { $ber != [getLinkBER $target] } { setLinkBER $target [$wi.ber.value get] if { $mirror != "" } { setLinkBER $mirror [$wi.ber.value get] } set changed 1 - } - set dup [$wi.dup.value get] - if { $dup != [getLinkDup $target] } { + } + set dup [$wi.dup.value get] + if { $dup != [getLinkDup $target] } { setLinkDup $target [$wi.dup.value get] if { $mirror != "" } { setLinkDup $mirror [$wi.dup.value get] } set changed 1 - } - if { $link_color != [getLinkColor $target] } { + } + if { $link_color != [getLinkColor $target] } { setLinkColor $target $link_color if { $mirror != "" } { setLinkColor $mirror $link_color } set changed 1 - } - set width [$wi.width.value get] - if { $width != [getLinkWidth $target] } { + } + set width [$wi.width.value get] + if { $width != [getLinkWidth $target] } { setLinkWidth $target [$wi.width.value get] if { $mirror != "" } { setLinkWidth $mirror [$wi.width.value get] } set changed 1 - } + } if { $changed == 1 && $oper_mode == "exec" } { execSetLinkParams $eid $target } @@ -2589,7 +2589,7 @@ proc popupConfigApply { wi object_type target phase } { } if { $changed == 1 } { redrawAll - updateUndoLog + updateUndoLog } destroy $wi } @@ -2872,26 +2872,26 @@ proc switchCanvas { direction } { set i [lsearch $canvas_list $curcanvas] switch -exact -- $direction { prev { - incr i -1 - if { $i < 0 } { - set curcanvas [lindex $canvas_list end] - } else { - set curcanvas [lindex $canvas_list $i] - } + incr i -1 + if { $i < 0 } { + set curcanvas [lindex $canvas_list end] + } else { + set curcanvas [lindex $canvas_list $i] + } } next { - incr i - if { $i >= [llength $canvas_list] } { - set curcanvas [lindex $canvas_list 0] - } else { - set curcanvas [lindex $canvas_list $i] - } + incr i + if { $i >= [llength $canvas_list] } { + set curcanvas [lindex $canvas_list 0] + } else { + set curcanvas [lindex $canvas_list $i] + } } first { - set curcanvas [lindex $canvas_list 0] + set curcanvas [lindex $canvas_list 0] } last { - set curcanvas [lindex $canvas_list end] + set curcanvas [lindex $canvas_list end] } } @@ -2899,15 +2899,15 @@ proc switchCanvas { direction } { set x 0 foreach canvas $canvas_list { set text [.hframe.t create text 0 0 \ - -text "[getCanvasName $canvas]" -tags "text $canvas"] + -text "[getCanvasName $canvas]" -tags "text $canvas"] set ox [lindex [.hframe.t bbox $text] 2] set oy [lindex [.hframe.t bbox $text] 3] set tab [.hframe.t create polygon $x 0 [expr {$x + 7}] 18 \ - [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 $x 0 \ - -fill gray -tags "tab $canvas"] + [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 $x 0 \ + -fill gray -tags "tab $canvas"] set line [.hframe.t create line 0 0 $x 0 [expr {$x + 7}] 18 \ - [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 999 0 \ - -fill #808080 -width 2 -tags "line $canvas"] + [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 999 0 \ + -fill #808080 -width 2 -tags "line $canvas"] .hframe.t coords $text [expr {$x + $ox + 12}] [expr {$oy + 2}] .hframe.t raise $text incr x [expr {2 * $ox + 17}] @@ -3089,9 +3089,9 @@ proc configRemoteHosts {} { set old_remote_exec $remote_exec if { $remote_exec } { - set state normal + set state normal } else { - set state disabled + set state disabled } set wi .popup @@ -3103,17 +3103,17 @@ proc configRemoteHosts {} { wm title $wi "Remote host(s) configuration" labelframe $wi.select -pady 2 -text "Experiment running:" \ - -padx 2 -borderwidth 2 + -padx 2 -borderwidth 2 radiobutton $wi.select.remote -text "remotely" \ - -command "enable_disable $wi"\ - -variable remote_exec -value true + -command "enable_disable $wi"\ + -variable remote_exec -value true radiobutton $wi.select.local -text "locally" \ - -command "enable_disable $wi"\ - -variable remote_exec -value false + -command "enable_disable $wi"\ + -variable remote_exec -value false checkbutton $wi.select.editor -text "edit mode only" \ - -command "enable_disable $wi"\ - -variable editor_only -onvalue true -offvalue false + -command "enable_disable $wi"\ + -variable editor_only -onvalue true -offvalue false pack $wi.select.local $wi.select.remote $wi.select.editor -side left labelframe $wi.hosts -pady 2 -text "Remote hosts:" -padx 2 @@ -3138,29 +3138,29 @@ proc configRemoteHosts {} { set i 0 foreach host_elem $exec_hosts { - eval label $wi.hosts.labels.v$i -text "$i. " -anchor e + eval label $wi.hosts.labels.v$i -text "$i. " -anchor e - eval entry $wi.hosts.address.v$i -bg white -width 15 \ - -validate focus -invcmd "focusAndFlash" - $wi.hosts.address.v$i insert 0 [lindex $host_elem 0] + eval entry $wi.hosts.address.v$i -bg white -width 15 \ + -validate focus -invcmd "focusAndFlash" + $wi.hosts.address.v$i insert 0 [lindex $host_elem 0] - eval entry $wi.hosts.ports.v$i -bg white -width 5 \ - -validate focus -invcmd "focusAndFlash" - $wi.hosts.ports.v$i insert 0 [lindex $host_elem 1] + eval entry $wi.hosts.ports.v$i -bg white -width 5 \ + -validate focus -invcmd "focusAndFlash" + $wi.hosts.ports.v$i insert 0 [lindex $host_elem 1] - eval entry $wi.hosts.monitors.v$i -bg white -width 5 \ - -validate focus -invcmd "focusAndFlash" - $wi.hosts.monitors.v$i insert 0 [lindex $host_elem 2] + eval entry $wi.hosts.monitors.v$i -bg white -width 5 \ + -validate focus -invcmd "focusAndFlash" + $wi.hosts.monitors.v$i insert 0 [lindex $host_elem 2] - eval checkbutton $wi.hosts.active.v$i \ - -variable active_host($i) -onvalue true -offvalue false + eval checkbutton $wi.hosts.active.v$i \ + -variable active_host($i) -onvalue true -offvalue false # eval entry $wi.hosts.weight.v$i -bg white -width 5 \ # -validate focus -invcmd "focusAndFlash" # $wi.hosts.weight.v$i insert 0 [lindex $host_elem 4] eval checkbutton $wi.hosts.ssh.v$i \ - -variable active_ssh($i) -onvalue true -offvalue false + -variable active_ssh($i) -onvalue true -offvalue false # -command { # if { active_ssh(0) } { # eval $wi.hosts.userName.v$i -configure state normal @@ -3170,27 +3170,27 @@ proc configRemoteHosts {} { # } eval entry $wi.hosts.userName.v$i -bg white -width 5 \ - -validate focus -invcmd "focusAndFlash" + -validate focus -invcmd "focusAndFlash" $wi.hosts.userName.v$i insert 0 [lindex $host_elem 5] - incr i + incr i } foreach j [list labels address ports monitors active ssh userName] { - eval pack $wi.hosts.$j.label -side top -padx 4 -pady 2 -fill x - set n [llength $exec_hosts] - for {set i 0} {$i < $n} {incr i} { - eval pack $wi.hosts.$j.v$i -side top -padx 4 -pady 2 -fill x - } + eval pack $wi.hosts.$j.label -side top -padx 4 -pady 2 -fill x + set n [llength $exec_hosts] + for {set i 0} {$i < $n} {incr i} { + eval pack $wi.hosts.$j.v$i -side top -padx 4 -pady 2 -fill x + } } pack $wi.hosts.labels $wi.hosts.address $wi.hosts.ports \ - $wi.hosts.monitors $wi.hosts.active \ + $wi.hosts.monitors $wi.hosts.active \ $wi.hosts.ssh $wi.hosts.userName -side left -fill x pack $wi.select $wi.hosts -side top -fill x -padx 4 frame $wi.butt -borderwidth 4 button $wi.butt.apply -text "Apply" -command \ - "configRemoteHostsApply $wi; destroy $wi" + "configRemoteHostsApply $wi; destroy $wi" focus $wi.butt.apply button $wi.butt.cancel -text "Cancel" -command \ "set remote_exec $old_remote_exec; destroy $wi" @@ -3226,17 +3226,17 @@ proc configRemoteHostsApply { wi } { set exec_hosts [] set at_least_one_up false for {set i 0} {$i < $n} {incr i} { - set ent [list [$wi.hosts.address.v$i get] \ - [$wi.hosts.ports.v$i get] \ - [$wi.hosts.monitors.v$i get]\ - $active_host($i) \ - $active_ssh($i)\ - [$wi.hosts.userName.v$i get]] - lappend exec_hosts $ent - if { $active_host($i) } { set at_least_one_up true } + set ent [list [$wi.hosts.address.v$i get] \ + [$wi.hosts.ports.v$i get] \ + [$wi.hosts.monitors.v$i get]\ + $active_host($i) \ + $active_ssh($i)\ + [$wi.hosts.userName.v$i get]] + lappend exec_hosts $ent + if { $active_host($i) } { set at_least_one_up true } } if { $remote_exec && ! $at_least_one_up } { - set editor_only true + set editor_only true .menubar.experiment entryconfigure "Execute" -state disabled } # catch { unset exec_sock monitor_sock } message @@ -3261,22 +3261,22 @@ proc enable_disable { wi } { set i 0 if { ! $remote_exec || $editor_only } { - set state disabled + set state disabled } else { - set state normal + set state normal } if { $editor_only } { .menubar.experiment entryconfigure "Execute" -state disabled } else { - .menubar.experiment entryconfigure "Execute" -state normal + .menubar.experiment entryconfigure "Execute" -state normal } foreach host_elem $exec_hosts { - eval $wi.hosts.address.v$i configure -state $state - eval $wi.hosts.ports.v$i configure -state $state - eval $wi.hosts.monitors.v$i configure -state $state - #eval $wi.hosts.weight.v$i configure -state $state + eval $wi.hosts.address.v$i configure -state $state + eval $wi.hosts.ports.v$i configure -state $state + eval $wi.hosts.monitors.v$i configure -state $state + #eval $wi.hosts.weight.v$i configure -state $state eval $wi.hosts.ssh.v$i configure -state $state eval $wi.hosts.userName.v$i configure -state $state incr i diff --git a/exec.tcl b/exec.tcl index 43ed756..76bae8c 100755 --- a/exec.tcl +++ b/exec.tcl @@ -1,4 +1,4 @@ -# $Id: exec.tcl,v 1.48 2007/05/07 23:06:06 marko Exp $ +# $Id: exec.tcl,v 1.49 2007/07/19 01:17:05 marko Exp $ # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -55,8 +55,8 @@ proc nexec { args } { global execSock if { $remote_exec } { - if { ![info exists execSock] || $execSock == "" } { - remoteStart + if { ![info exists execSock] || $execSock == "" } { + remoteStart } } @@ -70,7 +70,7 @@ proc nexec { args } { if { $remote_exec } { rexec $execSock $args } else { - eval exec $args + eval exec $args } } @@ -102,11 +102,11 @@ proc setOperMode { mode } { global undolevel redolevel if { $mode == "exec" } { ;# let's try something, sockets should be opened - nexec id -u - if { $editor_only } { ;# if set in nexec or open_exec_sockets + nexec id -u + if { $editor_only } { ;# if set in nexec or open_exec_sockets .menubar.experiment entryconfigure "Execute" -state disabled - return - } + return + } } # Verify that links to external interfaces are properly configured @@ -170,15 +170,15 @@ proc setOperMode { mode } { } .menubar.experiment entryconfigure "Terminate" -state disabled if { $undolevel > 0 } { - .menubar.edit entryconfigure "Undo" -state normal - } else { - .menubar.edit entryconfigure "Undo" -state disabled - } - if { $redolevel > $undolevel } { - .menubar.edit entryconfigure "Redo" -state normal - } else { - .menubar.edit entryconfigure "Redo" -state disabled - } + .menubar.edit entryconfigure "Undo" -state normal + } else { + .menubar.edit entryconfigure "Undo" -state disabled + } + if { $redolevel > $undolevel } { + .menubar.edit entryconfigure "Redo" -state normal + } else { + .menubar.edit entryconfigure "Redo" -state disabled + } set oper_mode edit remoteClose } @@ -201,10 +201,10 @@ proc statline {line} { global execMode if {$execMode == "batch"} { - puts $line + puts $line } else { - .bottom.textbox config -text "$line" - animateCursor + .bottom.textbox config -text "$line" + animateCursor } } @@ -364,14 +364,14 @@ proc l3node.start { eid node } { global viewcustomid set check [info exists viewcustomid] if { $check == 0 } { - set viewcustomid generic + set viewcustomid generic } if { [getCustomEnabled $node] == true } { set customCfg "" set customCfgList "" set customCfgList [getCustomConfig $node] foreach element $customCfgList { - set cid [lindex [lsearch -inline $element "custom-config-id *"] 1] + set cid [lindex [lsearch -inline $element "custom-config-id *"] 1] if { $cid == $viewcustomid } { set customCfg $element } @@ -389,17 +389,17 @@ proc l3node.start { eid node } { set ipsecCfg "" if { [getIpsecEnabled $node] == true } { - set setkeycfg [ipsecCfggen $node] - set setkeyFileId [open /tmp/$node_id/setkey.conf w+] - foreach line $setkeycfg { - puts $setkeyFileId $line - } - close $setkeyFileId + set setkeycfg [ipsecCfggen $node] + set setkeyFileId [open /tmp/$node_id/setkey.conf w+] + foreach line $setkeycfg { + puts $setkeyFileId $line + } + close $setkeyFileId set error "" set errorstr "" - set error [catch "nexec vimage $node_id setkey -f \ - /tmp/$node_id/setkey.conf" errorstr] + set error [catch "nexec vimage $node_id setkey -f \ + /tmp/$node_id/setkey.conf" errorstr] if { $error == "1" } { setkeyError $node_id $errorstr } @@ -410,11 +410,11 @@ proc l3node.start { eid node } { set bootcmd [[typemodel $node].bootcmd $node] } if { ! $remote_exec } { - set fileId [open /tmp/$node_id/boot.conf w] - foreach line $bootcfg { + set fileId [open /tmp/$node_id/boot.conf w] + foreach line $bootcfg { puts $fileId $line - } - close $fileId + } + close $fileId } else { nexec create_conf_file /tmp/$node_id/boot.conf foreach line $bootcfg { @@ -470,11 +470,11 @@ proc l3node.destroy {eid node } { set node_id "$eid\_$node" foreach ifc [ifcList $node] { catch { nexec ngctl msg $ifc@$node_id: shutdown } - set ifnum [string range $ifc 3 end] - set ifname [string range $ifc 0 2] - if { $ifname == "ser" } { + set ifnum [string range $ifc 3 end] + set ifname [string range $ifc 0 2] + if { $ifname == "ser" } { catch { nexec ngctl msg hdlc$ifnum@$node_id: shutdown } - } + } } catch {nexec vimage -d $node_id} nexec rm -fr /tmp/$node_id @@ -546,10 +546,10 @@ proc deployCfg {} { } set lname $eid\_$lnode1-$lnode2 - set bandwidth [expr [getLinkBandwidth $link] + 0] - set delay [expr [getLinkDelay $link] + 0] - set ber [expr [getLinkBER $link] + 0] - set dup [expr [getLinkDup $link] + 0] + set bandwidth [expr [getLinkBandwidth $link] + 0] + set delay [expr [getLinkDelay $link] + 0] + set ber [expr [getLinkBER $link] + 0] + set dup [expr [getLinkDup $link] + 0] set peer1 \ [lindex [[typemodel $lnode1].nghook $eid $lnode1 $ifname1] 0] @@ -874,8 +874,8 @@ proc cleanupCfg { } { proc openFwrd { lPort rPort rHost } { global tcl_platform platform if { $tcl_platform(platform) == "unix" } { - set pid [exec ssh -N -L $lPort:localhost:$rPort $rHost &] - return $pid + set pid [exec ssh -N -L $lPort:localhost:$rPort $rHost &] + return $pid } } @@ -924,7 +924,7 @@ proc open_sock { rHost rPort } { catch { set sock [socket $rHost $rPort] } } if { [info exists sock] } { - return $sock + return $sock } else { return "" } @@ -969,21 +969,21 @@ proc rexec { io command } { gets $io line if { $line == "Kraj rada" } { - close $io + close $io } if {$line != "Kraj" } { - set response $line + set response $line if { [string match "imunes -b *" $command] } { statline $line } - gets $io line + gets $io line } while { $line != "Kraj" } { - append response "\n" $line - if { [string match "imunes -b *" $command] } { - statline $line - } - gets $io line + append response "\n" $line + if { [string match "imunes -b *" $command] } { + statline $line + } + gets $io line } return $response } @@ -1007,7 +1007,7 @@ proc remoteStart {} { set remote_exec false set n [llength $exec_hosts] for { set i 0 } { $i < $n } { incr i } { - if { [lindex [lindex $exec_hosts $i] 3] } { + if { [lindex [lindex $exec_hosts $i] 3] } { set rHost [lindex [lindex $exec_hosts $i] 0] set rePort [lindex [lindex $exec_hosts $i] 1] set rmPort [lindex [lindex $exec_hosts $i] 2] @@ -1016,7 +1016,7 @@ proc remoteStart {} { set remote_exec true set exec_host $rHost break - } + } } if { ! $remote_exec } { return } @@ -1038,9 +1038,9 @@ proc remoteStart {} { } if { $monSock == "" || $execSock == "" } { set sel [tk_dialog .box "Socket problems" \ - "Cannot open sockets" \ - "" 0 "Retry" "Configure remote hosts" "Editor only mode" ] - switch $sel { + "Cannot open sockets" \ + "" 0 "Retry" "Configure remote hosts" "Editor only mode" ] + switch $sel { 0 { remoteStart } diff --git a/exec_server.tcl b/exec_server.tcl index ecdd0d6..31aa7f6 100755 --- a/exec_server.tcl +++ b/exec_server.tcl @@ -1,4 +1,4 @@ -# $Id: exec_server.tcl,v 1.4 2007/05/07 08:43:20 ana Exp $ +# $Id: exec_server.tcl,v 1.5 2007/07/19 01:17:05 marko Exp $ #! /usr/local/bin/tclsh8.4 ####### @@ -61,51 +61,51 @@ proc Exec_command {sock} { close $sock puts "Close $client(addr,$sock)" unset client(addr,$sock) - return + return } if { $debug_output } { puts "$server_port/K: >$line<" } if { $line == "Kraj" } { - puts "Kraj rada." - puts $sock "Kraj" - close $sock - exit 0 + puts "Kraj rada." + puts $sock "Kraj" + close $sock + exit 0 } if {$spremam_conf_fajl} { if { $line == "close_conf_file" } { - if { $debug_output} { puts "Zatvaram conf fajl" } - close $fileId - set spremam_conf_fajl false + if { $debug_output} { puts "Zatvaram conf fajl" } + close $fileId + set spremam_conf_fajl false puts $sock "Kraj" } else { - catch {puts $fileId $line} odg - if { $debug_output && ($odg != "") } { - puts "$server_port/puts greska: $odg" - } + catch {puts $fileId $line} odg + if { $debug_output && ($odg != "") } { + puts "$server_port/puts greska: $odg" + } } } else { if { [lindex $line 0] == "create_conf_file" } { - set conf_fajl [lindex $line 1] - if { $debug_output} { puts "Spremam conf fajl: $conf_fajl" } - set fileId [open "$conf_fajl" w] - ;# dodati provjeru!!! - set spremam_conf_fajl true - - } else { - if { [llength $line] == 0 } { return} - catch {eval exec $line} odg - if { $debug_output } { puts "$server_port/O: $odg" } - puts $sock $odg - } + set conf_fajl [lindex $line 1] + if { $debug_output} { puts "Spremam conf fajl: $conf_fajl" } + set fileId [open "$conf_fajl" w] + ;# dodati provjeru!!! + set spremam_conf_fajl true + + } else { + if { [llength $line] == 0 } { return} + catch {eval exec $line} odg + if { $debug_output } { puts "$server_port/O: $odg" } + puts $sock $odg + } puts $sock "Kraj" } catch {flush $sock} rez if { $rez != "" } { - puts "Socket closed on remote.\n$rez" + puts "Socket closed on remote.\n$rez" } } diff --git a/filemgmt.tcl b/filemgmt.tcl index 34d7b37..06ea728 100755 --- a/filemgmt.tcl +++ b/filemgmt.tcl @@ -1,4 +1,4 @@ -# $Id: filemgmt.tcl,v 1.8 2007/05/07 08:43:20 ana Exp $ +# $Id: filemgmt.tcl,v 1.9 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -82,7 +82,7 @@ set currentFile "" set fileTypes {{"IMUNES network configuration" {.imn} } - { "All files" {*}}} + { "All files" {*}}} #****f* filemgmt.tcl/newFile @@ -129,7 +129,7 @@ proc openFile {} { set fileId [open $currentFile r] set cfg "" foreach entry [read $fileId] { - lappend cfg $entry + lappend cfg $entry } close $fileId loadCfg $cfg @@ -157,12 +157,12 @@ proc openFile {} { proc saveFile { selectedFile } { global currentFile if { $selectedFile != ""} { - set currentFile $selectedFile - set fileName [file tail $currentFile] - wm title . "IMUNES $fileName" - set fileId [open $currentFile w] - dumpCfg file $fileId - close $fileId + set currentFile $selectedFile + set fileName [file tail $currentFile] + wm title . "IMUNES $fileName" + set fileId [open $currentFile w] + dumpCfg file $fileId + close $fileId .bottom.textbox config -text "Saved $fileName" } } @@ -182,8 +182,8 @@ proc fileOpenStartUp {} { global currentFile if { $argv != "" } { - set currentFile $argv - openFile + set currentFile $argv + openFile } } @@ -200,15 +200,15 @@ proc fileNewDialogBox {} { global currentFile set choice [tk_messageBox -type yesnocancel -default yes\ - -message "Save changes?" -icon question] + -message "Save changes?" -icon question] if { $choice != "cancel"} { - if { $choice == "yes"} { - fileSaveDialogBox - newFile - } else { - newFile - } + if { $choice == "yes"} { + fileSaveDialogBox + newFile + } else { + newFile + } } } @@ -226,8 +226,8 @@ proc fileOpenDialogBox {} { global fileTypes set selectedFile [tk_getOpenFile -filetypes $fileTypes] if { $selectedFile != ""} { - set currentFile $selectedFile - openFile + set currentFile $selectedFile + openFile } } @@ -246,11 +246,11 @@ proc fileSaveDialogBox {} { global fileTypes if { $currentFile == "" } { - set selectedFile [tk_getSaveFile -filetypes $fileTypes -initialfile\ - untitled -defaultextension .imn] - saveFile $selectedFile + set selectedFile [tk_getSaveFile -filetypes $fileTypes -initialfile\ + untitled -defaultextension .imn] + saveFile $selectedFile } else { - saveFile $currentFile + saveFile $currentFile } } @@ -267,7 +267,7 @@ proc fileSaveAsDialogBox {} { global currentFile global fileTypes set selectedFile [tk_getSaveFile -filetypes $fileTypes -initialfile\ - untitled -defaultextension .imn] + untitled -defaultextension .imn] saveFile $selectedFile } @@ -295,15 +295,15 @@ proc readConfigFile {} { global exec_hosts remote_exec editor_only global env if { [file exists ".imunesrc"] } { - source ".imunesrc" + source ".imunesrc" } else { - if { [catch {set myhome $env(HOME)}] } { - ;# not running on UNIX - } else { - if { [file exists "$myhome/.imunesrc"] } { - source "$myhome/.imunesrc" - } - } + if { [catch {set myhome $env(HOME)}] } { + ;# not running on UNIX + } else { + if { [file exists "$myhome/.imunesrc"] } { + source "$myhome/.imunesrc" + } + } } } diff --git a/gpgui.tcl b/gpgui.tcl index 488b19d..a665ef4 100644 --- a/gpgui.tcl +++ b/gpgui.tcl @@ -56,7 +56,7 @@ proc dialog { } { global partition_list readNodeWeights; - + set wi .popup toplevel $wi wm transient $wi . @@ -197,7 +197,7 @@ proc displayAllLinkWeights {wi} { set i 1; set j 1; foreach link $link_list { - + label $lw.more.weights.$link -text "$link" -anchor w #bandwidth label $lw.more.weights.bl$link -text "Bandwidth:" -anchor w @@ -389,15 +389,15 @@ proc getNodeWeight {node} { if {$wgt == ""} then { switch -exact -- [nodeType $node] { - pc { - set wgt $node_weights(0); - } - host { - set wgt $node_weights(1); - } - router { - set wgt $node_weights(2); - } + pc { + set wgt $node_weights(0); + } + host { + set wgt $node_weights(1); + } + router { + set wgt $node_weights(2); + } lanswitch { set wgt $node_weights(3); } @@ -437,7 +437,7 @@ proc changeDefaultWeights {wi} { set node_weights(3) [$wi.weight.switchs get]; set node_weights(4) [$wi.weight.hubs get]; set node_weights(5) [$wi.weight.rj45s get]; - + debug $file [format "%d %d %d %d %d %d" $node_weights(0) $node_weights(1) $node_weights(2) $node_weights(3) $]node_weights(4) $node_weights(5); close $file; destroy $wi; diff --git a/graph_partitioning.tcl b/graph_partitioning.tcl index 140fbae..570ba6b 100644 --- a/graph_partitioning.tcl +++ b/graph_partitioning.tcl @@ -306,8 +306,8 @@ proc mergePseudoLink { pnode } { mergeLink $l1; if {[lsearch $split_list "$n $n2"] < 0 && [lsearch $split_list "$n2 $n"] < 0} then { - lappend split_list "$n $n2"; - break; + lappend split_list "$n $n2"; + break; } } } @@ -452,11 +452,11 @@ proc recursiveBisection {nvertices node_weight node_neighbour edge_array edge_we set snode_neighbour0($i) $snode_neighbour(0,$i); } if {[array size upmap] > 0} then { - set snode_map0($i) $upmap($snode_map_help(0,$i)); - } else { + set snode_map0($i) $upmap($snode_map_help(0,$i)); + } else { set snode_map0($i) $snode_map_help(0,$i); } - debug "snode_map0($i)=$snode_map0($i)"; + debug "snode_map0($i)=$snode_map0($i)"; set snode_weight0($i) $snode_weight(0,$i); } @@ -465,11 +465,11 @@ proc recursiveBisection {nvertices node_weight node_neighbour edge_array edge_we set snode_neighbour1($i) $snode_neighbour(1,$i); } if {[array size upmap] > 0} then { - set snode_map1($i) $upmap($snode_map_help(1,$i)); - } else { + set snode_map1($i) $upmap($snode_map_help(1,$i)); + } else { set snode_map1($i) $snode_map_help(1,$i); } - debug "snode_map1($i)=$snode_map1($i)"; + debug "snode_map1($i)=$snode_map1($i)"; set snode_weight1($i) $snode_weight(1,$i); } @@ -565,24 +565,24 @@ proc coarseGraph {nvertices node_weight node_neighbour edge_array edge_weight tp #node has an unmatched, passend neighbor, and is matched with it if {$nvertices > $COARSEN_TO && [info exists nneighbour($unmatched_node)]} then { foreach ngb $nneighbour($unmatched_node) { - if {[lsearch $matched $ngb] == -1 && [expr {$nweight($i) + $nweight($ngb)}] < $max_nweight && $max_eweight < $eweight([getEdgeBetween $unmatched_node $ngb earray])} then { + if {[lsearch $matched $ngb] == -1 && [expr {$nweight($i) + $nweight($ngb)}] < $max_nweight && $max_eweight < $eweight([getEdgeBetween $unmatched_node $ngb earray])} then { set matched_ngb 1; - lappend matched $ngb; - set max_eweight $eweight([getEdgeBetween $unmatched_node $ngb earray]); + lappend matched $ngb; + set max_eweight $eweight([getEdgeBetween $unmatched_node $ngb earray]); set nmatch($unmatched_node) $ngb; set nmatch($ngb) $unmatched_node; set nmap($unmatched_node) $cnvertices; #potrebno za uncoarse set nmap($ngb) $cnvertices; #potrebno za uncoarse set cnweight($cnvertices) [expr {$nweight($unmatched_node) + $nweight($ngb)}]; - } + } } } #node is matched with itself if {$matched_ngb == 0} then { set nmatch($unmatched_node) $unmatched_node; - set nmap($unmatched_node) $cnvertices; - set cnweight($cnvertices) $nweight($unmatched_node); + set nmap($unmatched_node) $cnvertices; + set cnweight($cnvertices) $nweight($unmatched_node); } debug "nmap($unmatched_node)=$nmap($unmatched_node),$unmatched_node,$nmatch($unmatched_node) "; incr cnvertices; @@ -600,7 +600,7 @@ if {$nvertices > $COARSEN_TO && [info exists nneighbour($unmatched_node)]} then set cnode $nmap($parent1); if {[lsearch $used_nodes $cnode] > -1} { - continue; + continue; } lappend used_nodes $cnode; @@ -610,7 +610,7 @@ if {[info exists nneighbour($parent1)] && [info exists nneighbour($parent2)]} th # take all neighbours from "parent"-nodes set all_neighbours [concat $nneighbour($parent1) $nneighbour($parent2)]; foreach ngb $all_neighbours { - set ngb_map $nmap($ngb); + set ngb_map $nmap($ngb); #don't save duplicates if {$ngb_map == $cnode} then { continue; @@ -643,18 +643,18 @@ if {[info exists nneighbour($parent1)] && [info exists nneighbour($parent2)]} th } else { #check if the link already exists in coarsed graph for {set j 0} {$j < [array size cearray]} {incr j} { - if {$cearray($j) == "$cnode1 $cnode2" || $cearray($j) == "$cnode2 $cnode1"} then { - set twin 1; + if {$cearray($j) == "$cnode1 $cnode2" || $cearray($j) == "$cnode2 $cnode1"} then { + set twin 1; #add the edge weight to the weight of coarsed edge - incr ceweight($j) $eweight($i); - break; - } + incr ceweight($j) $eweight($i); + break; + } } #if its no double edge, make a new edge in coarsed graph if {$twin == 0} then { - set cearray($cnum_edges) "$cnode1 $cnode2"; + set cearray($cnum_edges) "$cnode1 $cnode2"; set ceweight($cnum_edges) $eweight($i); - incr cnum_edges; + incr cnum_edges; } } } @@ -752,22 +752,22 @@ proc makePartitions {nvertices node_weight node_neighbour edge_array edge_weight set visited($start_node) 1; while {1} { - #graph is disconnected - if {[llength $queue] == 0} { - set more_left 0; - for {set n 0} {$n < $nvertices} {incr n} { - if {$visited($n) == 0} then { - set queue $n; - set visited($n) 1; - set more_left 1; + #graph is disconnected + if {[llength $queue] == 0} { + set more_left 0; + for {set n 0} {$n < $nvertices} {incr n} { + if {$visited($n) == 0} then { + set queue $n; + set visited($n) 1; + set more_left 1; break; - } - } - if {$more_left == 0} then { - debug "no more left!"; - break; - } - } + } + } + if {$more_left == 0} then { + debug "no more left!"; + break; + } + } # take the first node from queue set i [lindex $queue 0]; set queue [lreplace $queue 0 0]; @@ -797,7 +797,7 @@ proc makePartitions {nvertices node_weight node_neighbour edge_array edge_weight lappend queue $ngb; };#if };#foreach - } + } };#while @@ -839,7 +839,7 @@ proc makePartitions {nvertices node_weight node_neighbour edge_array edge_weight for {set k 0} {$k < $nvertices} {incr k} { incr sum $nweight($k); } - + if {$pwgts2(0) + $pwgts2(1) != $sum} { error "refine: partition weigth wrong!"; } @@ -981,7 +981,7 @@ proc balance {nvertices node_neighbour node_weight edge_array edge_weight tpart_ #if it's no more boundary node if {$part_ed($hi_gain) == 0} then { - #remove it from the bndy list + #remove it from the bndy list set bndy [lreplace $part_boundary [lsearch $part_boundary $hi_gain] [lsearch $part_boundary $hi_gain]]; } @@ -989,42 +989,42 @@ proc balance {nvertices node_neighbour node_weight edge_array edge_weight tpart_ # go throught all neighbours of node "hi_gain" if {[info exists nneighbour($hi_gain)]} then { foreach ngb $nneighbour($hi_gain) { - set is_bnd_node $part_ed($ngb); #if the value is > 0, it is a boundary node - set edgeBetween [getEdgeBetween $hi_gain $ngb earray]; - if {$part_partition($ngb) == $move_to} then { - incr part_id($ngb) $eweight($edgeBetween); - incr part_ed($ngb) -$eweight($edgeBetween); - } else { - incr part_ed($ngb) $eweight($edgeBetween); - incr part_id($ngb) -$eweight($edgeBetween); - } + set is_bnd_node $part_ed($ngb); #if the value is > 0, it is a boundary node + set edgeBetween [getEdgeBetween $hi_gain $ngb earray]; + if {$part_partition($ngb) == $move_to} then { + incr part_id($ngb) $eweight($edgeBetween); + incr part_ed($ngb) -$eweight($edgeBetween); + } else { + incr part_ed($ngb) $eweight($edgeBetween); + incr part_id($ngb) -$eweight($edgeBetween); + } - if {$is_bnd_node > 0} then { - #node "ngb" is no longer an boundary node - if {$part_ed($ngb) == 0} then { - #remove it from the boundary list - set part_boundary [lreplace $part_boundary [lsearch $part_boundary $ngb] [lsearch $part_boundary $ngb]]; - if {$moved($ngb) == -1 && ($part_partition($ngb)==$move_from)} then { - #if not moved -> remove it from the queue - removeFromQueue queue($part_partition($ngb)) $ngb; - } - } else { - #if it wasn't been moved, update it in queue - if {$moved($ngb) == -1 && ($part_partition($ngb) == $move_from)} then { - removeFromQueue queue($part_partition($ngb)) $ngb; - set new_gain [expr {$part_ed($ngb) - $part_id($ngb)}]; - push queue($part_partition($ngb)) "$ngb $new_gain"; - } - } + if {$is_bnd_node > 0} then { + #node "ngb" is no longer an boundary node + if {$part_ed($ngb) == 0} then { + #remove it from the boundary list + set part_boundary [lreplace $part_boundary [lsearch $part_boundary $ngb] [lsearch $part_boundary $ngb]]; + if {$moved($ngb) == -1 && ($part_partition($ngb)==$move_from)} then { + #if not moved -> remove it from the queue + removeFromQueue queue($part_partition($ngb)) $ngb; + } + } else { + #if it wasn't been moved, update it in queue + if {$moved($ngb) == -1 && ($part_partition($ngb) == $move_from)} then { + removeFromQueue queue($part_partition($ngb)) $ngb; + set new_gain [expr {$part_ed($ngb) - $part_id($ngb)}]; + push queue($part_partition($ngb)) "$ngb $new_gain"; + } + } } else { ;#puts "not boundary node: $ngb"; - if {$part_ed($ngb) > 0} then { ;#new boundary node - lappend part_boundary $ngb; - #add it to the queue - if {$moved($ngb) == -1} then { - push queue($part_partition($ngb)) "$ngb [expr {$part_ed($ngb) - $part_id($ngb)}]"; - } - } - } + if {$part_ed($ngb) > 0} then { ;#new boundary node + lappend part_boundary $ngb; + #add it to the queue + if {$moved($ngb) == -1} then { + push queue($part_partition($ngb)) "$ngb [expr {$part_ed($ngb) - $part_id($ngb)}]"; + } + } + } } } } @@ -1056,12 +1056,12 @@ proc FMRefinement {nvertices node_neighbour node_weight edge_array edge_weight t upvar $node_weight nweight; upvar $node_neighbour nneighbour; - upvar $edge_array earray; - upvar $edge_weight eweight; + upvar $edge_array earray; + upvar $edge_weight eweight; upvar $tpart_wgt tpwgts; - array set queue {}; + array set queue {}; array set bak_id {}; array set bak_ed {}; array set bak_part {}; @@ -1082,15 +1082,15 @@ proc FMRefinement {nvertices node_neighbour node_weight edge_array edge_weight t set swap_limit 15; } - #pamti najbolju kombinaciju - set bak_bndy $part_boundary; - for {set i 0} {$i < $nvertices} {incr i} { - set bak_part($i) $part_partition($i); - set bak_id($i) $part_id($i); - set bak_ed($i) $part_ed($i); - } - set bak_pwgts(0) $part_pwgts(0); - set bak_pwgts(1) $part_pwgts(1); + #pamti najbolju kombinaciju + set bak_bndy $part_boundary; + for {set i 0} {$i < $nvertices} {incr i} { + set bak_part($i) $part_partition($i); + set bak_id($i) $part_id($i); + set bak_ed($i) $part_ed($i); + } + set bak_pwgts(0) $part_pwgts(0); + set bak_pwgts(1) $part_pwgts(1); # set all vertices free to move @@ -1187,7 +1187,7 @@ proc FMRefinement {nvertices node_neighbour node_weight edge_array edge_weight t if {[info exists nneighbour($hi_gain)]} then { foreach ngb $nneighbour($hi_gain) { set is_bnd_node $ed($ngb); #if the value is > 0, it is a boundary node - set edgeBetween [getEdgeBetween $hi_gain $ngb earray]; + set edgeBetween [getEdgeBetween $hi_gain $ngb earray]; if {$part($ngb) == $move_to} then { incr id($ngb) $eweight($edgeBetween); incr ed($ngb) -$eweight($edgeBetween); @@ -1410,7 +1410,7 @@ proc splitGraph {nvertices node_neighbour node_weight edge_array edge_weight sno incr snedges($p_i); } incr sum $nweight($ngb); - } else { + } else { incr sum [expr {-$nweight($ngb)}] } diff --git a/host.tcl b/host.tcl index 0525c51..e6ac8ce 100755 --- a/host.tcl +++ b/host.tcl @@ -1,4 +1,4 @@ -# $Id: host.tcl,v 1.14 2007/05/07 08:43:20 ana Exp $ +# $Id: host.tcl,v 1.15 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -152,14 +152,14 @@ proc $MODULE.bootcmd { node } { proc $MODULE.shellcmd { node } { set ret [nexec whereis -b bash] if { [llength $ret] == 2 } { - return [lindex $ret 1] + return [lindex $ret 1] } else { - set ret [nexec whereis -b tcsh] - if { [llength $ret] == 2 } { - return [lindex $ret 1] - } else { - return "/bin/sh" - } + set ret [nexec whereis -b tcsh] + if { [llength $ret] == 2 } { + return [lindex $ret 1] + } else { + return "/bin/sh" + } } } diff --git a/imunes.tcl b/imunes.tcl index b6b42cc..7488253 100755 --- a/imunes.tcl +++ b/imunes.tcl @@ -1,4 +1,4 @@ -# $Id: imunes.tcl,v 1.21 2007/06/12 10:47:37 ana Exp $ +# $Id: imunes.tcl,v 1.22 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -41,7 +41,7 @@ # Starts imunes in batch or interactive mode. Include procedures from # external files and initializes global variables. # -# imunes [-b|--batch] [filename] +# imunes [-b|--batch] [filename] # # When starting the program in batch mode the option -b or --batch must # be specified. @@ -169,7 +169,7 @@ set eid e0 # List can be overwritten in config file .imunesrc #***** -# IP port monitor_port +# IP port monitor_port set exec_hosts [list \ [list 192.168.1.100 2547 2548 false ] \ [list 10.0.0.1 1234 5678 false ] \ diff --git a/initgui.tcl b/initgui.tcl index 0452de4..2df5996 100755 --- a/initgui.tcl +++ b/initgui.tcl @@ -1,4 +1,4 @@ -# $Id: initgui.tcl,v 1.35 2007/05/07 08:43:20 ana Exp $ +# $Id: initgui.tcl,v 1.36 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -248,10 +248,10 @@ menu .menubar.canvas -tearoff 0 .menubar.canvas add command -label "Rename" -command renameCanvasPopup .menubar.canvas add command -label "Delete" -command { if { [llength $canvas_list] == 1 } { - return + return } foreach obj [.c find withtag node] { - selectNode .c $obj + selectNode .c $obj } deleteSelection set i [lsearch $canvas_list $curcanvas] @@ -365,7 +365,7 @@ menu .menubar.view -tearoff 0 set showNodeLabels 1 set showLinkLabels 1 redrawAllLinks - foreach object [.c find withtag linklabel] { + foreach object [.c find withtag linklabel] { .c itemconfigure $object -state normal } } @@ -377,7 +377,7 @@ menu .menubar.view -tearoff 0 set showNodeLabels 0 set showLinkLabels 0 redrawAllLinks - foreach object [.c find withtag linklabel] { + foreach object [.c find withtag linklabel] { .c itemconfigure $object -state hidden } } diff --git a/ipsec.tcl b/ipsec.tcl index 36c6954..aa3724f 100755 --- a/ipsec.tcl +++ b/ipsec.tcl @@ -1,4 +1,4 @@ -# $Id: ipsec.tcl,v 1.6 2007/07/11 13:33:19 test Exp $ +# $Id: ipsec.tcl,v 1.7 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -163,22 +163,22 @@ proc viewIpsecCfg { node delete view } { set ipsecCfgList [getIpsecConfig $node] set len [llength $ipsecCfgList] foreach ipsecCfg $ipsecCfgList { - set id [lindex [lsearch -inline $ipsecCfg "ipsec-config-id *"] 1] - lappend idlist $id + set id [lindex [lsearch -inline $ipsecCfg "ipsec-config-id *"] 1] + lappend idlist $id } if { $delete == "1" } { - set viewid [lindex $idlist 0] + set viewid [lindex $idlist 0] } if { $view == "0" } { - catch {unset viewid} + catch {unset viewid} } set ipsecCfg "" if { $view == "1" && $idlist == {} } { - set error "There are no ipsec-config entries with specified ipsec-config-id." - showIpsecErrors $error + set error "There are no ipsec-config entries with specified ipsec-config-id." + showIpsecErrors $error } else { @@ -1114,7 +1114,7 @@ proc checkSPrange { SPrange } { proc checkIPv46AddrPort { str } { if { $str == "" } { - return 1 + return 1 } set addr [lindex [split $str "\["] 0] set SAaddress [checkSAaddress $addr] @@ -1149,7 +1149,7 @@ proc checkIPv46AddrPort { str } { proc checkSAaddress { str } { if { $str == "" } { - return 1 + return 1 } if { [checkIPv4Addr $str] == 1 } { return 1 @@ -1175,7 +1175,7 @@ proc checkSAaddress { str } { proc checkSPnet { str } { if { $str == "" } { - return 1 + return 1 } if { [checkIPv4Net $str] == 1 } { return 1 diff --git a/ipv4.tcl b/ipv4.tcl index 023be9f..26a1130 100755 --- a/ipv4.tcl +++ b/ipv4.tcl @@ -1,4 +1,4 @@ -# $Id: ipv4.tcl,v 1.11 2007/05/07 08:43:20 ana Exp $ +# $Id: ipv4.tcl,v 1.12 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -58,20 +58,20 @@ proc findFreeIPv4Net { mask } { set ipnets {} foreach node $node_list { - foreach ifc [ifcList $node] { - set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2] - if {[lsearch $ipnets $ipnet] == -1} { - lappend ipnets $ipnet - } - } + foreach ifc [ifcList $node] { + set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2] + if {[lsearch $ipnets $ipnet] == -1} { + lappend ipnets $ipnet + } + } } for { set i 0 } { $i <= 255 } { incr i } { - for { set j 0 } { $j <= 255 } { incr j } { - if {[lsearch $ipnets "10 $i $j"] == -1} { - set ipnet "10.$i.$j" - return $ipnet - } - } + for { set j 0 } { $j <= 255 } { incr j } { + if {[lsearch $ipnets "10 $i $j"] == -1} { + set ipnet "10.$i.$j" + return $ipnet + } + } } } @@ -106,14 +106,14 @@ proc autoIPv4addr { node iface } { if { [[typemodel $peer_node].layer] == "LINK" } { foreach l2node [listLANnodes $peer_node {}] { - foreach ifc [ifcList $l2node] { + foreach ifc [ifcList $l2node] { set peer [logicalPeerByIfc $l2node $ifc] set peer_if [ifcByLogicalPeer $peer $l2node] set peer_ip4addr [getIfcIPv4addr $peer $peer_if] if { $peer_ip4addr != "" } { lappend peer_ip4addrs [lindex [split $peer_ip4addr /] 0] } - } + } } } else { set peer_if [ifcByLogicalPeer $peer_node $node] @@ -121,27 +121,27 @@ proc autoIPv4addr { node iface } { set peer_ip4addrs [lindex [split $peer_ip4addr /] 0] } switch -exact -- [nodeType $node] { - router { - set targetbyte 1 - } - host { - set targetbyte 10 - } - pc { - set targetbyte 20 - } + router { + set targetbyte 1 + } + host { + set targetbyte 10 + } + pc { + set targetbyte 20 + } } if { $peer_ip4addrs != "" } { - set ipnums [split [lindex $peer_ip4addrs 0] .] - set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]" - set ipaddr $net.$targetbyte - while { [lsearch $peer_ip4addrs $ipaddr] >= 0 } { - incr targetbyte - set ipaddr $net.$targetbyte - } - setIfcIPv4addr $node $iface "$ipaddr/24" + set ipnums [split [lindex $peer_ip4addrs 0] .] + set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]" + set ipaddr $net.$targetbyte + while { [lsearch $peer_ip4addrs $ipaddr] >= 0 } { + incr targetbyte + set ipaddr $net.$targetbyte + } + setIfcIPv4addr $node $iface "$ipaddr/24" } else { - setIfcIPv4addr $node $iface "[findFreeIPv4Net 24].$targetbyte/24" + setIfcIPv4addr $node $iface "[findFreeIPv4Net 24].$targetbyte/24" } } @@ -172,7 +172,7 @@ proc autoIPv4defaultroute { node iface } { if { [[typemodel $peer_node].layer] == "LINK" } { foreach l2node [listLANnodes $peer_node {}] { - foreach ifc [ifcList $l2node] { + foreach ifc [ifcList $l2node] { set peer [logicalPeerByIfc $l2node $ifc] if { [nodeType $peer] != "router" } { continue @@ -184,7 +184,7 @@ proc autoIPv4defaultroute { node iface } { setStatIPv4routes $node [list "0.0.0.0/0 $gw"] return } - } + } } } else { if { [nodeType $peer_node] != "router" } { @@ -219,29 +219,29 @@ proc autoIPv4defaultroute { node iface } { proc checkIPv4Addr { str } { set n 0 if { $str == "" } { - return 1 + return 1 } while { $n < 4 } { - if { $n < 3 } { - set i [string first . $str] - } else { - set i [string length $str] - } - if { $i < 1 } { - return 0 - } - set part [string range $str 0 [expr $i - 1]] - if { [string length [string trim $part]] != $i } { - return 0 - } - if { ![string is integer $part] } { - return 0 - } - if { $part < 0 || $part > 255 } { - return 0 - } - set str [string range $str [expr $i + 1] end] - incr n + if { $n < 3 } { + set i [string first . $str] + } else { + set i [string length $str] + } + if { $i < 1 } { + return 0 + } + set part [string range $str 0 [expr $i - 1]] + if { [string length [string trim $part]] != $i } { + return 0 + } + if { ![string is integer $part] } { + return 0 + } + if { $part < 0 || $part > 255 } { + return 0 + } + set str [string range $str [expr $i + 1] end] + incr n } return 1 } @@ -263,14 +263,14 @@ proc checkIPv4Addr { str } { proc checkIPv4Net { str } { if { $str == "" } { - return 1 + return 1 } if { ![checkIPv4Addr [lindex [split $str /] 0]]} { - return 0 + return 0 } set net [string trim [lindex [split $str /] 1]] if { [string length $net] == 0 } { - return 0 + return 0 } return [checkIntRange $net 0 32] } diff --git a/ipv6.tcl b/ipv6.tcl index 2a571ff..62aa8ac 100755 --- a/ipv6.tcl +++ b/ipv6.tcl @@ -1,4 +1,4 @@ -# $Id: ipv6.tcl,v 1.9 2007/05/07 08:43:20 ana Exp $ +# $Id: ipv6.tcl,v 1.10 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -58,18 +58,18 @@ proc findFreeIPv6Net { mask } { set ipnets {} foreach node $node_list { - foreach ifc [ifcList $node] { - set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 1] - if {[lsearch $ipnets $ipnet] == -1} { - lappend ipnets $ipnet - } - } + foreach ifc [ifcList $node] { + set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 1] + if {[lsearch $ipnets $ipnet] == -1} { + lappend ipnets $ipnet + } + } } for { set i 0 } { $i <= 9999 } { incr i } { - if {[lsearch $ipnets "a $i"] == -1} { - set ipnet "a:$i" - return $ipnet - } + if {[lsearch $ipnets "a $i"] == -1} { + set ipnet "a:$i" + return $ipnet + } } } @@ -95,14 +95,14 @@ proc autoIPv6addr { node iface } { if { [[typemodel $peer_node].layer] == "LINK" } { foreach l2node [listLANnodes $peer_node {}] { - foreach ifc [ifcList $l2node] { + foreach ifc [ifcList $l2node] { set peer [logicalPeerByIfc $l2node $ifc] set peer_if [ifcByLogicalPeer $peer $l2node] set peer_ip6addr [getIfcIPv6addr $peer $peer_if] if { $peer_ip6addr != "" } { lappend peer_ip6addrs [lindex [split $peer_ip6addr /] 0] } - } + } } } else { set peer_if [ifcByLogicalPeer $peer_node $node] @@ -110,27 +110,27 @@ proc autoIPv6addr { node iface } { set peer_ip6addrs [lindex [split $peer_ip6addr /] 0] } switch -exact -- [nodeType $node] { - router { - set targetbyte 1 - } - host { - set targetbyte 10 - } - pc { - set targetbyte 20 - } + router { + set targetbyte 1 + } + host { + set targetbyte 10 + } + pc { + set targetbyte 20 + } } if { $peer_ip6addrs != "" } { - set ipnums [split [lindex $peer_ip6addrs 0] :] - set net "[lindex $ipnums 0]:[lindex $ipnums 1]" - set ipaddr $net\::$targetbyte - while { [lsearch $peer_ip6addrs $ipaddr] >= 0 } { - incr targetbyte - set ipaddr $net\::$targetbyte - } - setIfcIPv6addr $node $iface "$ipaddr/64" + set ipnums [split [lindex $peer_ip6addrs 0] :] + set net "[lindex $ipnums 0]:[lindex $ipnums 1]" + set ipaddr $net\::$targetbyte + while { [lsearch $peer_ip6addrs $ipaddr] >= 0 } { + incr targetbyte + set ipaddr $net\::$targetbyte + } + setIfcIPv6addr $node $iface "$ipaddr/64" } else { - setIfcIPv6addr $node $iface "[findFreeIPv6Net 64]::$targetbyte/64" + setIfcIPv6addr $node $iface "[findFreeIPv6Net 64]::$targetbyte/64" } } @@ -207,32 +207,32 @@ proc checkIPv6Addr { str } { set wordlist [split $str :] set wordcnt [expr [llength $wordlist] - 1] if { $wordcnt < 2 || $wordcnt > 7 } { - return 0 + return 0 } if { [lindex $wordlist 0] == "" } { - set wordlist [lreplace $wordlist 0 0 0] + set wordlist [lreplace $wordlist 0 0 0] } if { [lindex $wordlist $wordcnt] == "" } { - set wordlist [lreplace $wordlist $wordcnt $wordcnt 0] + set wordlist [lreplace $wordlist $wordcnt $wordcnt 0] } for { set i 0 } { $i <= $wordcnt } { incr i } { - set word [lindex $wordlist $i] - if { $word == "" } { - if { $doublec == "true" } { - return 0 - } - set doublec true - } - if { [string length $word] > 4 } { - if { $i == $wordcnt } { - return [checkIPv4Addr $word] - } else { - return 0 - } - } - if { [string is xdigit $word] == 0 } { - return 0 - } + set word [lindex $wordlist $i] + if { $word == "" } { + if { $doublec == "true" } { + return 0 + } + set doublec true + } + if { [string length $word] > 4 } { + if { $i == $wordcnt } { + return [checkIPv4Addr $word] + } else { + return 0 + } + } + if { [string is xdigit $word] == 0 } { + return 0 + } } return 1 } @@ -253,14 +253,14 @@ proc checkIPv6Addr { str } { proc checkIPv6Net { str } { if { $str == "" } { - return 1 + return 1 } if { ![checkIPv6Addr [lindex [split $str /] 0]]} { - return 0 + return 0 } set net [string trim [lindex [split $str /] 1]] if { [string length $net] == 0 } { - return 0 + return 0 } return [checkIntRange $net 0 128] } diff --git a/linkcfg.tcl b/linkcfg.tcl index 1f30719..c1e11d6 100755 --- a/linkcfg.tcl +++ b/linkcfg.tcl @@ -1,4 +1,4 @@ -# $Id: linkcfg.tcl,v 1.15 2007/05/07 08:43:20 ana Exp $ +# $Id: linkcfg.tcl,v 1.16 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -141,19 +141,19 @@ proc removeLink { link } { set pnodes [linkPeers $link] foreach node $pnodes { - global $node - set i [lsearch $pnodes $node] - set peer [lreplace $pnodes $i $i] - set ifc [ifcByPeer $node $peer] - netconfClearSection $node "interface $ifc" - set i [lsearch [set $node] "interface-peer {$ifc $peer}"] - set $node [lreplace [set $node] $i $i] - if { [[typemodel $node].layer] == "NETWORK" } { - set ifcs [ifcList $node] - foreach ifc $ifcs { - autoIPv4defaultroute $node $ifc - } - } + global $node + set i [lsearch $pnodes $node] + set peer [lreplace $pnodes $i $i] + set ifc [ifcByPeer $node $peer] + netconfClearSection $node "interface $ifc" + set i [lsearch [set $node] "interface-peer {$ifc $peer}"] + set $node [lreplace [set $node] $i $i] + if { [[typemodel $node].layer] == "NETWORK" } { + set ifcs [ifcList $node] + foreach ifc $ifcs { + autoIPv4defaultroute $node $ifc + } + } } set i [lsearch -exact $link_list $link] set link_list [lreplace $link_list $i $i] @@ -323,10 +323,10 @@ proc getLinkDelayString { link } { } elseif { $delay >= 1000 } { set delstr "[expr {$delay * .001}] ms" } else { - set delstr "$delay us" + set delstr "$delay us" } } else { - set delstr "" + set delstr "" } return $delstr } diff --git a/nodecfg.tcl b/nodecfg.tcl index 04f1505..cab3ff3 100755 --- a/nodecfg.tcl +++ b/nodecfg.tcl @@ -1,4 +1,4 @@ -# $Id: nodecfg.tcl,v 1.17 2007/05/07 08:43:20 ana Exp $ +# $Id: nodecfg.tcl,v 1.18 2007/07/19 01:17:05 marko Exp $ # # Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved. # @@ -383,7 +383,7 @@ proc getCustomConfig { node } { } else { set values [lsearch -all -inline [set $node] "custom-config *"] foreach val $values { - lappend customCfgList [lindex $val 1] + lappend customCfgList [lindex $val 1] } } @@ -567,7 +567,7 @@ proc netconfInsertSection { node section } { lappend section "!" } foreach line $section { - set netconf [linsert $netconf $lnum_beg $line] + set netconf [linsert $netconf $lnum_beg $line] if { $lnum_beg != "end" } { incr lnum_beg } @@ -618,10 +618,10 @@ proc setIfcOperState { node ifc state } { lappend ifcfg " shutdown" } foreach line [netconfFetchSection $node "interface $ifc"] { - if { [lindex $line 0] != "shutdown" && \ + if { [lindex $line 0] != "shutdown" && \ [lrange $line 0 1] != "no shutdown" } { - lappend ifcfg $line - } + lappend ifcfg $line + } } netconfInsertSection $node $ifcfg } @@ -675,10 +675,10 @@ proc setIfcQDisc { node ifc qdisc } { lappend ifcfg " drr-queue" } foreach line [netconfFetchSection $node "interface $ifc"] { - if { [lindex $line 0] != "fair-queue" && \ + if { [lindex $line 0] != "fair-queue" && \ [lindex $line 0] != "drr-queue" } { - lappend ifcfg $line - } + lappend ifcfg $line + } } netconfInsertSection $node $ifcfg } @@ -828,9 +828,9 @@ proc getIfcMTU { node ifc } { proc setIfcMTU { node ifc mtu } { set ifcfg [list "interface $ifc"] foreach line [netconfFetchSection $node "interface $ifc"] { - if { [lindex $line 0] != "mtu" } { - lappend ifcfg $line - } + if { [lindex $line 0] != "mtu" } { + lappend ifcfg $line + } } switch -exact [string range $ifc 0 2] { eth { set limit 1500 } @@ -883,9 +883,9 @@ proc getIfcIPv4addr { node ifc } { proc setIfcIPv4addr { node ifc addr } { set ifcfg [list "interface $ifc"] foreach line [netconfFetchSection $node "interface $ifc"] { - if { [lrange $line 0 1] != "ip address" } { - lappend ifcfg $line - } + if { [lrange $line 0 1] != "ip address" } { + lappend ifcfg $line + } } if { $addr != "" } { lappend ifcfg " ip address $addr" @@ -934,9 +934,9 @@ proc getIfcIPv6addr { node ifc } { proc setIfcIPv6addr { node ifc addr } { set ifcfg [list "interface $ifc"] foreach line [netconfFetchSection $node "interface $ifc"] { - if { [lrange $line 0 1] != "ipv6 address" } { - lappend ifcfg $line - } + if { [lrange $line 0 1] != "ipv6 address" } { + lappend ifcfg $line + } } if { $addr != "" } { lappend ifcfg " ipv6 address $addr" @@ -1397,7 +1397,7 @@ proc ifcByLogicalPeer { node peer } { # Must search through pseudo peers # foreach ifc [ifcList $node] { - set t_peer [peerByIfc $node $ifc] + set t_peer [peerByIfc $node $ifc] if { [nodeType $t_peer] == "pseudo" } { set mirror [getNodeMirror $t_peer] if { [peerByIfc $mirror [ifcList $mirror]] == $peer } { @@ -1473,9 +1473,9 @@ proc removeNode { node } { global node_list $node foreach ifc [ifcList $node] { - set peer [peerByIfc $node $ifc] + set peer [peerByIfc $node $ifc] set link [linkByPeers $node $peer] - removeLink $link + removeLink $link } set i [lsearch -exact $node_list $node] set node_list [lreplace $node_list $i $i] diff --git a/pc.tcl b/pc.tcl index 0700000..5a005e5 100755 --- a/pc.tcl +++ b/pc.tcl @@ -1,4 +1,4 @@ -# $Id: pc.tcl,v 1.14 2007/05/07 08:43:20 ana Exp $ +# $Id: pc.tcl,v 1.15 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -146,14 +146,14 @@ proc $MODULE.bootcmd { node } { proc $MODULE.shellcmd { node } { set ret [nexec whereis -b bash] if { [llength $ret] == 2 } { - return [lindex $ret 1] + return [lindex $ret 1] } else { - set ret [nexec whereis -b tcsh] - if { [llength $ret] == 2 } { - return [lindex $ret 1] - } else { - return "/bin/sh" - } + set ret [nexec whereis -b tcsh] + if { [llength $ret] == 2 } { + return [lindex $ret 1] + } else { + return "/bin/sh" + } } } diff --git a/static.tcl b/static.tcl index dab8fd3..1f7a40b 100755 --- a/static.tcl +++ b/static.tcl @@ -1,4 +1,4 @@ -# $Id: static.tcl,v 1.14 2007/05/07 08:43:20 ana Exp $ +# $Id: static.tcl,v 1.15 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -154,14 +154,14 @@ proc $MODULE.bootcmd { node } { proc $MODULE.shellcmd { node } { set ret [nexec whereis -b bash] if { [llength $ret] == 2 } { - return [lindex $ret 1] + return [lindex $ret 1] } else { - set ret [nexec whereis -b tcsh] - if { [llength $ret] == 2 } { - return [lindex $ret 1] - } else { - return "/bin/sh" - } + set ret [nexec whereis -b tcsh] + if { [llength $ret] == 2 } { + return [lindex $ret 1] + } else { + return "/bin/sh" + } } } diff --git a/xorp.tcl b/xorp.tcl index 182d958..2ee98b8 100755 --- a/xorp.tcl +++ b/xorp.tcl @@ -1,4 +1,4 @@ -# $Id: xorp.tcl,v 1.20 2007/05/07 08:43:20 ana Exp $ +# $Id: xorp.tcl,v 1.21 2007/07/19 01:17:05 marko Exp $ # # Copyright 2005 University of Zagreb, Croatia. All rights reserved. # @@ -99,12 +99,12 @@ proc $MODULE.cfggen { node } { set ipv6mask "[lindex [split [getIfcIPv6addr $node $ifc] /] 1]" lappend cfg " interface $ifc {" lappend cfg " vif $ifc {" - if { $ipv4addr != "" } { + if { $ipv4addr != "" } { lappend cfg " address $ipv4addr {" lappend cfg " prefix-length: $ipv4mask" lappend cfg " }" } - if { $ipv6addr != "" } { + if { $ipv6addr != "" } { lappend cfg " address $ipv6addr {" lappend cfg " prefix-length: $ipv6mask" lappend cfg " }" @@ -150,7 +150,7 @@ proc $MODULE.cfggen { node } { lappend cfg " export: \"connected\"" foreach ifc [ifcList $node] { set addr "[lindex [split [getIfcIPv4addr $node $ifc] /] 0]" - if { $addr != "" } { + if { $addr != "" } { lappend cfg " interface $ifc {" lappend cfg " vif $ifc {" lappend cfg " address $addr {" @@ -171,7 +171,7 @@ proc $MODULE.cfggen { node } { lappend cfg " export: \"connected\"" foreach ifc [ifcList $node] { set addr "[lindex [split [getIfcIPv6addr $node $ifc] /] 0]" - if { $addr != "" } { + if { $addr != "" } { lappend cfg " interface $ifc {" lappend cfg " vif $ifc {" lappend cfg " address $addr {" -- 2.39.5