From: ana Date: Fri, 12 Jan 2007 22:43:34 +0000 (+0000) Subject: IPsec configuration. X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=3a94658cd37714eb6a26036815c66dad21542674;p=imunes.git IPsec configuration. Bug found by: Submitted by: Requested by: Reviewed by: Approved by: Obtained from: --- diff --git a/cfgparse.tcl b/cfgparse.tcl index 3dcdd03..c92576a 100755 --- a/cfgparse.tcl +++ b/cfgparse.tcl @@ -99,19 +99,27 @@ proc dumpCfg {method dest} { dumpputs $method $dest "node $node \{" foreach element $lnode { if { "[lindex $element 0]" == "network-config" } { - dumpputs $method $dest " network-config \{" - foreach line [lindex $element 1] { - dumpputs $method $dest " $line" - } - dumpputs $method $dest " \}" + dumpputs $method $dest " network-config \{" + foreach line [lindex $element 1] { + dumpputs $method $dest " $line" + } + dumpputs $method $dest " \}" } elseif { "[lindex $element 0]" == "custom-config" } { - dumpputs $method $dest " custom-config \{" - foreach line [lindex $element 1] { - dumpputs $method $dest " $line" - } - dumpputs $method $dest " \}" - } else { - dumpputs $method $dest " $element" + dumpputs $method $dest " custom-config \{" + foreach line [lindex $element 1] { + dumpputs $method $dest " $line" + } + 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" + } + } + dumpputs $method $dest " \}" + } else { + dumpputs $method $dest " $element" } } dumpputs $method $dest "\}" @@ -221,9 +229,11 @@ proc loadCfg { cfg } { set line [lreplace $line 0 0] continue } + set value [lindex $line 1] - set line [lreplace $line 0 1] - if {"$class" == "node"} { + set line [lreplace $line 0 1] + + if {"$class" == "node"} { switch -exact -- $field { type { lappend $object "type $value" @@ -258,17 +268,40 @@ proc loadCfg { cfg } { custom-command { lappend $object "custom-command {$value}" } + add-custom-command { + lappend $object "add-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}" + } + add-custom-config { + lappend $object "add-custom-config {$value}" + } + ipsec-enabled { + lappend $object "ipsec-enabled $value" + } + ipsec-config { + set cfg "" + + lappend cfg "name $value" + foreach zline [split $value { +}] { + if { [string index "$zline" 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}" + lappend $object "ipsec-config {$cfg}" } iconcoords { lappend $object "iconcoords {$value}" diff --git a/editor.tcl b/editor.tcl index c24f957..89744b3 100755 --- a/editor.tcl +++ b/editor.tcl @@ -49,16 +49,16 @@ proc animateCursor {} { global clock_seconds if { [clock seconds] == $clock_seconds } { - update - return + update + return } set clock_seconds [clock seconds] if { $cursorState } { - .c config -cursor watch - set cursorState 0 + .c config -cursor watch + set cursorState 0 } else { - .c config -cursor pirate - set cursorState 1 + .c config -cursor pirate + set cursorState 1 } update return @@ -86,24 +86,24 @@ proc removeGUILink { link atomic } { set node1 [lindex $nodes 0] set node2 [lindex $nodes 1] if { [nodeType $node1] == "pseudo" } { - removeLink [getLinkMirror $link] - removeLink $link - removeNode [getNodeMirror $node1] - removeNode $node1 - .c delete $node1 + removeLink [getLinkMirror $link] + removeLink $link + removeNode [getNodeMirror $node1] + removeNode $node1 + .c delete $node1 } elseif { [nodeType $node2] == "pseudo" } { - removeLink [getLinkMirror $link] - removeLink $link - removeNode [getNodeMirror $node2] - removeNode $node2 - .c delete $node2 + removeLink [getLinkMirror $link] + removeLink $link + removeNode [getNodeMirror $node2] + removeNode $node2 + .c delete $node2 } else { - removeLink $link + removeLink $link } .c delete $link if { $atomic == "atomic" } { - set changed 1 - updateUndoLog + set changed 1 + updateUndoLog } return } @@ -123,13 +123,13 @@ proc removeGUILink { link atomic } { proc removeGUINode { node } { set type [nodeType $node] foreach ifc [ifcList $node] { - set peer [peerByIfc $node $ifc] - set link [lindex [.c gettags "link && $node && $peer"] 1] - removeGUILink $link non-atomic + set peer [peerByIfc $node $ifc] + set link [lindex [.c gettags "link && $node && $peer"] 1] + removeGUILink $link non-atomic } if { $type != "pseudo" } { - removeNode $node - .c delete $node + removeNode $node + .c delete $node } return } @@ -148,13 +148,13 @@ proc updateUndoLog {} { global changed undolog undolevel redolevel if { $changed } { - global t_undolog undolog - set t_undolog "" - dumpCfg string t_undolog - incr undolevel - set undolog($undolevel) $t_undolog - set redolevel $undolevel - set changed 0 + global t_undolog undolog + set t_undolog "" + dumpCfg string t_undolog + incr undolevel + set undolog($undolevel) $t_undolog + set redolevel $undolevel + set changed 0 } return } @@ -173,9 +173,9 @@ proc undo {} { global undolevel undolog oper_mode if {$oper_mode == "edit" && $undolevel > 0} { - incr undolevel -1 - loadCfg $undolog($undolevel) - switchCanvas none + incr undolevel -1 + loadCfg $undolog($undolevel) + switchCanvas none } return } @@ -196,9 +196,9 @@ proc redo {} { global undolevel redolevel undolog oper_mode if {$oper_mode == "edit" && $redolevel > $undolevel} { - incr undolevel - loadCfg $undolog($undolevel) - switchCanvas none + incr undolevel + loadCfg $undolog($undolevel) + switchCanvas none } return } @@ -218,23 +218,23 @@ proc redrawAll {} { .c delete all set background [.c create rectangle 0 0 $sizex $sizey \ - -fill white -tags "background"] + -fill white -tags "background"] .c lower $background foreach node $node_list { - if { [getNodeCanvas $node] == $curcanvas } { - drawNode $node - } + if { [getNodeCanvas $node] == $curcanvas } { + drawNode $node + } } foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { - continue - } - drawLink $link - redrawLink $link - updateLinkLabel $link + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { + continue + } + drawLink $link + redrawLink $link + updateLinkLabel $link } return } @@ -264,35 +264,35 @@ proc drawNode { node } { set x [lindex $coords 0] set y [lindex $coords 1] .c create image $x $y -image [set $type] \ - -tags "node $node" + -tags "node $node" set coords [getNodeLabelCoords $node] set x [lindex $coords 0] set y [lindex $coords 1] if { [nodeType $node] != "pseudo" } { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $node]" \ - -tags "nodelabel $node"] + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $node]" \ + -tags "nodelabel $node"] + } else { + set pnode [getNodeName $node] + set pcanvas [getNodeCanvas $pnode] + set ifc [ifcByPeer $pnode [getNodeMirror $node]] + if { $pcanvas != $curcanvas } { + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $pnode]:$ifc @[getCanvasName $pcanvas]" \ + -tags "nodelabel $node" -justify center] } else { - set pnode [getNodeName $node] - set pcanvas [getNodeCanvas $pnode] - set ifc [ifcByPeer $pnode [getNodeMirror $node]] - if { $pcanvas != $curcanvas } { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $pnode]:$ifc @[getCanvasName $pcanvas]" \ - -tags "nodelabel $node" -justify center] - } else { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $pnode]:$ifc" \ - -tags "nodelabel $node" -justify center] - } + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $pnode]:$ifc" \ + -tags "nodelabel $node" -justify center] + } } if { $showNodeLabels == 0} { - .c itemconfigure $label -state hidden + .c itemconfigure $label -state hidden } # XXX Invisible pseudo-node labels global invisible if { $invisible == 1 && [nodeType $node] == "pseudo" } { - .c itemconfigure $label -state hidden + .c itemconfigure $label -state hidden } return } @@ -317,24 +317,24 @@ proc drawLink { link } { set lnode1 [lindex $nodes 0] set lnode2 [lindex $nodes 1] if { [getLinkMirror $link] != "" } { - set newlink [.c create line 0 0 0 0 \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link $link $lnode1 $lnode2" \ - -arrow both] + set newlink [.c create line 0 0 0 0 \ + -fill $defLinkColor -width $defLinkWidth \ + -tags "link $link $lnode1 $lnode2" \ + -arrow both] } else { - set newlink [.c create line 0 0 0 0 \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link $link $lnode1 $lnode2"] + set newlink [.c create line 0 0 0 0 \ + -fill $defLinkColor -width $defLinkWidth \ + -tags "link $link $lnode1 $lnode2"] } # XXX Invisible pseudo-liks global invisible if { $invisible == 1 && [getLinkMirror $link] != "" } { - .c itemconfigure $link -state hidden + .c itemconfigure $link -state hidden } .c raise $newlink background set newlink [.c create line 0 0 0 0 \ - -fill white -width [expr $defLinkWidth * 3 ] \ - -tags "link $link $lnode1 $lnode2"] + -fill white -width [expr $defLinkWidth * 3 ] \ + -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 @@ -364,33 +364,33 @@ proc chooseIfName { lnode1 lnode2 } { global $lnode1 $lnode2 switch -exact -- [nodeType $lnode1] { - pc { - return eth - } - host { - return eth - } - hub { - return e - } - lanswitch { - return e - } - frswitch { - return f - } - router { - if { [nodeType $lnode2] == "router" || \ - [nodeType $lnode2] == "frswitch" } { - #return ser - return eth - } else { - return eth - } - } - rj45 { - return - } + pc { + return eth + } + host { + return eth + } + hub { + return e + } + lanswitch { + return e + } + frswitch { + return f + } + router { + if { [nodeType $lnode2] == "router" || \ + [nodeType $lnode2] == "frswitch" } { + #return ser + return eth + } else { + return eth + } + } + rj45 { + return + } } } @@ -413,13 +413,13 @@ proc chooseIfName { lnode1 lnode2 } { proc listLANnodes { l2node l2peers } { lappend l2peers $l2node foreach ifc [ifcList $l2node] { - set peer [logicalPeerByIfc $l2node $ifc] - set type [nodeType $peer] - if { [ lsearch {lanswitch hub} $type] != -1 } { - if { [lsearch $l2peers $peer] == -1 } { - set l2peers [listLANnodes $peer $l2peers] - } - } + set peer [logicalPeerByIfc $l2node $ifc] + set type [nodeType $peer] + if { [ lsearch {lanswitch hub} $type] != -1 } { + if { [lsearch $l2peers $peer] == -1 } { + set l2peers [listLANnodes $peer $l2peers] + } + } } return $l2peers } @@ -442,42 +442,42 @@ proc calcDxDy { lnode } { upvar dy y switch -exact -- [nodeType $lnode] { - frswitch { - set x 1.8 - set y 1.8 - } - hub { - set x 1.5 - set y 2.6 - } - lanswitch { - set x 1.5 - set y 2.6 - } - router { - set x 1 - set y 2 - } - pc { - if { $showIfIPaddrs || $showIfIPv6addrs } { - set x 1.1 - } else { - set x 1.4 - } - set y 1.5 - } - host { - if { $showIfIPaddrs || $showIfIPv6addrs } { - set x 1.0 - } else { - set x 1.5 - } - set y 1.5 - } - rj45 { - set x 1 - set y 1 - } + frswitch { + set x 1.8 + set y 1.8 + } + hub { + set x 1.5 + set y 2.6 + } + lanswitch { + set x 1.5 + set y 2.6 + } + router { + set x 1 + set y 2 + } + pc { + if { $showIfIPaddrs || $showIfIPv6addrs } { + set x 1.1 + } else { + set x 1.4 + } + set y 1.5 + } + host { + if { $showIfIPaddrs || $showIfIPv6addrs } { + set x 1.0 + } else { + set x 1.5 + } + set y 1.5 + } + rj45 { + set x 1 + set y 1 + } } return } @@ -504,26 +504,26 @@ proc updateIfcLabel { lnode1 lnode2 } { set ifipv4addr [getIfcIPv4addr $lnode1 $ifc] set ifipv6addr [getIfcIPv6addr $lnode1 $ifc] if { $ifc == 0 } { - set ifc "" + set ifc "" } if { [getIfcOperState $lnode1 $ifc] == "down" } { - set labelstr "*" + set labelstr "*" } else { - set labelstr "" + set labelstr "" } if { $showIfNames } { - set labelstr "$labelstr$ifc " + set labelstr "$labelstr$ifc " } if { $showIfIPaddrs && $ifipv4addr != "" } { - set labelstr "$labelstr$ifipv4addr " + set labelstr "$labelstr$ifipv4addr " } if { $showIfIPv6addrs && $ifipv6addr != "" } { - set labelstr "$labelstr$ifipv6addr " + set labelstr "$labelstr$ifipv6addr " } set labelstr \ - [string range $labelstr 0 [expr [string length $labelstr] - 2]] + [string range $labelstr 0 [expr [string length $labelstr] - 2]] .c itemconfigure "interface && $lnode1 && $link" \ - -text "$labelstr" + -text "$labelstr" return } @@ -548,20 +548,20 @@ proc updateLinkLabel { link } { set dup [getLinkDup $link] set labelstr "$labelstr[getLinkBandwidthString $link] " if { "$delstr" != "" } { - set labelstr "$labelstr$delstr " + set labelstr "$labelstr$delstr " } if { "$ber" != "" } { - set berstr "ber=$ber" - set labelstr "$labelstr$berstr " + set berstr "ber=$ber" + set labelstr "$labelstr$berstr " } if { "$dup" != "" } { - set dupstr "dup=$dup%" - set labelstr "$labelstr$dupstr " + set dupstr "dup=$dup%" + set labelstr "$labelstr$dupstr " } set labelstr [string range $labelstr 0 [expr [string length $labelstr] - 2]] .c itemconfigure "linklabel && $link" -text "$labelstr" if { $showLinkLabels == 0} { - .c itemconfigure "linklabel && $link" -state hidden + .c itemconfigure "linklabel && $link" -state hidden } return } @@ -579,12 +579,12 @@ proc redrawAllLinks {} { global link_list curcanvas foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { - continue - } - redrawLink $link + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { + continue + } + redrawLink $link } return } @@ -626,7 +626,7 @@ proc redrawLink { link } { .c coords "linklabel && $link" $lx $ly set n [expr sqrt (($x1 - $x2) * ($x1 - $x2) + \ - ($y1 - $y2) * ($y1 - $y2)) * 0.015] + ($y1 - $y2) * ($y1 - $y2)) * 0.015] if { $n < 1 } { set n 1 } calcDxDy $lnode1 @@ -679,9 +679,9 @@ proc splitGUILink { link } { set y2 [lindex [getNodeCoords $orig_node2] 1] setNodeCoords $new_node1 \ - "[expr $x1 + 0.4 * ($x2 - $x1)] [expr $y1 + 0.4 * ($y2 - $y1)]" + "[expr $x1 + 0.4 * ($x2 - $x1)] [expr $y1 + 0.4 * ($y2 - $y1)]" setNodeCoords $new_node2 \ - "[expr $x1 + 0.6 * ($x2 - $x1)] [expr $y1 + 0.6 * ($y2 - $y1)]" + "[expr $x1 + 0.6 * ($x2 - $x1)] [expr $y1 + 0.6 * ($y2 - $y1)]" setNodeLabelCoords $new_node1 [getNodeCoords $new_node1] setNodeLabelCoords $new_node2 [getNodeCoords $new_node2] @@ -707,9 +707,9 @@ proc selectNode { c obj } { set node [lindex [$c gettags $obj] 1] $c addtag selected withtag "node && $node" if { [nodeType $node] == "pseudo" } { - set bbox [$c bbox "nodelabel && $node"] + set bbox [$c bbox "nodelabel && $node"] } else { - set bbox [$c bbox "node && $node"] + set bbox [$c bbox "node && $node"] } set bx1 [expr [lindex $bbox 0] - 2] set by1 [expr [lindex $bbox 1] - 2] @@ -717,7 +717,7 @@ proc selectNode { c obj } { set by2 [expr [lindex $bbox 3] + 1] $c delete -withtags "selectmark && $node" $c create line $bx1 $by1 $bx2 $by1 $bx2 $by2 $bx1 $by2 $bx1 $by1 \ - -dash {6 4} -fill black -width 1 -tags "selectmark $node" + -dash {6 4} -fill black -width 1 -tags "selectmark $node" return } @@ -748,10 +748,10 @@ proc button3link { c x y } { set link [lindex [$c gettags {link && current}] 1] if { $link == "" } { - set link [lindex [$c gettags {linklabel && current}] 1] - if { $link == "" } { - return - } + set link [lindex [$c gettags {linklabel && current}] 1] + if { $link == "" } { + return + } } .button3menu delete 0 end @@ -760,41 +760,41 @@ proc button3link { c x y } { # Configure link # .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" + -command "popupConfigDialog $c" # # Delete link # if { $oper_mode != "exec" } { - .button3menu add command -label "Delete" \ - -command "removeGUILink $link atomic" + .button3menu add command -label "Delete" \ + -command "removeGUILink $link atomic" } else { - .button3menu add command -label "Delete" \ - -state disabled + .button3menu add command -label "Delete" \ + -state disabled } # # Split link # if { $oper_mode != "exec" && [getLinkMirror $link] == "" } { - .button3menu add command -label "Split" \ - -command "splitGUILink $link" + .button3menu add command -label "Split" \ + -command "splitGUILink $link" } else { - .button3menu add command -label "Split" \ - -state disabled + .button3menu add command -label "Split" \ + -state disabled } # # Merge two pseudo nodes / links # if { $oper_mode != "exec" && [getLinkMirror $link] != "" && - [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] == - $curcanvas } { - .button3menu add command -label "Merge" \ - -command "mergeGUINode [lindex [linkPeers $link] 1]" + [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] == + $curcanvas } { + .button3menu add command -label "Merge" \ + -command "mergeGUINode [lindex [linkPeers $link] 1]" } else { - .button3menu add command -label "Merge" \ - -state disabled + .button3menu add command -label "Merge" \ + -state disabled } set x [winfo pointerx .] @@ -821,39 +821,39 @@ proc movetoCanvas { canvas } { set selected_nodes {} foreach obj [.c find withtag "node && selected"] { - set node [lindex [.c gettags $obj] 1] - lappend selected_nodes $node - setNodeCanvas $node $canvas - set changed 1 + set node [lindex [.c gettags $obj] 1] + lappend selected_nodes $node + setNodeCanvas $node $canvas + set changed 1 } foreach obj [.c find withtag "linklabel"] { - set link [lindex [.c gettags $obj] 1] - set link_peers [linkPeers $link] - set peer1 [lindex $link_peers 0] - set peer2 [lindex $link_peers 1] - set peer1_in_selected [lsearch $selected_nodes $peer1] - set peer2_in_selected [lsearch $selected_nodes $peer2] - if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) || - ($peer1_in_selected != -1 && $peer2_in_selected == -1) } { - if { [nodeType $peer2] == "pseudo" } { - setNodeCanvas $peer2 $canvas - if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } { - mergeLink $link - } - continue - } - set new_nodes [splitLink $link pseudo] - set new_node1 [lindex $new_nodes 0] - set new_node2 [lindex $new_nodes 1] - setNodeMirror $new_node1 $new_node2 - setNodeMirror $new_node2 $new_node1 - setNodeName $new_node1 $peer2 - setNodeName $new_node2 $peer1 - set link1 [linkByPeers $peer1 $new_node1] - set link2 [linkByPeers $peer2 $new_node2] - setLinkMirror $link1 $link2 - setLinkMirror $link2 $link1 - } + set link [lindex [.c gettags $obj] 1] + set link_peers [linkPeers $link] + set peer1 [lindex $link_peers 0] + set peer2 [lindex $link_peers 1] + set peer1_in_selected [lsearch $selected_nodes $peer1] + set peer2_in_selected [lsearch $selected_nodes $peer2] + if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) || + ($peer1_in_selected != -1 && $peer2_in_selected == -1) } { + if { [nodeType $peer2] == "pseudo" } { + setNodeCanvas $peer2 $canvas + if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } { + mergeLink $link + } + continue + } + set new_nodes [splitLink $link pseudo] + set new_node1 [lindex $new_nodes 0] + set new_node2 [lindex $new_nodes 1] + setNodeMirror $new_node1 $new_node2 + setNodeMirror $new_node2 $new_node1 + setNodeName $new_node1 $peer2 + setNodeName $new_node2 $peer1 + set link1 [linkByPeers $peer1 $new_node1] + set link2 [linkByPeers $peer2 $new_node2] + setLinkMirror $link1 $link2 + setLinkMirror $link2 $link1 + } } updateUndoLog redrawAll @@ -914,17 +914,17 @@ proc button3node { c x y } { set node [lindex [$c gettags {node && current}] 1] if { $node == "" } { - set node [lindex [$c gettags {nodelabel && current}] 1] - if { $node == "" } { - return - } + set node [lindex [$c gettags {nodelabel && current}] 1] + if { $node == "" } { + return + } } set mirror_node [getNodeMirror $node] if { [$c gettags "node && $node && selected"] == "" } { - $c dtag node selected - $c delete -withtags selectmark - selectNode $c [$c find withtag "current"] + $c dtag node selected + $c delete -withtags selectmark + selectNode $c [$c find withtag "current"] } .button3menu delete 0 end @@ -933,11 +933,11 @@ proc button3node { c x y } { # Configure node # if { [nodeType $node] != "pseudo" } { - .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" + .button3menu add command -label "Configure" \ + -command "popupConfigDialog $c" } else { - .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" -state disabled + .button3menu add command -label "Configure" \ + -command "popupConfigDialog $c" -state disabled } # @@ -945,34 +945,34 @@ proc button3node { c x y } { # .button3menu.connect delete 0 end if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } { - .button3menu add cascade -label "Create link to" \ - -menu .button3menu.connect -state disabled + .button3menu add cascade -label "Create link to" \ + -menu .button3menu.connect -state disabled } else { - .button3menu add cascade -label "Create link to" \ - -menu .button3menu.connect + .button3menu add cascade -label "Create link to" \ + -menu .button3menu.connect } .button3menu.connect add command -label "Canvas:" -state disabled foreach canvas $canvas_list { - destroy .button3menu.connect.$canvas - menu .button3menu.connect.$canvas -tearoff 0 - .button3menu.connect.$canvas add command \ - -label "Node:" -state disabled - .button3menu.connect add cascade -label [getCanvasName $canvas] \ - -menu .button3menu.connect.$canvas + destroy .button3menu.connect.$canvas + menu .button3menu.connect.$canvas -tearoff 0 + .button3menu.connect.$canvas add command \ + -label "Node:" -state disabled + .button3menu.connect add cascade -label [getCanvasName $canvas] \ + -menu .button3menu.connect.$canvas } foreach peer_node $node_list { - set canvas [getNodeCanvas $peer_node] - if { $node != $peer_node && [nodeType $node] != "rj45" && - [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 && - [ifcByLogicalPeer $node $peer_node] == "" } { - .button3menu.connect.$canvas add command \ - -label [getNodeName $peer_node] \ - -command "newGUILink $node $peer_node" - } elseif { [nodeType $peer_node] != "pseudo" } { - .button3menu.connect.$canvas add command \ - -label [getNodeName $peer_node] \ - -state disabled - } + set canvas [getNodeCanvas $peer_node] + if { $node != $peer_node && [nodeType $node] != "rj45" && + [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 && + [ifcByLogicalPeer $node $peer_node] == "" } { + .button3menu.connect.$canvas add command \ + -label [getNodeName $peer_node] \ + -command "newGUILink $node $peer_node" + } elseif { [nodeType $peer_node] != "pseudo" } { + .button3menu.connect.$canvas add command \ + -label [getNodeName $peer_node] \ + -state disabled + } } # @@ -980,43 +980,43 @@ proc button3node { c x y } { # .button3menu.moveto delete 0 end if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } { - .button3menu add cascade -label "Move to" \ - -menu .button3menu.moveto -state disabled + .button3menu add cascade -label "Move to" \ + -menu .button3menu.moveto -state disabled } else { - .button3menu add cascade -label "Move to" \ - -menu .button3menu.moveto + .button3menu add cascade -label "Move to" \ + -menu .button3menu.moveto } .button3menu.moveto add command -label "Canvas:" -state disabled foreach canvas $canvas_list { - if { $canvas != $curcanvas } { - .button3menu.moveto add command \ - -label [getCanvasName $canvas] \ - -command "movetoCanvas $canvas" - } else { - .button3menu.moveto add command \ - -label [getCanvasName $canvas] -state disabled - } + if { $canvas != $curcanvas } { + .button3menu.moveto add command \ + -label [getCanvasName $canvas] \ + -command "movetoCanvas $canvas" + } else { + .button3menu.moveto add command \ + -label [getCanvasName $canvas] -state disabled + } } # # Merge two pseudo nodes / links # if { $oper_mode != "exec" && [nodeType $node] == "pseudo" && \ - [getNodeCanvas $mirror_node] == $curcanvas } { - .button3menu add command -label "Merge" \ - -command "mergeGUINode $node" + [getNodeCanvas $mirror_node] == $curcanvas } { + .button3menu add command -label "Merge" \ + -command "mergeGUINode $node" } else { - .button3menu add command -label "Merge" \ - -state disabled + .button3menu add command -label "Merge" \ + -state disabled } # # Delete selection # if { $oper_mode != "exec" } { - .button3menu add command -label "Delete" -command deleteSelection + .button3menu add command -label "Delete" -command deleteSelection } else { - .button3menu add command -label "Delete" -state disabled + .button3menu add command -label "Delete" -state disabled } # @@ -1024,18 +1024,18 @@ proc button3node { c x y } { # .button3menu.shell delete 0 end if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } { - .button3menu add cascade -label "Shell window" \ - -menu .button3menu.shell - set cmd [[typemodel $node].shellcmd $node] - if { $cmd != "/bin/sh" && $cmd != "" } { - .button3menu.shell add command -label "$cmd" \ - -command "spawnShell $node $cmd" - } - .button3menu.shell add command -label "/bin/sh" \ - -command "spawnShell $node /bin/sh" + .button3menu add cascade -label "Shell window" \ + -menu .button3menu.shell + set cmd [[typemodel $node].shellcmd $node] + if { $cmd != "/bin/sh" && $cmd != "" } { + .button3menu.shell add command -label "$cmd" \ + -command "spawnShell $node $cmd" + } + .button3menu.shell add command -label "/bin/sh" \ + -command "spawnShell $node /bin/sh" } else { - .button3menu add cascade -label "Shell window" \ - -menu .button3menu.shell -state disabled + .button3menu add cascade -label "Shell window" \ + -menu .button3menu.shell -state disabled } # @@ -1043,30 +1043,30 @@ proc button3node { c x y } { # .button3menu.ethereal delete 0 end if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } { - .button3menu add cascade -label "Ethereal" \ - -menu .button3menu.ethereal - foreach ifc [ifcList $node] { - set label "$ifc" - if { [getIfcIPv4addr $node $ifc] != "" } { - set label "$label ([getIfcIPv4addr $node $ifc])" - } - if { [getIfcIPv6addr $node $ifc] != "" } { - set label "$label ([getIfcIPv6addr $node $ifc])" - } - .button3menu.ethereal add command -label $label \ - -command "startethereal $node $ifc" - } - .button3menu add command -label Start \ - -command "[typemodel $node].start $eid $node" - .button3menu add command -label Stop \ - -command "[typemodel $node].shutdown $eid $node" + .button3menu add cascade -label "Ethereal" \ + -menu .button3menu.ethereal + foreach ifc [ifcList $node] { + set label "$ifc" + if { [getIfcIPv4addr $node $ifc] != "" } { + set label "$label ([getIfcIPv4addr $node $ifc])" + } + if { [getIfcIPv6addr $node $ifc] != "" } { + set label "$label ([getIfcIPv6addr $node $ifc])" + } + .button3menu.ethereal add command -label $label \ + -command "startethereal $node $ifc" + } + .button3menu add command -label Start \ + -command "[typemodel $node].start $eid $node" + .button3menu add command -label Stop \ + -command "[typemodel $node].shutdown $eid $node" } else { - .button3menu add cascade -label "Ethereal" \ - -menu .button3menu.ethereal -state disabled - .button3menu add command -label start \ - -command "[typemodel $node].start $eid $node" -state disabled - .button3menu add command -label stop \ - -command "[typemodel $node].stop $eid $node" -state disabled + .button3menu add cascade -label "Ethereal" \ + -menu .button3menu.ethereal -state disabled + .button3menu add command -label start \ + -command "[typemodel $node].start $eid $node" -state disabled + .button3menu add command -label stop \ + -command "[typemodel $node].stop $eid $node" -state disabled } # @@ -1102,15 +1102,15 @@ proc spawnShell { node cmd } { nexec vimageShellServer.sh $node_id 1234 $cmd & if { $gui_unix } { exec xterm -sb -rightbar \ - -T "IMUNES: [getNodeName $node] (console)" \ - -e "nc $exec_host 1234" & + -T "IMUNES: [getNodeName $node] (console)" \ + -e "nc $exec_host 1234" & } else { exec cmd /c nc $exec_host 1234 & } } else { nexec xterm -sb -rightbar \ - -T "IMUNES: [getNodeName $node] (console)" \ - -e "vimage $node_id $cmd" & + -T "IMUNES: [getNodeName $node] (console)" \ + -e "vimage $node_id $cmd" & } } @@ -1168,63 +1168,63 @@ proc button1 { c x y button } { set curobj [$c find withtag current] set curtype [lindex [$c gettags current] 0] if { $curtype == "node" || ( $curtype == "nodelabel" && - [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] - if { $button == "ctrl" } { - if { $wasselected } { - $c dtag $node selected - $c delete -withtags "selectmark && $node" - } - } elseif { !$wasselected } { - $c dtag node selected - $c delete -withtags selectmark - } - if { $activetool == "select" && !$wasselected} { - selectNode $c $curobj - } + [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] + if { $button == "ctrl" } { + if { $wasselected } { + $c dtag $node selected + $c delete -withtags "selectmark && $node" + } + } elseif { !$wasselected } { + $c dtag node selected + $c delete -withtags selectmark + } + if { $activetool == "select" && !$wasselected} { + selectNode $c $curobj + } } elseif { $button != "ctrl" || $activetool != "select" } { - $c dtag node selected - $c delete -withtags selectmark + $c dtag node selected + $c delete -withtags selectmark } if { $curobj == $background } { - if { [lsearch {select link} $activetool] < 0 } { - set node [newNode $activetool] - setNodeCanvas $node $curcanvas - setNodeCoords $node "$x $y" - set dy 32 - if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } { - set dy 24 - } - setNodeLabelCoords $node "$x [expr $y + $dy]" - drawNode $node - selectNode $c [$c find withtag "node && $node"] - set changed 1 - } elseif { $activetool == "select" \ - && $curtype != "node" && $curtype != "nodelabel"} { - $c config -cursor cross - set lastX $x - set lastY $y - if {$selectbox != ""} { - # We actually shouldn't get here! - $c delete $selectbox - set selectbox "" - } - } + if { [lsearch {select link} $activetool] < 0 } { + set node [newNode $activetool] + setNodeCanvas $node $curcanvas + setNodeCoords $node "$x $y" + set dy 32 + if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } { + set dy 24 + } + setNodeLabelCoords $node "$x [expr $y + $dy]" + drawNode $node + selectNode $c [$c find withtag "node && $node"] + set changed 1 + } elseif { $activetool == "select" \ + && $curtype != "node" && $curtype != "nodelabel"} { + $c config -cursor cross + set lastX $x + set lastY $y + if {$selectbox != ""} { + # We actually shouldn't get here! + $c delete $selectbox + set selectbox "" + } + } } else { - if {$curtype == "node" || $curtype == "nodelabel"} { - $c config -cursor fleur - } - if {$activetool == "link" && $curtype == "node"} { - $c config -cursor cross - set lastX [lindex [$c coords $curobj] 0] - set lastY [lindex [$c coords $curobj] 1] - set newlink [$c create line $lastX $lastY $x $y \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link"] - } + if {$curtype == "node" || $curtype == "nodelabel"} { + $c config -cursor fleur + } + if {$activetool == "link" && $curtype == "node"} { + $c config -cursor cross + set lastX [lindex [$c coords $curobj] 0] + set lastY [lindex [$c coords $curobj] 1] + set newlink [$c create line $lastX $lastY $x $y \ + -fill $defLinkColor -width $defLinkWidth \ + -tags "link"] + } } $c raise link background $c raise linklabel "link || background" @@ -1260,42 +1260,42 @@ proc button1-motion { c x y } { set curobj [$c find withtag current] set curtype [lindex [$c gettags current] 0] if {$activetool == "link" && $newlink != ""} { - $c coords $newlink $lastX $lastY $x $y + $c coords $newlink $lastX $lastY $x $y } elseif { $activetool == "select" && \ ( $curobj == $selectbox || $curobj == $background )} { - if {$selectbox == ""} { - set selectbox [$c create line \ - $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \ - -dash {10 4} -fill black -width 1 -tags "selectbox"] - $c raise $selectbox "background || link || linklabel || interface" - } else { - $c coords $selectbox \ - $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY - } + if {$selectbox == ""} { + set selectbox [$c create line \ + $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \ + -dash {10 4} -fill black -width 1 -tags "selectbox"] + $c raise $selectbox "background || link || linklabel || interface" + } else { + $c coords $selectbox \ + $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY + } } 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 + && [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 } else { - foreach img [$c find withtag "selected"] { - set node [lindex [$c gettags $img] 1] + 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] + $c move $img [expr $x-$lastX] [expr $y-$lastY] 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] - $c addtag need_redraw withtag "link && $node" - } - foreach link [$c find withtag "link && need_redraw"] { - redrawLink [lindex [$c gettags $link] 1] - } - $c dtag link need_redraw - set changed 1 - set lastX $x - set lastY $y + $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] + $c addtag need_redraw withtag "link && $node" + } + foreach link [$c find withtag "link && need_redraw"] { + redrawLink [lindex [$c gettags $link] 1] + } + $c dtag link need_redraw + set changed 1 + set lastX $x + set lastY $y } return } @@ -1335,23 +1335,23 @@ proc newGUILink { lnode1 lnode2 } { set link [newLink $lnode1 $lnode2] if { $link == "" } { - return + return } if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } { - set new_nodes [splitLink $link pseudo] - set orig_nodes [linkPeers $link] - set new_node1 [lindex $new_nodes 0] - set new_node2 [lindex $new_nodes 1] - set orig_node1 [lindex $orig_nodes 0] - set orig_node2 [lindex $orig_nodes 1] - set new_link1 [linkByPeers $orig_node1 $new_node1] - set new_link2 [linkByPeers $orig_node2 $new_node2] - setNodeMirror $new_node1 $new_node2 - setNodeMirror $new_node2 $new_node1 - setNodeName $new_node1 $orig_node2 - setNodeName $new_node2 $orig_node1 - setLinkMirror $new_link1 $new_link2 - setLinkMirror $new_link2 $new_link1 + set new_nodes [splitLink $link pseudo] + set orig_nodes [linkPeers $link] + set new_node1 [lindex $new_nodes 0] + set new_node2 [lindex $new_nodes 1] + set orig_node1 [lindex $orig_nodes 0] + set orig_node2 [lindex $orig_nodes 1] + set new_link1 [linkByPeers $orig_node1 $new_node1] + set new_link2 [linkByPeers $orig_node2 $new_node2] + setNodeMirror $new_node1 $new_node2 + setNodeMirror $new_node2 $new_node1 + setNodeName $new_node1 $orig_node2 + setNodeName $new_node2 $orig_node1 + setLinkMirror $new_link1 $new_link2 + setLinkMirror $new_link2 $new_link1 } redrawAll set changed 1 @@ -1387,106 +1387,106 @@ proc button1-release { c x y } { $c config -cursor left_ptr if {$activetool == "link" && $newlink != ""} { - $c delete $newlink - set newlink "" - set destobj "" - foreach obj [$c find overlapping $x $y $x $y] { - if {[lindex [$c gettags $obj] 0] == "node"} { - set destobj $obj - break - } - } - if {$destobj != "" && $curobj != "" && $destobj != $curobj} { - set lnode1 [lindex [$c gettags $curobj] 1] - set lnode2 [lindex [$c gettags $destobj] 1] - if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } { - set link [newLink $lnode1 $lnode2] - if { $link != "" } { - drawLink $link - redrawLink $link - updateLinkLabel $link - set changed 1 - } - } - } + $c delete $newlink + set newlink "" + set destobj "" + foreach obj [$c find overlapping $x $y $x $y] { + if {[lindex [$c gettags $obj] 0] == "node"} { + set destobj $obj + break + } + } + if {$destobj != "" && $curobj != "" && $destobj != $curobj} { + set lnode1 [lindex [$c gettags $curobj] 1] + set lnode2 [lindex [$c gettags $destobj] 1] + if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } { + set link [newLink $lnode1 $lnode2] + if { $link != "" } { + drawLink $link + redrawLink $link + updateLinkLabel $link + set changed 1 + } + } + } } if { $changed == 1 } { - set regular true - if { [lindex [$c gettags $curobj] 0] == "nodelabel" } { - set node [lindex [$c gettags $curobj] 1] - selectNode $c [$c find withtag "node && $node"] - } - set selected {} - foreach img [$c find withtag "selected"] { - set node [lindex [$c gettags $img] 1] - lappend selected $node - set coords [$c coords $img] - set x [lindex $coords 0] - set y [lindex $coords 1] - if { $autorearrange_enabled } { - set dx 0 - set dy 0 - } else { - set dx [expr int($x / $grid + 0.5) * $grid - $x] - set dy [expr int($y / $grid + 0.5) * $grid - $y] - } - $c move $img $dx $dy - set coords [$c coords $img] - set x [lindex $coords 0] - set y [lindex $coords 1] - setNodeCoords $node "$x $y" - if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { - set regular false - } - $c move "nodelabel && $node" $dx $dy - set coords [$c coords "nodelabel && $node"] - set x [lindex $coords 0] - set y [lindex $coords 1] - setNodeLabelCoords $node "$x $y" - if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { - set regular false - } - $c move "selectmark && $node" $dx $dy - $c addtag need_redraw withtag "link && $node" - } - if {$regular == "true"} { - foreach link [$c find withtag "link && need_redraw"] { - redrawLink [lindex [$c gettags $link] 1] - } - } else { - loadCfg $undolog($undolevel) - redrawAll - foreach node $selected { - selectNode $c [$c find withtag "node && $node"] - } - set changed 0 - } - $c dtag link need_redraw + set regular true + if { [lindex [$c gettags $curobj] 0] == "nodelabel" } { + set node [lindex [$c gettags $curobj] 1] + selectNode $c [$c find withtag "node && $node"] + } + set selected {} + foreach img [$c find withtag "selected"] { + set node [lindex [$c gettags $img] 1] + lappend selected $node + set coords [$c coords $img] + set x [lindex $coords 0] + set y [lindex $coords 1] + if { $autorearrange_enabled } { + set dx 0 + set dy 0 + } else { + set dx [expr int($x / $grid + 0.5) * $grid - $x] + set dy [expr int($y / $grid + 0.5) * $grid - $y] + } + $c move $img $dx $dy + set coords [$c coords $img] + set x [lindex $coords 0] + set y [lindex $coords 1] + setNodeCoords $node "$x $y" + if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { + set regular false + } + $c move "nodelabel && $node" $dx $dy + set coords [$c coords "nodelabel && $node"] + set x [lindex $coords 0] + set y [lindex $coords 1] + setNodeLabelCoords $node "$x $y" + if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { + set regular false + } + $c move "selectmark && $node" $dx $dy + $c addtag need_redraw withtag "link && $node" + } + if {$regular == "true"} { + foreach link [$c find withtag "link && need_redraw"] { + redrawLink [lindex [$c gettags $link] 1] + } + } else { + loadCfg $undolog($undolevel) + redrawAll + foreach node $selected { + selectNode $c [$c find withtag "node && $node"] + } + set changed 0 + } + $c dtag link need_redraw } elseif {$activetool == "select" } { - if {$selectbox == ""} { - set x1 $x - set y1 $y - set autorearrange_enabled 0 - } else { - set coords [$c coords $selectbox] - set x [lindex $coords 0] - set y [lindex $coords 1] - set x1 [lindex $coords 4] - set y1 [lindex $coords 5] - $c delete $selectbox - set selectbox "" - } - set enclosed {} - foreach obj [$c find enclosed $x $y $x1 $y1] { - set tags [$c gettags $obj] - if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} { - lappend enclosed $obj - } - } - foreach obj $enclosed { - selectNode $c $obj - } + if {$selectbox == ""} { + set x1 $x + set y1 $y + set autorearrange_enabled 0 + } else { + set coords [$c coords $selectbox] + set x [lindex $coords 0] + set y [lindex $coords 1] + set x1 [lindex $coords 4] + set y1 [lindex $coords 5] + $c delete $selectbox + set selectbox "" + } + set enclosed {} + foreach obj [$c find enclosed $x $y $x1 $y1] { + set tags [$c gettags $obj] + if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} { + lappend enclosed $obj + } + } + foreach obj $enclosed { + selectNode $c $obj + } } $c raise link background $c raise linklabel "link || background" @@ -1521,14 +1521,14 @@ proc nodeEnter { c } { set name [getNodeName $node] set model [getNodeModel $node] if { $model != "" } { - set line "{$node} $name ($model):" + set line "{$node} $name ($model):" } else { - set line "{$node} $name:" + set line "{$node} $name:" } if { $type != "rj45" } { - foreach ifc [ifcList $node] { - set line "$line $ifc:[getIfcIPv4addr $node $ifc]" - } + foreach ifc [ifcList $node] { + set line "$line $ifc:[getIfcIPv4addr $node $ifc]" + } } .bottom.textbox config -text "$line" return @@ -1553,7 +1553,7 @@ proc linkEnter {c} { set link [lindex [$c gettags current] 1] if { [lsearch $link_list $link] == -1 } { - return + return } set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]" .bottom.textbox config -text "$line" @@ -1597,17 +1597,17 @@ proc anyLeave {c} { #**** proc checkIntRange { str low high } { if { $str == "" } { - return 1 + return 1 } set str [string trimleft $str 0] if { $str == "" } { - set str 0 + set str 0 } if { ![string is integer $str] } { - return 0 + return 0 } if { $str < $low || $str > $high } { - return 0 + return 0 } return 1 } @@ -1634,22 +1634,22 @@ proc focusAndFlash {W {count 9}} { set bg white if { $badentry == -1 } { - return + return } else { - set badentry 1 + set badentry 1 } focus -force $W if {$count<1} { - $W configure -foreground $fg -background $bg - set badentry 0 + $W configure -foreground $fg -background $bg + set badentry 0 } else { - if {$count%2} { - $W configure -foreground $bg -background $fg - } else { - $W configure -foreground $fg -background $bg - } - after 200 [list focusAndFlash $W [expr {$count-1}]] + if {$count%2} { + $W configure -foreground $bg -background $fg + } else { + $W configure -foreground $fg -background $bg + } + after 200 [list focusAndFlash $W [expr {$count-1}]] } return } @@ -1681,329 +1681,360 @@ proc popupConfigDialog { c } { set tk_type [lindex [$c gettags current] 0] set target [lindex [$c gettags current] 1] if { [lsearch {node nodelabel interface} $tk_type] > -1 } { - set object_type node + set object_type node } if { [lsearch {link linklabel} $tk_type] > -1 } { - set object_type link + set object_type link } if { "$object_type" == ""} { - destroy $wi - return + destroy $wi + return } if { $object_type == "link" } { - set n0 [lindex [linkPeers $target] 0] - set n1 [lindex [linkPeers $target] 1] - if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } { - destroy $wi - return - } + set n0 [lindex [linkPeers $target] 0] + set n1 [lindex [linkPeers $target] 1] + if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } { + destroy $wi + return + } } $c dtag node selected $c delete -withtags selectmark switch -exact -- $object_type { - node { - set type [nodeType $target] - if { $type == "pseudo" } { - # - # Hyperlink to another canvas - # - destroy $wi - 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" } { - label $wi.ftop.name_label -text "Physical interface:" - } else { - label $wi.ftop.name_label -text "Node name:" - } - 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" } { - frame $wi.model -borderwidth 4 - label $wi.model.label -text "Model:" - if { $oper_mode == "edit" } { - eval tk_optionMenu $wi.model.menu router_model \ - $supp_router_models - } else { - tk_optionMenu $wi.model.menu router_model $model - } - pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0 - pack $wi.model -side top - } - - if { $type != "rj45" } { - foreach ifc [lsort -ascii [ifcList $target]] { - labelframe $wi.if$ifc -padx 4 -pady 4 - frame $wi.if$ifc.label - label $wi.if$ifc.label.txt -text "Interface $ifc:" - pack $wi.if$ifc.label.txt -side left -anchor w - if {[[typemodel $target].layer] == "NETWORK"} { - global ifoper$ifc - set ifoper$ifc [getIfcOperState $target $ifc] - radiobutton $wi.if$ifc.label.up -text "up" \ - -variable ifoper$ifc -value up - radiobutton $wi.if$ifc.label.down -text "down" \ - -variable ifoper$ifc -value down - label $wi.if$ifc.label.mtul -text "MTU" \ - -anchor e -width 5 - spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.label.mtuv insert 0 \ - [getIfcMTU $target $ifc] - if {![string first eth $ifc]} { - $wi.if$ifc.label.mtuv configure \ - -from 256 -to 1500 -increment 2 \ - -vcmd {checkIntRange %P 256 1500} - } else { - $wi.if$ifc.label.mtuv configure \ - -from 256 -to 2044 -increment 2 \ - -vcmd {checkIntRange %P 256 2044} - } - pack $wi.if$ifc.label.up $wi.if$ifc.label.down \ - $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \ - -side left -anchor w - } - pack $wi.if$ifc.label -side top -anchor w - frame $wi.if$ifc.tab -width 10 - frame $wi.if$ifc.cfg - - # - # Queue config - # - global ifqdisc$ifc ifqdrop$ifc - set ifqdisc$ifc [getIfcQDisc $target $ifc] - set ifqdrop$ifc [getIfcQDrop $target $ifc] - frame $wi.if$ifc.cfg.q - label $wi.if$ifc.cfg.q.l1 -text "Queue" \ - -anchor w - tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \ - FIFO DRR WFQ - tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \ - drop-tail drop-head - label $wi.if$ifc.cfg.q.l2 -text "len" \ - -anchor e -width 3 - spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc] - $wi.if$ifc.cfg.q.len configure \ - -from 5 -to 4096 -increment 1 \ - -vcmd {checkIntRange %P 5 4096} - pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \ - $wi.if$ifc.cfg.q.drop -side left -anchor w - pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \ - -side left -anchor e - pack $wi.if$ifc.cfg.q -side top -anchor w - - if {[lsearch {router pc host} $type] >= 0} { - # - # IPv4 address - # - frame $wi.if$ifc.cfg.ipv4 - label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \ - -anchor w - entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.ipv4.addrv insert 0 \ - [getIfcIPv4addr $target $ifc] - $wi.if$ifc.cfg.ipv4.addrv configure \ - -vcmd {checkIPv4Net %P} - pack $wi.if$ifc.cfg.ipv4.addrl \ - $wi.if$ifc.cfg.ipv4.addrv -side left - pack $wi.if$ifc.cfg.ipv4 -side top -anchor w - - # - # IPv6 address - # - frame $wi.if$ifc.cfg.ipv6 - label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \ - -anchor w - entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.ipv6.addrv insert 0 \ - [getIfcIPv6addr $target $ifc] - $wi.if$ifc.cfg.ipv6.addrv configure \ - -vcmd {checkIPv6Net %P} - pack $wi.if$ifc.cfg.ipv6.addrl \ - $wi.if$ifc.cfg.ipv6.addrv -side left - pack $wi.if$ifc.cfg.ipv6 -side top -anchor w - } - 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} { - # - # Static routes - # - set routes [concat [getStatIPv4routes $target] \ - [getStatIPv6routes $target]] - labelframe $wi.statrt -padx 4 -pady 4 - label $wi.statrt.label -text "Static routes:" - pack $wi.statrt.label -side top -anchor w - frame $wi.statrt.tab -width 10 - frame $wi.statrt.tab1 -width 10 - frame $wi.statrt.cfg - set h [expr [llength $routes] + 1] - if { $h < 2 } { - set h 2 - } - text $wi.statrt.cfg.text -font arial -bg white \ - -width 42 -height $h -takefocus 0 - foreach route $routes { - $wi.statrt.cfg.text insert end "$route " - } - 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} { - # - # Custom startup config - # - global customEnabled - labelframe $wi.custom -padx 4 -pady 4 - frame $wi.custom.label - label $wi.custom.label.txt -text "Custom startup config:" - pack $wi.custom.label.txt -side left -anchor w - set customEnabled [getCustomEnabled $target] - radiobutton $wi.custom.label.enabled -text "enabled" \ - -variable customEnabled -value true - radiobutton $wi.custom.label.disabled -text "disabled" \ - -variable customEnabled -value false - pack $wi.custom.label.enabled $wi.custom.label.disabled \ - -side left -anchor w - pack $wi.custom.label -side top -anchor w - frame $wi.custom.cfg - button $wi.custom.cfg.generate -text "Generate" \ - -command "cfgGenerate $target" - button $wi.custom.cfg.edit -text "Edit" \ - -command "editStartupCfg $target" - button $wi.custom.cfg.clear -text "Clear" \ - -command "setCustomConfig $target {}" - pack $wi.custom.cfg.generate $wi.custom.cfg.edit \ - $wi.custom.cfg.clear -side left - - pack $wi.custom.label -side top -anchor w - pack $wi.custom.cfg -side top - pack $wi.custom -side top -anchor w -fill both - - # - # CPU scheduling parameters - # - labelframe $wi.cpu -padx 4 -pady 4 - label $wi.cpu.minl -text "CPU min%" -anchor w - spinbox $wi.cpu.mine -bg white -width 3 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.cpu.mine insert 0 [lindex \ - [lsearch -inline [getNodeCPUConf $target] {min *}] 1] - $wi.cpu.mine configure \ - -vcmd {checkIntRange %P 1 90} \ - -from 0 -to 90 -increment 1 - label $wi.cpu.maxl -text " max%" -anchor w - spinbox $wi.cpu.maxe -bg white -width 3 \ - -validate focus -invcmd "focusAndFlash %W" - set cpumax [lindex \ - [lsearch -inline [getNodeCPUConf $target] {max *}] 1] - if { $cpumax == "" } { - set cpumax 100 - } - $wi.cpu.maxe insert 0 $cpumax - $wi.cpu.maxe configure \ - -vcmd {checkIntRange %P 1 100} \ - -from 1 -to 100 -increment 1 - label $wi.cpu.weightl -text " weight" -anchor w - spinbox $wi.cpu.weighte -bg white -width 2 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.cpu.weighte insert 0 [lindex \ - [lsearch -inline [getNodeCPUConf $target] {weight *}] 1] - $wi.cpu.weighte configure \ - -vcmd {checkIntRange %P 1 10} \ - -from 1 -to 10 -increment 1 - pack $wi.cpu.minl $wi.cpu.mine \ - $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 - } + node { + set type [nodeType $target] + if { $type == "pseudo" } { + # + # Hyperlink to another canvas + # + destroy $wi + 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" } { + label $wi.ftop.name_label -text "Physical interface:" + } else { + label $wi.ftop.name_label -text "Node name:" + } + 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" } { + frame $wi.model -borderwidth 4 + label $wi.model.label -text "Model:" + if { $oper_mode == "edit" } { + eval tk_optionMenu $wi.model.menu router_model \ + $supp_router_models + } else { + tk_optionMenu $wi.model.menu router_model $model + } + pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0 + pack $wi.model -side top + } + + if { $type != "rj45" } { + foreach ifc [lsort -ascii [ifcList $target]] { + labelframe $wi.if$ifc -padx 4 -pady 4 + frame $wi.if$ifc.label + label $wi.if$ifc.label.txt -text "Interface $ifc:" + pack $wi.if$ifc.label.txt -side left -anchor w + if {[[typemodel $target].layer] == "NETWORK"} { + global ifoper$ifc + set ifoper$ifc [getIfcOperState $target $ifc] + radiobutton $wi.if$ifc.label.up -text "up" \ + -variable ifoper$ifc -value up + radiobutton $wi.if$ifc.label.down -text "down" \ + -variable ifoper$ifc -value down + label $wi.if$ifc.label.mtul -text "MTU" \ + -anchor e -width 5 + spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.label.mtuv insert 0 \ + [getIfcMTU $target $ifc] + if {![string first eth $ifc]} { + $wi.if$ifc.label.mtuv configure \ + -from 256 -to 1500 -increment 2 \ + -vcmd {checkIntRange %P 256 1500} + } else { + $wi.if$ifc.label.mtuv configure \ + -from 256 -to 2044 -increment 2 \ + -vcmd {checkIntRange %P 256 2044} + } + pack $wi.if$ifc.label.up $wi.if$ifc.label.down \ + $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \ + -side left -anchor w + } + pack $wi.if$ifc.label -side top -anchor w + frame $wi.if$ifc.tab -width 10 + frame $wi.if$ifc.cfg + + # + # Queue config + # + global ifqdisc$ifc ifqdrop$ifc + set ifqdisc$ifc [getIfcQDisc $target $ifc] + set ifqdrop$ifc [getIfcQDrop $target $ifc] + frame $wi.if$ifc.cfg.q + label $wi.if$ifc.cfg.q.l1 -text "Queue" \ + -anchor w + tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \ + FIFO DRR WFQ + tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \ + drop-tail drop-head + label $wi.if$ifc.cfg.q.l2 -text "len" \ + -anchor e -width 3 + spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc] + $wi.if$ifc.cfg.q.len configure \ + -from 5 -to 4096 -increment 1 \ + -vcmd {checkIntRange %P 5 4096} + pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \ + $wi.if$ifc.cfg.q.drop -side left -anchor w + pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \ + -side left -anchor e + pack $wi.if$ifc.cfg.q -side top -anchor w + + if {[lsearch {router pc host} $type] >= 0} { + # + # IPv4 address + # + frame $wi.if$ifc.cfg.ipv4 + label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \ + -anchor w + entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.ipv4.addrv insert 0 \ + [getIfcIPv4addr $target $ifc] + $wi.if$ifc.cfg.ipv4.addrv configure \ + -vcmd {checkIPv4Net %P} + pack $wi.if$ifc.cfg.ipv4.addrl \ + $wi.if$ifc.cfg.ipv4.addrv -side left + pack $wi.if$ifc.cfg.ipv4 -side top -anchor w + + # + # IPv6 address + # + frame $wi.if$ifc.cfg.ipv6 + label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \ + -anchor w + entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.ipv6.addrv insert 0 \ + [getIfcIPv6addr $target $ifc] + $wi.if$ifc.cfg.ipv6.addrv configure \ + -vcmd {checkIPv6Net %P} + pack $wi.if$ifc.cfg.ipv6.addrl \ + $wi.if$ifc.cfg.ipv6.addrv -side left + pack $wi.if$ifc.cfg.ipv6 -side top -anchor w + } + 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} { + # + # Static routes + # + set routes [concat [getStatIPv4routes $target] \ + [getStatIPv6routes $target]] + labelframe $wi.statrt -padx 4 -pady 4 + label $wi.statrt.label -text "Static routes:" + pack $wi.statrt.label -side top -anchor w + frame $wi.statrt.tab -width 10 + frame $wi.statrt.tab1 -width 10 + frame $wi.statrt.cfg + set h [expr [llength $routes] + 1] + if { $h < 2 } { + set h 2 + } + text $wi.statrt.cfg.text -font arial -bg white \ + -width 42 -height $h -takefocus 0 + foreach route $routes { + $wi.statrt.cfg.text insert end "$route " + } + 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} { + # + # Custom startup config + # + global customEnabled + labelframe $wi.custom -padx 4 -pady 4 + frame $wi.custom.label + label $wi.custom.label.txt -text "Custom startup config:" + pack $wi.custom.label.txt -side left -anchor w + set customEnabled [getCustomEnabled $target] + radiobutton $wi.custom.label.enabled -text "enabled" \ + -variable customEnabled -value true + radiobutton $wi.custom.label.disabled -text "disabled" \ + -variable customEnabled -value false + pack $wi.custom.label.enabled $wi.custom.label.disabled \ + -side left -anchor w + pack $wi.custom.label -side top -anchor w + frame $wi.custom.cfg + button $wi.custom.cfg.generate -text "Generate" \ + -command "cfgGenerate $target" + button $wi.custom.cfg.edit -text "Edit" \ + -command "editStartupCfg $target" + button $wi.custom.cfg.clear -text "Clear" \ + -command "setCustomConfig $target {}" + pack $wi.custom.cfg.generate $wi.custom.cfg.edit \ + $wi.custom.cfg.clear -side left + + pack $wi.custom.label -side top -anchor w + pack $wi.custom.cfg -side top + pack $wi.custom -side top -anchor w -fill both + + # + # IPsec configuration: + # + global ipsecEnabled + labelframe $wi.ipsec -padx 4 -pady 4 + frame $wi.ipsec.label + label $wi.ipsec.label.txt -text "Manual IPsec configuration:" + pack $wi.ipsec.label.txt -side left -anchor w + set ipsecEnabled [getIpsecEnabled $target] + radiobutton $wi.ipsec.label.enabled -text "enabled" \ + -variable ipsecEnabled -value true + radiobutton $wi.ipsec.label.disabled -text "disabled" \ + -variable ipsecEnabled -value false + pack $wi.ipsec.label.enabled $wi.ipsec.label.disabled \ + -side left -anchor w + pack $wi.ipsec.label -side top -anchor w + frame $wi.ipsec.cfg + set delete "0" + set view "0" + button $wi.ipsec.cfg.add -text "Add SA/SP" \ + -command "viewIpsecCfg $target $delete $view" + set delete "0" + set view "1" + button $wi.ipsec.cfg.view -text "Edit SAs/SPs" \ + -command "viewIpsecCfg $target $delete $view" + pack $wi.ipsec.cfg.add \ + $wi.ipsec.cfg.view -side left + pack $wi.ipsec.label -side top -anchor w + pack $wi.ipsec.cfg -side top + pack $wi.ipsec -side top -anchor w -fill both + + # + # CPU scheduling parameters + # + labelframe $wi.cpu -padx 4 -pady 4 + label $wi.cpu.minl -text "CPU min%" -anchor w + spinbox $wi.cpu.mine -bg white -width 3 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.cpu.mine insert 0 [lindex \ + [lsearch -inline [getNodeCPUConf $target] {min *}] 1] + $wi.cpu.mine configure \ + -vcmd {checkIntRange %P 1 90} \ + -from 0 -to 90 -increment 1 + label $wi.cpu.maxl -text " max%" -anchor w + spinbox $wi.cpu.maxe -bg white -width 3 \ + -validate focus -invcmd "focusAndFlash %W" + set cpumax [lindex \ + [lsearch -inline [getNodeCPUConf $target] {max *}] 1] + if { $cpumax == "" } { + set cpumax 100 + } + $wi.cpu.maxe insert 0 $cpumax + $wi.cpu.maxe configure \ + -vcmd {checkIntRange %P 1 100} \ + -from 1 -to 100 -increment 1 + label $wi.cpu.weightl -text " weight" -anchor w + spinbox $wi.cpu.weighte -bg white -width 2 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.cpu.weighte insert 0 [lindex \ + [lsearch -inline [getNodeCPUConf $target] {weight *}] 1] + $wi.cpu.weighte configure \ + -vcmd {checkIntRange %P 1 10} \ + -from 1 -to 10 -increment 1 + pack $wi.cpu.minl $wi.cpu.mine \ + $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.butt -borderwidth 6 button $wi.butt.apply -text "Apply" -command \ - "popupConfigApply $wi $object_type $target 0" + "popupConfigApply $wi $object_type $target 0" focus $wi.butt.apply button $wi.butt.cancel -text "Cancel" -command \ - "set badentry -1 ; destroy $wi" + "set badentry -1 ; destroy $wi" pack $wi.butt.cancel $wi.butt.apply -side right pack $wi.butt -side bottom after 100 { - grab .popup + grab .popup } return } @@ -2054,29 +2085,25 @@ proc editStartupCfg { node } { pack $w.ftop -side top -anchor w text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \ - -setgrid 1 -height 40 -undo 1 -autosep 1 -background white + -setgrid 1 -height 10 -undo 1 -autosep 1 -background white focus $w.text scrollbar $w.scroll -command "$w.text yview" - frame $w.buttons - pack $w.buttons -side bottom - button $w.buttons.apply -text "Apply" \ - -command "customConfigApply $w $node" - button $w.buttons.cancel -text Cancel -command "destroy $w" - pack $w.buttons.apply $w.buttons.cancel -side left - pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both + # TODO: Ako je custom-config vec ucitan i ostavimo postavljen custom + # config enabled, onda se ono ucitano razlomi tak da da svako slovo + # dodje u novi red. foreach line [getCustomConfig $node] { - $w.text insert end "$line " + $w.text insert end "$line " } $w.text mark set insert 0.0 + return } - #****f* editor.tcl/customConfigApply # NAME # customConfigApply -- custom configuration apply @@ -2094,13 +2121,13 @@ proc customConfigApply { w node } { global changed set newcmd [$w.ftop.cmd get] - set newconf [split [$w.text get 0.0 end] { }] + set newconf [split [$w.text get 0.0 end] {^M}] while { [lindex $newconf end] == {} && $newconf != {} } { - set newconf [lreplace $newconf end end] + set newconf [lreplace $newconf end end] } if { [getCustomCmd $node] != $newcmd || \ - [getCustomConfig $node] != $newconf } { - set changed 1 + [getCustomConfig $node] != $newconf } { + set changed 1 } setCustomCmd $node $newcmd setCustomConfig $node $newconf @@ -2108,7 +2135,6 @@ proc customConfigApply { w node } { return } - #****f* editor.tcl/popupConfigApply # NAME # popupConfigApply -- popup configuration apply @@ -2130,223 +2156,230 @@ proc customConfigApply { w node } { # set to 0. #**** proc popupConfigApply { wi object_type target phase } { - global changed oper_mode router_model badentry customEnabled + global changed oper_mode router_model badentry + global customEnabled ipsecEnabled global eid $wi config -cursor watch update if { $phase == 0 } { - set badentry 0 - focus . - after 100 "popupConfigApply $wi $object_type $target 1" - return + set badentry 0 + focus . + after 100 "popupConfigApply $wi $object_type $target 1" + return } elseif { $badentry } { - $wi config -cursor left_ptr - return + $wi config -cursor left_ptr + return } switch -exact -- $object_type { - # - # Node - # - node { - 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" && \ - $router_model != $model } { - setNodeModel $target $router_model - set changed 1 - } - - # - # Queue config - # - foreach ifc [ifcList $target] { - if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \ - [nodeType $target] != "rj45" } { - global ifqdisc$ifc ifqdrop$ifc - set qdisc [subst $[subst ifqdisc$ifc]] - set oldqdisc [getIfcQDisc $target $ifc] - if { $qdisc != $oldqdisc } { - setIfcQDisc $target $ifc $qdisc - set changed 1 - } - set qdrop [subst $[subst ifqdrop$ifc]] - set oldqdrop [getIfcQDrop $target $ifc] - if { $qdrop != $oldqdrop } { - setIfcQDrop $target $ifc $qdrop - set changed 1 - } - set len [$wi.if$ifc.cfg.q.len get] - set oldlen [getIfcQLen $target $ifc] - if { $len != $oldlen } { - setIfcQLen $target $ifc $len - set changed 1 - } - } - } - - 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 - } - - 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] } { - 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] } { - 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] } { - 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] } { - setLinkDup $target [$wi.dup.value get] - if { $mirror != "" } { - setLinkDup $mirror [$wi.dup.value get] - } - set changed 1 - } + # + # Node + # + node { + 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" && \ + $router_model != $model } { + setNodeModel $target $router_model + set changed 1 + } + + # + # Queue config + # + foreach ifc [ifcList $target] { + if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \ + [nodeType $target] != "rj45" } { + global ifqdisc$ifc ifqdrop$ifc + set qdisc [subst $[subst ifqdisc$ifc]] + set oldqdisc [getIfcQDisc $target $ifc] + if { $qdisc != $oldqdisc } { + setIfcQDisc $target $ifc $qdisc + set changed 1 + } + set qdrop [subst $[subst ifqdrop$ifc]] + set oldqdrop [getIfcQDrop $target $ifc] + if { $qdrop != $oldqdrop } { + setIfcQDrop $target $ifc $qdrop + set changed 1 + } + set len [$wi.if$ifc.cfg.q.len get] + set oldlen [getIfcQLen $target $ifc] + if { $len != $oldlen } { + setIfcQLen $target $ifc $len + set changed 1 + } + } + } + + 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 + } + + 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] } { + 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] } { + 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] } { + 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] } { + setLinkDup $target [$wi.dup.value get] + if { $mirror != "" } { + setLinkDup $mirror [$wi.dup.value get] + } + set changed 1 + } if { $changed == 1 && $oper_mode == "exec" } { execSetLinkParams $eid $target } - } + } } if { $changed == 1 } { - redrawAll + redrawAll updateUndoLog } destroy $wi @@ -2387,12 +2420,14 @@ proc printCanvas { w } { proc deleteSelection { } { global changed global background - + global viewid + catch {unset viewid} + foreach obj [.c find withtag "node && selected"] { - set lnode [lindex [.c gettags $obj] 1] - if { $lnode != "" } { + set lnode [lindex [.c gettags $obj] 1] + if { $lnode != "" } { removeGUINode $lnode - } + } set changed 1 } .c raise link background @@ -2425,143 +2460,143 @@ proc rearrange { mode } { .menubar.tools entryconfigure "Rearrange selected" -state disabled .bottom.mbuf config -text "autorearrange" if { $mode == "selected" } { - set tagmatch "node && selected" + set tagmatch "node && selected" } else { - set tagmatch "node" + set tagmatch "node" } set otime [clock clicks -milliseconds] while { $autorearrange_enabled } { - set ntime [clock clicks -milliseconds] - if { $otime == $ntime } { - set dt 0.001 - } else { - set dt [expr ($ntime - $otime) * 0.001] - if { $dt > 0.2 } { - set dt 0.2 - } - set otime $ntime - } - - set objects [.c find withtag $tagmatch] - set peer_objects [.c find withtag node] - foreach obj $peer_objects { + set ntime [clock clicks -milliseconds] + if { $otime == $ntime } { + set dt 0.001 + } else { + set dt [expr ($ntime - $otime) * 0.001] + if { $dt > 0.2 } { + set dt 0.2 + } + set otime $ntime + } + + set objects [.c find withtag $tagmatch] + set peer_objects [.c find withtag node] + foreach obj $peer_objects { set node [lindex [.c gettags $obj] 1] - set coords [.c coords $obj] - set x [lindex $coords 0] - set y [lindex $coords 1] - set x_t($node) $x - set y_t($node) $y - - if { $x > 0 } { - set fx [expr 1000 / ($x * $x + 100)] - } else { - set fx 10 - } - set dx [expr $sizex - $x] - if { $dx > 0 } { - set fx [expr $fx - 1000 / ($dx * $dx + 100)] - } else { - set fx [expr $fx - 10] - } - - if { $y > 0 } { - set fy [expr 1000 / ($y * $y + 100)] - } else { - set fy 10 - } - set dy [expr $sizey - $y] - if { $dy > 0 } { - set fy [expr $fy - 1000 / ($dy * $dy + 100)] - } else { - set fy [expr $fy - 10] - } - set fx_t($node) $fx - set fy_t($node) $fy - } - - foreach obj $objects { + set coords [.c coords $obj] + set x [lindex $coords 0] + set y [lindex $coords 1] + set x_t($node) $x + set y_t($node) $y + + if { $x > 0 } { + set fx [expr 1000 / ($x * $x + 100)] + } else { + set fx 10 + } + set dx [expr $sizex - $x] + if { $dx > 0 } { + set fx [expr $fx - 1000 / ($dx * $dx + 100)] + } else { + set fx [expr $fx - 10] + } + + if { $y > 0 } { + set fy [expr 1000 / ($y * $y + 100)] + } else { + set fy 10 + } + set dy [expr $sizey - $y] + if { $dy > 0 } { + set fy [expr $fy - 1000 / ($dy * $dy + 100)] + } else { + set fy [expr $fy - 10] + } + set fx_t($node) $fx + set fy_t($node) $fy + } + + foreach obj $objects { set node [lindex [.c gettags $obj] 1] - set i [lsearch -exact $peer_objects $obj] - set peer_objects [lreplace $peer_objects $i $i] - set x $x_t($node) - set y $y_t($node) - foreach other_obj $peer_objects { - set other [lindex [.c gettags $other_obj] 1] - set o_x $x_t($other) - set o_y $y_t($other) - set dx [expr $x - $o_x] - set dy [expr $y - $o_y] - set d [expr hypot($dx, $dy)] - set d2 [expr $d * $d] - set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)] - set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)] - if {[linkByPeers $node $other] != ""} { - set p_fx [expr $p_fx - $dx * $d2 * .0000000005] - set p_fy [expr $p_fy - $dy * $d2 * .0000000005] - } - set fx_t($node) [expr $fx_t($node) + $p_fx] - set fy_t($node) [expr $fy_t($node) + $p_fy] - set fx_t($other) [expr $fx_t($other) - $p_fx] - set fy_t($other) [expr $fy_t($other) - $p_fy] - } - - foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas || - [getLinkMirror $link] != "" } { - continue - } - set peers [linkPeers $link] - set coords0 [getNodeCoords [lindex $peers 0]] - set coords1 [getNodeCoords [lindex $peers 1]] - set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5] - set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5] - set dx [expr $x - $o_x] - set dy [expr $y - $o_y] - set d [expr hypot($dx, $dy)] - set d2 [expr $d * $d] - set fx_t($node) \ - [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)] - set fy_t($node) \ - [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)] - } - } - - foreach obj $objects { + set i [lsearch -exact $peer_objects $obj] + set peer_objects [lreplace $peer_objects $i $i] + set x $x_t($node) + set y $y_t($node) + foreach other_obj $peer_objects { + set other [lindex [.c gettags $other_obj] 1] + set o_x $x_t($other) + set o_y $y_t($other) + set dx [expr $x - $o_x] + set dy [expr $y - $o_y] + set d [expr hypot($dx, $dy)] + set d2 [expr $d * $d] + set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)] + set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)] + if {[linkByPeers $node $other] != ""} { + set p_fx [expr $p_fx - $dx * $d2 * .0000000005] + set p_fy [expr $p_fy - $dy * $d2 * .0000000005] + } + set fx_t($node) [expr $fx_t($node) + $p_fx] + set fy_t($node) [expr $fy_t($node) + $p_fy] + set fx_t($other) [expr $fx_t($other) - $p_fx] + set fy_t($other) [expr $fy_t($other) - $p_fy] + } + + foreach link $link_list { + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas || + [getLinkMirror $link] != "" } { + continue + } + set peers [linkPeers $link] + set coords0 [getNodeCoords [lindex $peers 0]] + set coords1 [getNodeCoords [lindex $peers 1]] + set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5] + set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5] + set dx [expr $x - $o_x] + set dy [expr $y - $o_y] + set d [expr hypot($dx, $dy)] + set d2 [expr $d * $d] + set fx_t($node) \ + [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)] + set fy_t($node) \ + [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)] + } + } + + foreach obj $objects { set node [lindex [.c gettags $obj] 1] - if { [catch "set v_t($node)" v] } { - set vx 0.0 - set vy 0.0 - } else { - set vx [lindex $v_t($node) 0] - set vy [lindex $v_t($node) 1] - } - set vx [expr $vx + 1000.0 * $fx_t($node) * $dt] - set vy [expr $vy + 1000.0 * $fy_t($node) * $dt] - set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001] - set vx [expr $vx * exp( - $dampk * $dt)] - set vy [expr $vy * exp( - $dampk * $dt)] - set dx [expr $vx * $dt] - set dy [expr $vy * $dt] - set x [expr $x_t($node) + $dx] - set y [expr $y_t($node) + $dy] - set v_t($node) "$vx $vy" - - setNodeCoords $node "$x $y" - .c move $obj $dx $dy - set img [.c find withtag "selectmark && $node"] - .c move $img $dx $dy - set img [.c find withtag "nodelabel && $node"] - .c move $img $dx $dy - setNodeLabelCoords $node [.c coords $img] - .c addtag need_redraw withtag "link && $node" - } - foreach link [.c find withtag "link && need_redraw"] { - redrawLink [lindex [.c gettags $link] 1] - } - .c dtag link need_redraw - update + if { [catch "set v_t($node)" v] } { + set vx 0.0 + set vy 0.0 + } else { + set vx [lindex $v_t($node) 0] + set vy [lindex $v_t($node) 1] + } + set vx [expr $vx + 1000.0 * $fx_t($node) * $dt] + set vy [expr $vy + 1000.0 * $fy_t($node) * $dt] + set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001] + set vx [expr $vx * exp( - $dampk * $dt)] + set vy [expr $vy * exp( - $dampk * $dt)] + set dx [expr $vx * $dt] + set dy [expr $vy * $dt] + set x [expr $x_t($node) + $dx] + set y [expr $y_t($node) + $dy] + set v_t($node) "$vx $vy" + + setNodeCoords $node "$x $y" + .c move $obj $dx $dy + set img [.c find withtag "selectmark && $node"] + .c move $img $dx $dy + set img [.c find withtag "nodelabel && $node"] + .c move $img $dx $dy + setNodeLabelCoords $node [.c coords $img] + .c addtag need_redraw withtag "link && $node" + } + foreach link [.c find withtag "link && need_redraw"] { + redrawLink [lindex [.c gettags $link] 1] + } + .c dtag link need_redraw + update } .menubar.tools entryconfigure "Rearrange all" -state normal .menubar.tools entryconfigure "Rearrange selected" -state normal @@ -2587,46 +2622,46 @@ 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] - } - } - next { - 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] - } - last { - set curcanvas [lindex $canvas_list end] - } + prev { + 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] + } + } + first { + set curcanvas [lindex $canvas_list 0] + } + last { + set curcanvas [lindex $canvas_list end] + } } .hframe.t delete all set x 0 foreach canvas $canvas_list { - set text [.hframe.t create text 0 0 \ - -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"] - 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"] - .hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2] - .hframe.t raise $text - incr x [expr 2 * $ox + 17] + set text [.hframe.t create text 0 0 \ + -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"] + 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"] + .hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2] + .hframe.t raise $text + incr x [expr 2 * $ox + 17] } incr x 7 .hframe.t raise "$curcanvas" @@ -2639,10 +2674,10 @@ proc switchCanvas { direction } { set lmargin [expr [lindex [.hframe.t xview] 0] * $x - 1] set rmargin [expr [lindex [.hframe.t xview] 1] * $x + 1] if { $lborder < $lmargin } { - .hframe.t xview moveto [expr 1.0 * ($lborder - 10) / $x] + .hframe.t xview moveto [expr 1.0 * ($lborder - 10) / $x] } if { $rborder > $rmargin } { - .hframe.t xview moveto [expr 1.0 * ($rborder - $width + 10) / $x] + .hframe.t xview moveto [expr 1.0 * ($rborder - $width + 10) / $x] } redrawAll @@ -2701,7 +2736,7 @@ proc renameCanvasApply { w } { set newname [$w.e1 get] destroy $w if { $newname != [getCanvasName $curcanvas] } { - set changed 1 + set changed 1 } setCanvasName $curcanvas $newname switchCanvas none @@ -2724,13 +2759,13 @@ proc animate {} { .c itemconfigure "selectmark || selectbox" -dashoffset $animatephase incr animatephase 2 if { $animatephase == 100 } { - set animatephase 0 + set animatephase 0 } if { $oper_mode == "edit" } { - after 250 animate + after 250 animate } else { - after 1500 animate + after 1500 animate } return } @@ -2807,7 +2842,7 @@ proc configRemoteHosts {} { 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" + -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 \ @@ -2815,29 +2850,29 @@ proc configRemoteHosts {} { $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" + -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 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 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 - # -command { - # if { active_ssh(0) } { - # eval $wi.hosts.userName.v$i -configure state normal - # } else { - # eval $wi.hosts.userName.v$i -configure state disabled - # } - # } - - eval entry $wi.hosts.userName.v$i -bg white -width 5 \ - -validate focus -invcmd "focusAndFlash" - $wi.hosts.userName.v$i insert 0 [lindex $host_elem 5] + eval checkbutton $wi.hosts.ssh.v$i \ + -variable active_ssh($i) -onvalue true -offvalue false + # -command { + # if { active_ssh(0) } { + # eval $wi.hosts.userName.v$i -configure state normal + # } else { + # eval $wi.hosts.userName.v$i -configure state disabled + # } + # } + + eval entry $wi.hosts.userName.v$i -bg white -width 5 \ + -validate focus -invcmd "focusAndFlash" + $wi.hosts.userName.v$i insert 0 [lindex $host_elem 5] incr i } @@ -2851,7 +2886,7 @@ proc configRemoteHosts {} { } pack $wi.hosts.labels $wi.hosts.address $wi.hosts.ports \ $wi.hosts.monitors $wi.hosts.active \ - $wi.hosts.ssh $wi.hosts.userName -side left -fill x + $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 @@ -2859,14 +2894,14 @@ proc configRemoteHosts {} { "configRemoteHostsApply $wi; destroy $wi" focus $wi.butt.apply button $wi.butt.cancel -text "Cancel" -command \ - "set remote_exec $old_remote_exec; destroy $wi" + "set remote_exec $old_remote_exec; destroy $wi" pack $wi.butt.cancel $wi.butt.apply -side right pack $wi.butt -side bottom enable_disable $wi after 100 { - grab .popup + grab .popup } ;# Apply and Cancel explicitly destroy $wi vwait forever @@ -2896,14 +2931,14 @@ proc configRemoteHostsApply { wi } { [$wi.hosts.ports.v$i get] \ [$wi.hosts.monitors.v$i get]\ $active_host($i) \ - $active_ssh($i)\ - [$wi.hosts.userName.v$i get]] + $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 - .menubar.experiment entryconfigure "Execute" -state disabled + .menubar.experiment entryconfigure "Execute" -state disabled } # catch { unset exec_sock monitor_sock } message # set exec_sockets_opened false @@ -2933,7 +2968,7 @@ proc enable_disable { wi } { } if { $editor_only } { - .menubar.experiment entryconfigure "Execute" -state disabled + .menubar.experiment entryconfigure "Execute" -state disabled } else { .menubar.experiment entryconfigure "Execute" -state normal } @@ -2943,9 +2978,9 @@ proc enable_disable { wi } { 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 + 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 da9fb96..c4f58e3 100755 --- a/exec.tcl +++ b/exec.tcl @@ -402,6 +402,8 @@ proc l3node.start { eid node } { nexec vimage $node_id ifconfig $ifc mtu $mtu } + set ipsecCfg "" + if { [getCustomEnabled $node] == true } { set bootcmd [getCustomCmd $node] set bootcfg [getCustomConfig $node] @@ -409,6 +411,21 @@ proc l3node.start { eid node } { set bootcmd "" set bootcfg "" } + + 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 + + # TODO: Show the user if setkey.conf has + # been succesfully loaded. + catch "nexec vimage $node_id setkey -f \ + /tmp/$node_id/setkey.conf" + } + if { $bootcmd == "" || $bootcfg =="" } { set bootcfg [[typemodel $node].cfggen $node] set bootcmd [[typemodel $node].bootcmd $node] @@ -426,7 +443,8 @@ proc l3node.start { eid node } { } nexec close_conf_file } - catch "nexec vimage $node_id $bootcmd /tmp/$node_id/boot.conf &" + + catch "nexec vimage $node_id $bootcmd /tmp/$node_id/boot.conf &" } #****f* exec.tcl/l3node.shutdown diff --git a/imunes.tcl b/imunes.tcl index a65d081..da7acbc 100755 --- a/imunes.tcl +++ b/imunes.tcl @@ -108,6 +108,8 @@ source "$ROOTDIR/$LIBDIR/filemgmt.tcl" source "$ROOTDIR/$LIBDIR/ns2imunes.tcl" +source "$ROOTDIR/$LIBDIR/ipsec.tcl" + # # Global variables are initialized here # diff --git a/initgui.tcl b/initgui.tcl index 959b866..acca085 100755 --- a/initgui.tcl +++ b/initgui.tcl @@ -124,7 +124,7 @@ set autorearrange_enabled 0 # # Initialize a few variables to default values # -set defLinkColor red +set defLinkColor red set defLinkWidth 2 set defEthBandwidth 100000000 set defSerBandwidth 2048000 diff --git a/install.sh b/install.sh index 638d017..d136b97 100755 --- a/install.sh +++ b/install.sh @@ -25,7 +25,7 @@ chmod 755 $ROOTDIR/$BINDIR/imunes lib_files="nodecfg.tcl linkcfg.tcl cfgparse.tcl ipv4.tcl ipv6.tcl exec.tcl \ canvas.tcl editor.tcl filemgmt.tcl help.tcl initgui.tcl \ quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \ - lanswitch.tcl rj45.tcl hub.tcl ns2imunes.tcl" + lanswitch.tcl rj45.tcl hub.tcl ns2imunes.tcl ipsec.tcl" tiny_icons="delete.gif hub.gif frswitch.gif host.gif \ lanswitch.gif link.gif pc.gif rj45.gif router.gif select.gif" diff --git a/nodecfg.tcl b/nodecfg.tcl index 85cce81..eb31b10 100755 --- a/nodecfg.tcl +++ b/nodecfg.tcl @@ -328,6 +328,12 @@ proc getCustomCmd { node } { return [lindex [lsearch -inline [set $node] "custom-command *"] 1] } +proc getAddCustomCmd { node } { + global $node + + return [lindex [lsearch -inline [set $node] "add-custom-command *"] 1] +} + #****f* nodecfg.tcl/setCustomCmd # NAME # setCustomEnabled -- set custom configuration command @@ -351,6 +357,18 @@ proc setCustomCmd { node cmd } { return } +# TODO: +proc setAddCustomCmd { node cmd } { + global $node + + set i [lsearch [set $node] "add-custom-command *"] + if { $i >= 0 } { + set $node [lreplace [set $node] $i $i] + } + lappend $node [list add-custom-command $cmd] + return +} + #****f* nodecfg.tcl/getCustomConfig # NAME # getCustomConfig -- get custom configuration section @@ -370,6 +388,12 @@ proc getCustomConfig { node } { return [lindex [lsearch -inline [set $node] "custom-config *"] 1] } +proc getAddCustomConfig { node } { + global $node + + return [lindex [lsearch -inline [set $node] "add-custom-config *"] 1] +} + #****f* nodecfg.tcl/setCustomConfig # NAME # setCustomConfig -- set custom configuration command @@ -395,6 +419,20 @@ proc setCustomConfig { node cfg } { return } +# TODO +proc setAddCustomConfig { node cfg } { + global $node + + set i [lsearch [set $node] "add-custom-config *"] + if { $i >= 0 } { + set $node [lreplace [set $node] $i $i] + } + if { $cfg != {} } { + lappend $node [list add-custom-config $cfg] + } + return +} + #****f* nodecfg.tcl/netconfFetchSection # NAME # netconfFetchSection -- fetch the network configuration section @@ -1508,7 +1546,9 @@ proc newIfc { type node } { proc newNode { type } { global node_list def_router_model - + global viewid + catch {unset viewid} + set node [newObjectId node] global $node set $node {}