created files ipv4.tcl and ipv6.tcl.
Move the MTU rolobox in interface config window from IPv4 address to toplevel.
Change the default IPv6 subnet from fefe:0:: to fec0:0:0:0:: which should
be more correct according to certain authors (site-local prefix space).
Add proc $MODULE.layer for each node type. Return value can be either
NETWORK or LINK and is to be used primarily by editor.tcl for choosing
which configurable parameter to show / offer on a per-node basis.
Add proc removeNode and removeLink which do not manipulate on any Tk
objects, thus can be invoked in plain tcl scripts. For removing Tk objects
(primarily in editor.tcl) removeGUINode and removeGUILink should be used.
Node names can now be arbitrary strings, including punctuation and
whitespaces.
Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:
}
-proc removeLink { link } {
- global links $link
+proc removeGUILink { link } {
global .c
- set nodes [lindex [lsearch -inline [set $link] "nodes *"] 1]
- foreach node $nodes {
- global $node
- set i [lsearch $nodes $node]
- set peer [lreplace $nodes $i $i]
- set ifc [ifcByPeer $node $peer]
- netconfClearSection $node "interface $ifc"
- set i [lsearch [set $node] "interface-peer {$ifc $peer}"]
- set $node [lreplace [set $node] $i $i]
- }
- unset $link
- set i [lsearch -exact $links $link]
- set links [lreplace $links $i $i]
+ removeLink $link
.c delete $link
return
}
-proc removeNode { node } {
- global nodes $node
+proc removeGUINode { node } {
global .c
foreach ifc [ifcList $node] {
set peer [peerByIfc $node $ifc]
set link [lindex [.c gettags "link && $node && $peer"] 1]
- removeLink $link
+ removeGUILink $link
}
- unset $node
- set i [lsearch -exact $nodes $node]
- set nodes [lreplace $nodes $i $i]
+ removeNode $node
.c delete $node
return
}
# Cleanup first - this also automatically deletes all associated links
foreach node $nodes {
- removeNode $node
+ removeGUINode $node
}
set class ""
proc drawLink {link} {
global defLinkWidth defLinkColor
- set nodes [linkEndpoints $link]
+ set nodes [linkPeers $link]
set lnode1 [lindex $nodes 0]
set lnode2 [lindex $nodes 1]
set newlink [.c create line 0 0 0 0 \
}
-proc newId { type } {
+proc newObjectId { type } {
global nodes links
set mark [string range [set type] 0 0]
}
-proc findFreeIPv4net { mask } {
- global nodes
-
- set ipnets {}
- foreach node $nodes {
- foreach ifc [ifcList $node] {
- set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2]
- if {[lsearch $ipnets $ipnet] == -1} {
- lappend ipnets $ipnet
- }
- }
- }
- for { set i 0 } { $i <= 255 } { incr i } {
- for { set j 0 } { $j <= 255 } { incr j } {
- if {[lsearch $ipnets "10 $i $j"] == -1} {
- set ipnet "10.$i.$j"
- return $ipnet
- }
- }
- }
-}
-
-
-proc findFreeIPv6net { mask } {
- global nodes
-
- set ipnets {}
- foreach node $nodes {
- foreach ifc [ifcList $node] {
- set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 1]
- if {[lsearch $ipnets $ipnet] == -1} {
- lappend ipnets $ipnet
- }
- }
- }
- for { set i 0 } { $i <= 9999 } { incr i } {
- if {[lsearch $ipnets "fefe $i"] == -1} {
- set ipnet "fefe:$i"
- return $ipnet
- }
- }
-}
-
-
proc listLANnodes { l2node l2peers } {
lappend l2peers $l2node
foreach ifc [ifcList $l2node] {
}
-proc newLANIPv4 { l3node bridge } {
- set peer_ipaddrs {}
- set l2nodes [listLANnodes $bridge {}]
- foreach l2node $l2nodes {
- foreach ifc [ifcList $l2node] {
- set peer [peerByIfc $l2node $ifc]
- set peer_if [ifcByPeer $peer $l2node]
- set peer_ipaddr [getIfcIPv4addr $peer $peer_if]
- if { $peer_ipaddr != "" } {
- lappend peer_ipaddrs [lindex [split $peer_ipaddr /] 0]
- }
- }
- }
- switch -exact -- [nodeType $l3node] {
- router {
- set targetbyte 1
- }
- host {
- set targetbyte 10
- }
- pc {
- set targetbyte 20
- }
- }
- if { $peer_ipaddrs != "" } {
- set ipnums [split [lindex $peer_ipaddrs 0] .]
- set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]"
- set ipaddr $net.$targetbyte
- while { [lsearch $peer_ipaddrs $ipaddr] >= 0 } {
- incr targetbyte
- set ipaddr $net.$targetbyte
- }
- return "$ipaddr/24"
- } else {
- return "[findFreeIPv4net 24].$targetbyte/24"
- }
-}
-
-
-proc newLANIPv6 { l3node bridge } {
- set peer_ipaddrs {}
- set l2nodes [listLANnodes $bridge {}]
- foreach l2node $l2nodes {
- foreach ifc [ifcList $l2node] {
- set peer [peerByIfc $l2node $ifc]
- set peer_if [ifcByPeer $peer $l2node]
- set peer_ipaddr [getIfcIPv6addr $peer $peer_if]
- if { $peer_ipaddr != "" } {
- lappend peer_ipaddrs [lindex [split $peer_ipaddr /] 0]
- }
- }
- }
- switch -exact -- [nodeType $l3node] {
- router {
- set targetbyte 1
- }
- host {
- set targetbyte 10
- }
- pc {
- set targetbyte 20
- }
- }
- if { $peer_ipaddrs != "" } {
- set ipnums [split [lindex $peer_ipaddrs 0] :]
- set net "[lindex $ipnums 0]:[lindex $ipnums 1]"
- set ipaddr $net\::$targetbyte
- while { [lsearch $peer_ipaddrs $ipaddr] >= 0 } {
- incr targetbyte
- set ipaddr $net\::$targetbyte
- }
- return "$ipaddr/64"
- } else {
- return "[findFreeIPv6net 64]::$targetbyte/64"
- }
-}
-
-
-proc findLANdgIP { bridge } {
- foreach ifc [ifcList $bridge] {
- set peer [peerByIfc $bridge $ifc]
- set peer_if [ifcByPeer $peer $bridge]
- set peer_ipaddr [getIfcIPv4addr $peer $peer_if]
- if { [nodeType $peer] == "router" } {
- return [lindex [split $peer_ipaddr /] 0]
- }
- }
-}
-
-
-proc updateLANdg { bridge } {
- set gw [findLANdgIP $bridge]
- if { $gw == "" } {
- return
- }
- foreach ifc [ifcList $bridge] {
- set peer [peerByIfc $bridge $ifc]
- if { [nodeType $peer] == "pc" || [nodeType $peer] == "host" } {
- setStatIPv4routes $peer [list "0.0.0.0/0 $gw"]
- }
- }
- return
-}
-
-
-
proc calcDxDy { lnode } {
global showIfIPaddrs
upvar dx x
set interface ""
set tk_type [lindex [$c gettags current] 0]
set target [lindex [$c gettags current] 1]
- set n0 [lindex [linkEndpoints $target] 0]
- set n1 [lindex [linkEndpoints $target] 1]
- if { [lsearch {hub lanswitch rj45} [nodeType $n0]] < 0 } {
+ set n0 [lindex [linkPeers $target] 0]
+ set n1 [lindex [linkPeers $target] 1]
+ if { [[typemodel $n0].layer] == "NETWORK" } {
set interface "[ifcByPeer $n0 $n1]@$eid\_$n0"
- } elseif { [lsearch {hub lanswitch rj45} [nodeType $n1]] < 0 } {
+ } elseif { [[typemodel $n1].layer] == "NETWORK" } {
set interface "[ifcByPeer $n1 $n0]@$eid\_$n1"
}
if { $interface != "" } {
$c delete -withtags selectmark
}
if {$curobj == $background} {
- if { [lsearch {router pc host hub lanswitch frswitch rj45} \
- $activetool] >= 0 } {
- set node [newId node]
+ if { [lsearch {select delete} $activetool] < 0 } {
+ set node [newObjectId node]
global $node
lappend $node "type $activetool"
if { $activetool == "router" } {
set link [lindex [$c gettags {linklabel && current}] 1]
}
if { $link != "" } {
- removeLink $link
+ removeGUILink $link
set changed 1
} elseif { $node != "" } {
foreach obj [$c find withtag "node && selected"] {
- removeNode [lindex [$c gettags $obj] 1]
+ removeGUINode [lindex [$c gettags $obj] 1]
}
set changed 1
}
set x [lindex [$c coords $destobj] 0]
set y [lindex [$c coords $destobj] 1]
if { $regular == "yes" } {
- set link [newId link]
+ set link [newObjectId link]
global $link
set ipv4net [findFreeIPv4net 24]
set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
- if { [lsearch {lanswitch hub rj45} [nodeType $lnode1]] < 0 && \
+ if { [[typemodel $lnode1].layer] == "NETWORK" && \
[lsearch {lanswitch hub} [nodeType $lnode2]] >= 0 } {
setIfcIPv4addr $lnode1 $ifname1 [newLANIPv4 $lnode1 $lnode2]
setIfcIPv6addr $lnode1 $ifname1 [newLANIPv6 $lnode1 $lnode2]
set lannode $lnode2
- } elseif { [lsearch {hub frswitch lanswitch rj45} \
- [nodeType $lnode1]] < 0 } {
+ } elseif { [[typemodel $lnode1].layer] == "NETWORK" } {
setIfcIPv4addr $lnode1 $ifname1 $ipv4net.1/24
setIfcIPv6addr $lnode1 $ifname1 $ipv6net\::1/64
if { [nodeType $lnode1] == "pc" || \
set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
- if { [lsearch {lanswitch hub rj45} [nodeType $lnode2]] < 0 && \
+ if { [[typemodel $lnode2].layer] == "NETWORK" && \
[lsearch {lanswitch hub} [nodeType $lnode1]] >= 0 } {
setIfcIPv4addr $lnode2 $ifname2 [newLANIPv4 $lnode2 $lnode1]
setIfcIPv6addr $lnode2 $ifname2 [newLANIPv6 $lnode2 $lnode1]
set lannode $lnode1
- } elseif { [lsearch {hub frswitch lanswitch rj45} \
- [nodeType $lnode2]] < 0 } {
+ } elseif { [[typemodel $lnode2].layer] == "NETWORK" } {
setIfcIPv4addr $lnode2 $ifname2 $ipv4net.2/24
setIfcIPv6addr $lnode2 $ifname2 $ipv6net\::2/64
if { [nodeType $lnode2] == "pc" || \
}
-proc checkIPv4Addr { str } {
- set n 0
- while { $n < 4 } {
- if { $n < 3 } {
- set i [string first . $str]
- } else {
- set i [string length $str]
- }
- if { $i < 1 } {
- return 0
- }
- set part [string range $str 0 [expr $i - 1]]
- if { [string length [string trim $part]] != $i } {
- return 0
- }
- if { ![string is integer $part] } {
- return 0
- }
- if { $part < 0 || $part > 255 } {
- return 0
- }
- set str [string range $str [expr $i + 1] end]
- incr n
- }
- return 1
-}
-
-
-proc checkIPv4Net { str } {
- if { $str == "" } {
- return 1
- }
- if { ![checkIPv4Addr [lindex [split $str /] 0]]} {
- return 0
- }
- set net [lindex [split $str /] 1]
- if { [string length [string trim $net]] != [string length $net] } {
- return 0
- }
- return [checkIntRange $net 0 32]
-}
-
-
-proc checkIPv6Addr { str } {
- set doublec false
- set wordlist [split $str :]
- set wordcnt [expr [llength $wordlist] - 1]
- if { $wordcnt > 7 } {
- return 0
- }
- if { [lindex $wordlist 0] == "" } {
- set wordlist [lreplace $wordlist 0 0 0]
- }
- if { [lindex $wordlist $wordcnt] == "" } {
- set wordlist [lreplace $wordlist $wordcnt $wordcnt 0]
- }
- for { set i 0 } { $i <= $wordcnt } { incr i } {
- set word [lindex $wordlist $i]
- if { $word == "" } {
- if { $doublec == "true" } {
- return 0
- }
- set doublec true
- }
- if { [string length $word] > 4 } {
- if { $i == $wordcnt } {
- return [checkIPv4Addr $word]
- } else {
- return 0
- }
- }
- if { [string is xdigit $word] == 0 } {
- return 0
- }
- }
- return 1
-}
-
-
-proc checkIPv6Net { str } {
- if { $str == "" } {
- return 1
- }
- if { ![checkIPv6Addr [lindex [split $str /] 0]]} {
- return 0
- }
- set net [lindex [split $str /] 1]
- if { [string length [string trim $net]] != [string length $net] } {
- return 0
- }
- return [checkIntRange $net 0 128]
-}
-
-
proc focusAndFlash {W {count 9}} {
global badentry
return
}
if { $object_type == "link" } {
- set n0 [lindex [linkEndpoints $target] 0]
- set n1 [lindex [linkEndpoints $target] 1]
+ set n0 [lindex [linkPeers $target] 0]
+ set n1 [lindex [linkPeers $target] 1]
if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } {
destroy $wi
return
entry $wi.ftop.name -bg white -width 16 \
-validate focus -invcmd "focusAndFlash %W"
$wi.ftop.name insert 0 [getNodeName $target]
- $wi.ftop.name configure -vcmd {string is alnum %P}
pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4
pack $wi.ftop -side top
if { $type == "router" } {
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 { $type != "lanswitch" } {
+ 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
- if { 1 } {
- #
- # 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
- }
+ #
+ # 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 & MTU
+ # 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 16 \
+ 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}
- label $wi.if$ifc.cfg.ipv4.mtul -text "MTU" \
- -anchor e -width 5
- spinbox $wi.if$ifc.cfg.ipv4.mtuv -bg white -width 4 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.if$ifc.cfg.ipv4.mtuv insert 0 \
- [getIfcMTU $target $ifc]
- if {![string first eth $ifc]} {
- $wi.if$ifc.cfg.ipv4.mtuv configure \
- -from 256 -to 1500 -increment 2 \
- -vcmd {checkIntRange %P 256 1500}
- } else {
- $wi.if$ifc.cfg.ipv4.mtuv configure \
- -from 256 -to 2044 -increment 2 \
- -vcmd {checkIntRange %P 256 2044}
- }
pack $wi.if$ifc.cfg.ipv4.addrl \
- $wi.if$ifc.cfg.ipv4.addrv \
- $wi.if$ifc.cfg.ipv4.mtul \
- $wi.if$ifc.cfg.ipv4.mtuv -side left
+ $wi.if$ifc.cfg.ipv4.addrv -side left
pack $wi.if$ifc.cfg.ipv4 -side top -anchor w
#
set h 2
}
text $wi.statrt.cfg.text -font arial -bg white \
- -width 40 -height $h -takefocus 0
+ -width 42 -height $h -takefocus 0
foreach route $routes {
$wi.statrt.cfg.text insert end "$route\r"
}
if { [getCustomCmd $node] != $newcmd || \
[getCustomConfig $node] != $newconf } {
set changed 1
- updateUndoLog
}
setCustomCmd $node $newcmd
setCustomConfig $node $newconf
node {
set type [nodeType $target]
set model [getNodeModel $target]
- set name [lindex [split [$wi.ftop.name get]] 0]
+ set name [string trim [$wi.ftop.name get]]
if { $name != [getNodeName $target] } {
setNodeName $target $name
.c itemconfigure "nodelabel && $target" -text $name
}
}
- if {[lsearch {router pc host} [nodeType $target]] >= 0} {
+ if {[[typemodel $target].layer] == "NETWORK"} {
foreach ifc [ifcList $target] {
#
# Operational state
set changed 1
}
- set mtu [$wi.if$ifc.cfg.ipv4.mtuv get]
+ set mtu [$wi.if$ifc.label.mtuv get]
set oldmtu [getIfcMTU $target $ifc]
if { $mtu != $oldmtu } {
setIfcMTU $target $ifc $mtu
close $p
}
+
proc delete_object { c x y } {
global changed
global background
set link [lindex [$c gettags {linklabel && current}] 1]
}
if { $link != "" } {
- removeLink $link
+ removeGUILink $link
set changed 1
}
if { $node != "" } {
- removeNode $node
+ removeGUINode $node
set changed 1
}
foreach obj [$c find withtag "node && selected"] {
- removeNode [lindex [$c gettags $obj] 1]
+ removeGUINode [lindex [$c gettags $obj] 1]
set changed 1
}
$c raise link background
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
set mac 0
foreach link $links {
statline "Creating link $link"
- set lnode1 [lindex [linkEndpoints $link] 0]
- set lnode2 [lindex [linkEndpoints $link] 1]
+ set lnode1 [lindex [linkPeers $link] 0]
+ set lnode2 [lindex [linkPeers $link] 1]
set ifname1 [ifcByPeer $lnode1 $lnode2]
set ifname2 [ifcByPeer $lnode2 $lnode1]
set bandwidth [expr [getLinkBandwidth $link] + 0]
set peer [peerByIfc $node $ifc]
foreach link $links {
- set endpoints [linkEndpoints $link]
+ set endpoints [linkPeers $link]
if { $endpoints == "$node $peer" } {
set dir downstream
break
proc execSetIfcQDisc { eid node ifc qdisc } {
set target [linkByIfc $node $ifc]
- set peers [linkEndpoints [lindex $target 0]]
+ set peers [linkPeers [lindex $target 0]]
set dir [lindex $target 1]
set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
switch -exact $qdisc {
proc execSetIfcQDrop { eid node ifc qdrop } {
set target [linkByIfc $node $ifc]
- set peers [linkEndpoints [lindex $target 0]]
+ set peers [linkPeers [lindex $target 0]]
set dir [lindex $target 1]
set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
switch -exact $qdrop {
proc execSetIfcQLen { eid node ifc qlen } {
set target [linkByIfc $node $ifc]
- set peers [linkEndpoints [lindex $target 0]]
+ set peers [linkPeers [lindex $target 0]]
set dir [lindex $target 1]
set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
nexec ngctl msg $ngnode: setcfg "{ $dir={ queuelen=$qlen } }"
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
set copyright {
-Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
set MODULE host
+
+proc $MODULE.layer {} {
+ return NETWORK
+}
+
+
proc $MODULE.cfggen { node } {
global $node
set MODULE hub
+proc $MODULE.layer {} {
+ return LINK
+}
+
+
proc $MODULE.instantiate { eid node } {
catch {nexec ngctl mkpeer hub anchor anchor | tail -1} resp
foreach elem [split [lindex [split $resp "\{\}"] 1]] {
#!/bin/sh
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
set LIBDIR ""
set ROOTDIR "."
-source "$ROOTDIR/$LIBDIR/exec.tcl"
source "$ROOTDIR/$LIBDIR/linkcfg.tcl"
source "$ROOTDIR/$LIBDIR/nodecfg.tcl"
+source "$ROOTDIR/$LIBDIR/ipv4.tcl"
+source "$ROOTDIR/$LIBDIR/ipv6.tcl"
source "$ROOTDIR/$LIBDIR/editor.tcl"
source "$ROOTDIR/$LIBDIR/help.tcl"
source "$ROOTDIR/$LIBDIR/filemgmt.tcl"
+source "$ROOTDIR/$LIBDIR/exec.tcl"
source "$ROOTDIR/$LIBDIR/quagga.tcl"
source "$ROOTDIR/$LIBDIR/xorp.tcl"
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
.menubar add cascade -label File -underline 0 -menu .menubar.file
.menubar add cascade -label Edit -underline 0 -menu .menubar.edit
+.menubar add cascade -label Sheet -underline 0 -menu .menubar.sheet
.menubar add cascade -label View -underline 0 -menu .menubar.view
.menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
.menubar add cascade -label Help -underline 0 -menu .menubar.help
+
+#
+# File
+#
menu .menubar.file -tearoff 0
.menubar.file add command -label New -underline 0 \
.menubar.file add separator
.menubar.file add command -label Quit -underline 0 -command { exit }
+
+#
+# Edit
+#
menu .menubar.edit -tearoff 0
.menubar.edit add command -label "Undo" -underline 0 \
-accelerator "Ctrl+Z" -command undo
-accelerator "Ctrl+Y" -command redo
bind . <Control-y> redo
+
+#
+# Sheet
+#
+menu .menubar.sheet -tearoff 0
+
+
+#
+# View
+#
menu .menubar.view -tearoff 0
.menubar.view add cascade -label "Show" -underline 0 \
-menu .menubar.view.show
}
}
+
+#
+# Experiment
+#
menu .menubar.experiment -tearoff 0
.menubar.experiment add command -label "Execute" -underline 0 \
-command "setOperMode exec"
.menubar.experiment add command -label "Terminate" -underline 0 \
-command "setOperMode edit" -state disabled
+
+#
+# Tools
+#
menu .menubar.tools -tearoff 0
+
+#
+# Help
+#
menu .menubar.help -tearoff 0
.menubar.help add command -label "About" -command {
toplevel .about
pack .left -side left -fill y
foreach b {select delete link hub lanswitch router host pc rj45} {
- set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif]
- radiobutton .left.$b -indicatoron 0 \
- -variable activetool -value $b -selectcolor [.left cget -bg] \
- -width 32 -height 32 -activebackground gray -image $image
- pack .left.$b -side top
+ set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif]
+ radiobutton .left.$b -indicatoron 0 \
+ -variable activetool -value $b -selectcolor [.left cget -bg] \
+ -width 32 -height 32 -activebackground gray -image $image
+ pack .left.$b -side top
}
foreach b {router host pc hub lanswitch frswitch rj45} {
- set $b [image create photo -file $ROOTDIR/$LIBDIR/icons/normal/$b.gif]
+ set $b [image create photo -file $ROOTDIR/$LIBDIR/icons/normal/$b.gif]
}
lib_files="editor.tcl exec.tcl filemgmt.tcl nodecfg.tcl linkcfg.tcl help.tcl \
initgui.tcl quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \
- lanswitch.tcl rj45.tcl hub.tcl quaggaboot.sh"
+ ipv4.tcl ipv6.tcl lanswitch.tcl rj45.tcl hub.tcl quaggaboot.sh"
tiny_icons="delete.gif hub.gif frswitch.gif host.gif \
lanswitch.gif link.gif pc.gif rj45.gif router.gif select.gif"
--- /dev/null
+#
+# Copyright 2005 University of Zagreb, Croatia. All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. All advertising materials mentioning features or use of this software
+# must display the following acknowledgement:
+# This product includes software developed by the University of Zagreb,
+# Croatia and its contributors.
+# 4. Neither the name of the University nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# This work was supported in part by Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+proc findFreeIPv4net { mask } {
+ global nodes
+
+ set ipnets {}
+ foreach node $nodes {
+ foreach ifc [ifcList $node] {
+ set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2]
+ if {[lsearch $ipnets $ipnet] == -1} {
+ lappend ipnets $ipnet
+ }
+ }
+ }
+ for { set i 0 } { $i <= 255 } { incr i } {
+ for { set j 0 } { $j <= 255 } { incr j } {
+ if {[lsearch $ipnets "10 $i $j"] == -1} {
+ set ipnet "10.$i.$j"
+ return $ipnet
+ }
+ }
+ }
+}
+
+
+proc newLANIPv4 { l3node bridge } {
+ set peer_ipaddrs {}
+ set l2nodes [listLANnodes $bridge {}]
+ foreach l2node $l2nodes {
+ foreach ifc [ifcList $l2node] {
+ set peer [peerByIfc $l2node $ifc]
+ set peer_if [ifcByPeer $peer $l2node]
+ set peer_ipaddr [getIfcIPv4addr $peer $peer_if]
+ if { $peer_ipaddr != "" } {
+ lappend peer_ipaddrs [lindex [split $peer_ipaddr /] 0]
+ }
+ }
+ }
+ switch -exact -- [nodeType $l3node] {
+ router {
+ set targetbyte 1
+ }
+ host {
+ set targetbyte 10
+ }
+ pc {
+ set targetbyte 20
+ }
+ }
+ if { $peer_ipaddrs != "" } {
+ set ipnums [split [lindex $peer_ipaddrs 0] .]
+ set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]"
+ set ipaddr $net.$targetbyte
+ while { [lsearch $peer_ipaddrs $ipaddr] >= 0 } {
+ incr targetbyte
+ set ipaddr $net.$targetbyte
+ }
+ return "$ipaddr/24"
+ } else {
+ return "[findFreeIPv4net 24].$targetbyte/24"
+ }
+}
+
+
+proc findLANdgIP { bridge } {
+ foreach ifc [ifcList $bridge] {
+ set peer [peerByIfc $bridge $ifc]
+ set peer_if [ifcByPeer $peer $bridge]
+ set peer_ipaddr [getIfcIPv4addr $peer $peer_if]
+ if { [nodeType $peer] == "router" } {
+ return [lindex [split $peer_ipaddr /] 0]
+ }
+ }
+}
+
+
+proc updateLANdg { bridge } {
+ set gw [findLANdgIP $bridge]
+ if { $gw == "" } {
+ return
+ }
+ foreach ifc [ifcList $bridge] {
+ set peer [peerByIfc $bridge $ifc]
+ if { [nodeType $peer] == "pc" || [nodeType $peer] == "host" } {
+ setStatIPv4routes $peer [list "0.0.0.0/0 $gw"]
+ }
+ }
+ return
+}
+
+
+proc checkIPv4Addr { str } {
+ set n 0
+ while { $n < 4 } {
+ if { $n < 3 } {
+ set i [string first . $str]
+ } else {
+ set i [string length $str]
+ }
+ if { $i < 1 } {
+ return 0
+ }
+ set part [string range $str 0 [expr $i - 1]]
+ if { [string length [string trim $part]] != $i } {
+ return 0
+ }
+ if { ![string is integer $part] } {
+ return 0
+ }
+ if { $part < 0 || $part > 255 } {
+ return 0
+ }
+ set str [string range $str [expr $i + 1] end]
+ incr n
+ }
+ return 1
+}
+
+
+proc checkIPv4Net { str } {
+ if { $str == "" } {
+ return 1
+ }
+ if { ![checkIPv4Addr [lindex [split $str /] 0]]} {
+ return 0
+ }
+ set net [lindex [split $str /] 1]
+ if { [string length [string trim $net]] != [string length $net] } {
+ return 0
+ }
+ return [checkIntRange $net 0 32]
+}
+
+
--- /dev/null
+#
+# Copyright 2005 University of Zagreb, Croatia. All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. All advertising materials mentioning features or use of this software
+# must display the following acknowledgement:
+# This product includes software developed by the University of Zagreb,
+# Croatia and its contributors.
+# 4. Neither the name of the University nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# This work was supported in part by Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+proc findFreeIPv6net { mask } {
+ global nodes
+
+ set ipnets {}
+ foreach node $nodes {
+ foreach ifc [ifcList $node] {
+ set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 3]
+ if {[lsearch $ipnets $ipnet] == -1} {
+ lappend ipnets $ipnet
+ }
+ }
+ }
+ for { set i 0 } { $i <= 9999 } { incr i } {
+ if {[lsearch $ipnets "fec0 0 0 $i"] == -1} {
+ set ipnet "fec0:0:0:$i"
+ return $ipnet
+ }
+ }
+}
+
+
+proc newLANIPv6 { l3node bridge } {
+ set peer_ipaddrs {}
+ set l2nodes [listLANnodes $bridge {}]
+ foreach l2node $l2nodes {
+ foreach ifc [ifcList $l2node] {
+ set peer [peerByIfc $l2node $ifc]
+ set peer_if [ifcByPeer $peer $l2node]
+ set peer_ipaddr [getIfcIPv6addr $peer $peer_if]
+ if { $peer_ipaddr != "" } {
+ lappend peer_ipaddrs [lindex [split $peer_ipaddr /] 0]
+ }
+ }
+ }
+ switch -exact -- [nodeType $l3node] {
+ router {
+ set targetbyte 1
+ }
+ host {
+ set targetbyte 10
+ }
+ pc {
+ set targetbyte 20
+ }
+ }
+ if { $peer_ipaddrs != "" } {
+ set ipnums [split [lindex $peer_ipaddrs 0] :]
+ set net "[lindex $ipnums 0]:[lindex $ipnums 1]"
+ set ipaddr $net\::$targetbyte
+ while { [lsearch $peer_ipaddrs $ipaddr] >= 0 } {
+ incr targetbyte
+ set ipaddr $net\::$targetbyte
+ }
+ return "$ipaddr/64"
+ } else {
+ return "[findFreeIPv6net 64]::$targetbyte/64"
+ }
+}
+
+
+proc checkIPv6Addr { str } {
+ set doublec false
+ set wordlist [split $str :]
+ set wordcnt [expr [llength $wordlist] - 1]
+ if { $wordcnt > 7 } {
+ return 0
+ }
+ if { [lindex $wordlist 0] == "" } {
+ set wordlist [lreplace $wordlist 0 0 0]
+ }
+ if { [lindex $wordlist $wordcnt] == "" } {
+ set wordlist [lreplace $wordlist $wordcnt $wordcnt 0]
+ }
+ for { set i 0 } { $i <= $wordcnt } { incr i } {
+ set word [lindex $wordlist $i]
+ if { $word == "" } {
+ if { $doublec == "true" } {
+ return 0
+ }
+ set doublec true
+ }
+ if { [string length $word] > 4 } {
+ if { $i == $wordcnt } {
+ return [checkIPv4Addr $word]
+ } else {
+ return 0
+ }
+ }
+ if { [string is xdigit $word] == 0 } {
+ return 0
+ }
+ }
+ return 1
+}
+
+
+proc checkIPv6Net { str } {
+ if { $str == "" } {
+ return 1
+ }
+ if { ![checkIPv6Addr [lindex [split $str /] 0]]} {
+ return 0
+ }
+ set net [lindex [split $str /] 1]
+ if { [string length [string trim $net]] != [string length $net] } {
+ return 0
+ }
+ return [checkIntRange $net 0 128]
+}
+
+
set MODULE lanswitch
+proc $MODULE.layer {} {
+ return LINK
+}
+
+
proc $MODULE.instantiate { eid node } {
catch {nexec ngctl mkpeer bridge anchor anchor | tail -1} resp
foreach elem [split [lindex [split $resp "\{\}"] 1]] {
#
-# Copyright 2004 University of Zagreb, Croatia. All rights reserved.
+# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
#
-# linkEndpoints { link_id }
+# linkPeers { link_id }
# Returns node_ids of link endpoints
#
+# linkByPeers { node1_id node2_id }
+# Returns link_id whose peers are node1 and node2
+#
+# removeLink { link_id }
+# Removes the link and related entries in peering node's configs
+#
# getLinkBandwidth { link_id }
# ... in bits per second
#
#
-proc linkEndpoints { link } {
+proc linkPeers { link } {
global $link
set entry [lsearch -inline [set $link] "nodes {*}"]
}
+proc linkByPeers { node1 node2 } {
+ global links
+
+ foreach link $links {
+ set peers [linkPeers $link]
+ if { $peers == "$node1 $node2" || $peers == "$node2 $node1" } {
+ return $link
+ }
+ }
+ return
+}
+
+
+proc removeLink { link } {
+ global links $link
+
+ set pnodes [linkPeers $link]
+ foreach node $pnodes {
+ global $node
+ set i [lsearch $pnodes $node]
+ set peer [lreplace $pnodes $i $i]
+ set ifc [ifcByPeer $node $peer]
+ netconfClearSection $node "interface $ifc"
+ set i [lsearch [set $node] "interface-peer {$ifc $peer}"]
+ set $node [lreplace [set $node] $i $i]
+ }
+ unset $link
+ set i [lsearch -exact $links $link]
+ set links [lreplace $links $i $i]
+ return
+}
+
+
proc getLinkBandwidth { link } {
global $link
return $bandstr
}
+
proc setLinkBandwidth { link value } {
global $link
} else {
set $link [lreplace [set $link] $i $i "delay $value"]
}
+ return
}
} else {
set $link [lreplace [set $link] $i $i "ber $value"]
}
+ return
}
} else {
set $link [lreplace [set $link] $i $i "duplicate $value"]
}
+ return
}
# The following node types are to be implemented in the future:
#
# frswitch
-# pseudo
# text
# image
#
global $node
set netconf [lindex [lsearch -inline [set $node] "network-config *"] 1]
- return [lindex [lsearch -inline $netconf "hostname *"] 1]
+ return [lrange [lsearch -inline $netconf "hostname *"] 1 end]
}
}
+proc removeNode { node } {
+ global nodes $node
+
+ foreach ifc [ifcList $node] {
+ set peer [peerByIfc $node $ifc]
+ set link [linkByPeers $node $peer]
+ removeLink $link
+ }
+ unset $node
+ set i [lsearch -exact $nodes $node]
+ set nodes [lreplace $nodes $i $i]
+ return
+}
+
+
#
# The following should really go into a separate "editing" library
+# XXX GUI / tk polluted!
#
proc undo {} {
set MODULE pc
+proc $MODULE.layer {} {
+ return NETWORK
+}
+
+
proc $MODULE.cfggen { node } {
global $node
set MODULE router.quagga
+proc $MODULE.layer {} {
+ return NETWORK
+}
+
+
proc $MODULE.cfggen { node } {
global $node
foreach line $protocfg {
lappend cfg "$line"
}
+ lappend cfg "!"
}
- lappend cfg "!"
}
foreach statrte [getStatIPv4routes $node] {
#
-proc rj45.instantiate { eid node } {
+set MODULE rj45
+
+
+proc $MODULE.layer {} {
+ return LINK
+}
+
+
+proc $MODULE.instantiate { eid node } {
set ifname [getNodeName $node]
nexec ifconfig $ifname up
return
}
-proc rj45.nghook { eid node ifc } {
+proc $MODULE.nghook { eid node ifc } {
set nodename [getNodeName $node]
return [list $nodename lower]
}
set MODULE router.static
+proc $MODULE.layer {} {
+ return NETWORK
+}
+
+
proc $MODULE.cfggen { node } {
global $node
set MODULE router.xorp
+proc $MODULE.layer {} {
+ return NETWORK
+}
+
+
proc $MODULE.cfggen { node } {
global $node
projects / imunes.git / commitdiff