# 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
}
# do nothing, return, if coords are empty
if { $target == 0 && [$c coords "$newoval"] == "" } {
- return
+ return
}
set wi .popup
catch {destroy $wi}
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
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
pack $wi.butt.cancel $wi.butt.apply -side right
pack $wi.butt -side bottom
after 100 {
- grab .popup
+ grab .popup
}
return
}
# 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 {}
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 .]
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"
}
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]
#****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
# * 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
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 }]
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}]
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"
}
# do nothing, return, if coords are empty
if { $rectangle == 0 && [$c coords "$newrect"] == "" } {
- return
+ return
}
set wi .popup
catch {destroy $wi}
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
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
pack $wi.butt.cancel $wi.butt.apply -side right
pack $wi.butt -side bottom
after 100 {
- grab .popup
+ grab .popup
}
return
}
# 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
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]
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]
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
}
}
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
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
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:"
# 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 "
pack $wi.action.apply $wi.action.cancel -side left ;# -fill x
after 100 {
- grab .popup
+ grab .popup
}
return
}
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"
# 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
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]"
}
}
-# $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.
#
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 \{"
}
}
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"
}
}
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 ""
}
lappend canvas_list $object
}
if {"$class" == "option"} {
- # for future use
+ # for future use
lappend prefs $object
}
continue
}
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 {
}
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"
}
} 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 ""
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
}
-# $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
#
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
}
}
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]
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]
-# $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.
#
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]
} 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
}
.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
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 } {
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)" \
[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
}
} 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}]
switch -exact -- $object_type {
node {
- set type [nodeType $target]
- if { $type == "pseudo" } {
+ set type [nodeType $target]
+ if { $type == "pseudo" } {
#
# Hyperlink to another canvas
#
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" } {
}
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
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
#
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
#
$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
}
}
set edit 1
if { $deleted == "1" } {
- set viewcustomid [lindex $customidlist 0]
+ set viewcustomid [lindex $customidlist 0]
}
if { $customidlist == "" } {
# 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
}
}
- 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
}
}
if { $changed == 1 } {
redrawAll
- updateUndoLog
+ updateUndoLog
}
destroy $wi
}
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]
}
}
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}]
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
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
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
# }
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"
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
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
-# $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.
#
global execSock
if { $remote_exec } {
- if { ![info exists execSock] || $execSock == "" } {
- remoteStart
+ if { ![info exists execSock] || $execSock == "" } {
+ remoteStart
}
}
if { $remote_exec } {
rexec $execSock $args
} else {
- eval exec $args
+ eval exec $args
}
}
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
}
.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
}
global execMode
if {$execMode == "batch"} {
- puts $line
+ puts $line
} else {
- .bottom.textbox config -text "$line"
- animateCursor
+ .bottom.textbox config -text "$line"
+ animateCursor
}
}
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
}
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
}
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 {
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
}
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]
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
}
}
catch { set sock [socket $rHost $rPort] }
}
if { [info exists sock] } {
- return $sock
+ return $sock
} else {
return ""
}
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
}
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]
set remote_exec true
set exec_host $rHost
break
- }
+ }
}
if { ! $remote_exec } { return }
}
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
}
-# $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
#######
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"
}
}
-# $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.
#
set currentFile ""
set fileTypes {{"IMUNES network configuration" {.imn} }
- { "All files" {*}}}
+ { "All files" {*}}}
#****f* filemgmt.tcl/newFile
set fileId [open $currentFile r]
set cfg ""
foreach entry [read $fileId] {
- lappend cfg $entry
+ lappend cfg $entry
}
close $fileId
loadCfg $cfg
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"
}
}
global currentFile
if { $argv != "" } {
- set currentFile $argv
- openFile
+ set currentFile $argv
+ openFile
}
}
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
+ }
}
}
global fileTypes
set selectedFile [tk_getOpenFile -filetypes $fileTypes]
if { $selectedFile != ""} {
- set currentFile $selectedFile
- openFile
+ set currentFile $selectedFile
+ openFile
}
}
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
}
}
global currentFile
global fileTypes
set selectedFile [tk_getSaveFile -filetypes $fileTypes -initialfile\
- untitled -defaultextension .imn]
+ untitled -defaultextension .imn]
saveFile $selectedFile
}
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"
+ }
+ }
}
}
global partition_list
readNodeWeights;
-
+
set wi .popup
toplevel $wi
wm transient $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
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);
}
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;
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;
}
}
}
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);
}
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);
}
#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;
set cnode $nmap($parent1);
if {[lsearch $used_nodes $cnode] > -1} {
- continue;
+ continue;
}
lappend used_nodes $cnode;
# 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;
} 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;
}
}
}
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];
lappend queue $ngb;
};#if
};#foreach
- }
+ }
};#while
for {set k 0} {$k < $nvertices} {incr k} {
incr sum $nweight($k);
}
-
+
if {$pwgts2(0) + $pwgts2(1) != $sum} {
error "refine: partition weigth wrong!";
}
#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]];
}
# 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)}]";
+ }
+ }
+ }
}
}
}
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 {};
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
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);
incr snedges($p_i);
}
incr sum $nweight($ngb);
- } else {
+ } else {
incr sum [expr {-$nweight($ngb)}]
}
-# $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.
#
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"
+ }
}
}
-# $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.
#
# 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.
# 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 ] \
-# $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.
#
.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]
set showNodeLabels 1
set showLinkLabels 1
redrawAllLinks
- foreach object [.c find withtag linklabel] {
+ foreach object [.c find withtag linklabel] {
.c itemconfigure $object -state normal
}
}
set showNodeLabels 0
set showLinkLabels 0
redrawAllLinks
- foreach object [.c find withtag linklabel] {
+ foreach object [.c find withtag linklabel] {
.c itemconfigure $object -state hidden
}
}
-# $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.
#
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 {
proc checkIPv46AddrPort { str } {
if { $str == "" } {
- return 1
+ return 1
}
set addr [lindex [split $str "\["] 0]
set SAaddress [checkSAaddress $addr]
proc checkSAaddress { str } {
if { $str == "" } {
- return 1
+ return 1
}
if { [checkIPv4Addr $str] == 1 } {
return 1
proc checkSPnet { str } {
if { $str == "" } {
- return 1
+ return 1
}
if { [checkIPv4Net $str] == 1 } {
return 1
-# $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.
#
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
+ }
+ }
}
}
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]
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"
}
}
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
setStatIPv4routes $node [list "0.0.0.0/0 $gw"]
return
}
- }
+ }
}
} else {
if { [nodeType $peer_node] != "router" } {
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
}
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]
}
-# $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.
#
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
+ }
}
}
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]
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"
}
}
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
}
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]
}
-# $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.
#
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]
} 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
}
-# $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.
#
} else {
set values [lsearch -all -inline [set $node] "custom-config *"]
foreach val $values {
- lappend customCfgList [lindex $val 1]
+ lappend customCfgList [lindex $val 1]
}
}
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
}
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
}
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
}
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 }
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"
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"
# 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 } {
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]
-# $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.
#
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"
+ }
}
}
-# $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.
#
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"
+ }
}
}
-# $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.
#
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 " }"
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 {"
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 {"
projects / imunes.git / commitdiff