From 26dbb9d3e2ceeafa234b9ed402b0856994ca5654 Mon Sep 17 00:00:00 2001 From: marko Date: Sat, 16 Jul 2005 04:55:00 +0000 Subject: [PATCH] Move several IPv4 and IPv6 specific procedures into separated newly 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: --- editor.tcl | 422 +++++++++----------------------------------------- exec.tcl | 14 +- help.tcl | 4 +- host.tcl | 6 + hub.tcl | 5 + imunes | 2 +- imunes.tcl | 6 +- initgui.tcl | 45 +++++- install.sh | 2 +- ipv4.tcl | 168 ++++++++++++++++++++ ipv6.tcl | 147 ++++++++++++++++++ lanswitch.tcl | 5 + linkcfg.tcl | 49 +++++- nodecfg.tcl | 19 ++- pc.tcl | 5 + quagga.tcl | 7 +- rj45.tcl | 12 +- static.tcl | 5 + xorp.tcl | 5 + 19 files changed, 555 insertions(+), 373 deletions(-) create mode 100755 ipv4.tcl create mode 100755 ipv6.tcl diff --git a/editor.tcl b/editor.tcl index 76d9321..43f98a7 100755 --- a/editor.tcl +++ b/editor.tcl @@ -55,40 +55,24 @@ proc animateCursor {} { } -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 } @@ -194,7 +178,7 @@ proc loadCfg { cfg } { # Cleanup first - this also automatically deletes all associated links foreach node $nodes { - removeNode $node + removeGUINode $node } set class "" @@ -373,7 +357,7 @@ proc drawNode { node } { 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 \ @@ -393,7 +377,7 @@ proc drawLink {link} { } -proc newId { type } { +proc newObjectId { type } { global nodes links set mark [string range [set type] 0 0] @@ -447,50 +431,6 @@ proc chooseIfName { lnode1 lnode2 } { } -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] { @@ -506,112 +446,6 @@ proc listLANnodes { l2node l2peers } { } -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 @@ -816,11 +650,11 @@ proc startethereal { c } { 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 != "" } { @@ -869,9 +703,8 @@ proc button1 { c x y button} { $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" } { @@ -930,11 +763,11 @@ proc button1 { c x y button} { 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 } @@ -1073,7 +906,7 @@ proc button1-release { c x y } { 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] @@ -1082,13 +915,12 @@ proc button1-release { c x y } { 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" || \ @@ -1099,13 +931,12 @@ proc button1-release { c x y } { 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" || \ @@ -1288,100 +1119,6 @@ proc checkIntRange { str low high } { } -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 @@ -1435,8 +1172,8 @@ proc popupConfigDialog { c } { 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 @@ -1460,7 +1197,6 @@ proc popupConfigDialog { c } { 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" } { @@ -1482,82 +1218,78 @@ proc popupConfigDialog { c } { 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 # @@ -1598,7 +1330,7 @@ proc popupConfigDialog { c } { 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 " } @@ -1806,7 +1538,6 @@ proc customConfigApply { w node } { if { [getCustomCmd $node] != $newcmd || \ [getCustomConfig $node] != $newconf } { set changed 1 - updateUndoLog } setCustomCmd $node $newcmd setCustomConfig $node $newconf @@ -1833,7 +1564,7 @@ proc popupConfigApply { wi object_type target close phase } { 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 @@ -1873,7 +1604,7 @@ proc popupConfigApply { wi object_type target close phase } { } } - if {[lsearch {router pc host} [nodeType $target]] >= 0} { + if {[[typemodel $target].layer] == "NETWORK"} { foreach ifc [ifcList $target] { # # Operational state @@ -1905,7 +1636,7 @@ proc popupConfigApply { wi object_type target close phase } { 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 @@ -2032,6 +1763,7 @@ proc printCanvas { w } { close $p } + proc delete_object { c x y } { global changed global background @@ -2042,15 +1774,15 @@ proc delete_object { c x y } { 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 diff --git a/exec.tcl b/exec.tcl index 01e78a5..eb5909a 100755 --- a/exec.tcl +++ b/exec.tcl @@ -1,5 +1,5 @@ # -# 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 @@ -211,8 +211,8 @@ proc deployCfg {} { 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] @@ -366,7 +366,7 @@ proc linkByIfc { node ifc } { set peer [peerByIfc $node $ifc] foreach link $links { - set endpoints [linkEndpoints $link] + set endpoints [linkPeers $link] if { $endpoints == "$node $peer" } { set dir downstream break @@ -383,7 +383,7 @@ proc linkByIfc { node ifc } { 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 { @@ -397,7 +397,7 @@ proc execSetIfcQDisc { eid node ifc 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 { @@ -410,7 +410,7 @@ proc execSetIfcQDrop { eid node ifc 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 } }" diff --git a/help.tcl b/help.tcl index 27884b2..68625c0 100755 --- a/help.tcl +++ b/help.tcl @@ -1,5 +1,5 @@ # -# 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 @@ -36,7 +36,7 @@ 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 diff --git a/host.tcl b/host.tcl index 174ae64..d808d98 100755 --- a/host.tcl +++ b/host.tcl @@ -36,6 +36,12 @@ set MODULE host + +proc $MODULE.layer {} { + return NETWORK +} + + proc $MODULE.cfggen { node } { global $node diff --git a/hub.tcl b/hub.tcl index 05001c0..7a249df 100755 --- a/hub.tcl +++ b/hub.tcl @@ -37,6 +37,11 @@ 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]] { diff --git a/imunes b/imunes index 477261f..f85f457 100755 --- a/imunes +++ b/imunes @@ -1,6 +1,6 @@ #!/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 diff --git a/imunes.tcl b/imunes.tcl index e6d3dab..24d0282 100755 --- a/imunes.tcl +++ b/imunes.tcl @@ -1,5 +1,5 @@ # -# 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 @@ -52,12 +52,14 @@ if {[lindex $argv 0] == "-b" || [lindex $argv 0] == "--batch"} { 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" diff --git a/initgui.tcl b/initgui.tcl index bb2853c..c175efb 100755 --- a/initgui.tcl +++ b/initgui.tcl @@ -1,5 +1,5 @@ # -# 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 @@ -47,10 +47,15 @@ menu .menubar .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 \ @@ -93,6 +98,10 @@ bind . "fileSaveDialogBox" .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 @@ -101,6 +110,16 @@ bind . undo -accelerator "Ctrl+Y" -command redo bind . 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 @@ -144,14 +163,26 @@ menu .menubar.view.show -tearoff 0 } } + +# +# 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 @@ -168,14 +199,14 @@ frame .left 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] } diff --git a/install.sh b/install.sh index 9d37982..d2d2e2f 100755 --- a/install.sh +++ b/install.sh @@ -25,7 +25,7 @@ chmod 755 $ROOTDIR/$BINDIR/imunes 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" diff --git a/ipv4.tcl b/ipv4.tcl new file mode 100755 index 0000000..c21148b --- /dev/null +++ b/ipv4.tcl @@ -0,0 +1,168 @@ +# +# 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] +} + + diff --git a/ipv6.tcl b/ipv6.tcl new file mode 100755 index 0000000..b90c6c6 --- /dev/null +++ b/ipv6.tcl @@ -0,0 +1,147 @@ +# +# 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] +} + + diff --git a/lanswitch.tcl b/lanswitch.tcl index c34b1d4..115bcce 100755 --- a/lanswitch.tcl +++ b/lanswitch.tcl @@ -37,6 +37,11 @@ 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]] { diff --git a/linkcfg.tcl b/linkcfg.tcl index 30b7f6c..24beed9 100755 --- a/linkcfg.tcl +++ b/linkcfg.tcl @@ -1,5 +1,5 @@ # -# 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 @@ -35,9 +35,15 @@ # -# 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 # @@ -63,7 +69,7 @@ # -proc linkEndpoints { link } { +proc linkPeers { link } { global $link set entry [lsearch -inline [set $link] "nodes {*}"] @@ -71,6 +77,39 @@ proc linkEndpoints { link } { } +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 @@ -101,6 +140,7 @@ proc getLinkBandwidthString { link } { return $bandstr } + proc setLinkBandwidth { link value } { global $link @@ -147,6 +187,7 @@ proc setLinkDelay { link value } { } else { set $link [lreplace [set $link] $i $i "delay $value"] } + return } @@ -167,6 +208,7 @@ proc setLinkBER { link value } { } else { set $link [lreplace [set $link] $i $i "ber $value"] } + return } @@ -187,4 +229,5 @@ proc setLinkDup { link value } { } else { set $link [lreplace [set $link] $i $i "duplicate $value"] } + return } diff --git a/nodecfg.tcl b/nodecfg.tcl index 975fa87..5aa20c5 100755 --- a/nodecfg.tcl +++ b/nodecfg.tcl @@ -57,7 +57,6 @@ # The following node types are to be implemented in the future: # # frswitch -# pseudo # text # image # @@ -603,7 +602,7 @@ proc getNodeName { node } { 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] } @@ -754,8 +753,24 @@ proc hasIPv6Addr { node } { } +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 {} { diff --git a/pc.tcl b/pc.tcl index 2b2b282..1ffe76b 100755 --- a/pc.tcl +++ b/pc.tcl @@ -37,6 +37,11 @@ set MODULE pc +proc $MODULE.layer {} { + return NETWORK +} + + proc $MODULE.cfggen { node } { global $node diff --git a/quagga.tcl b/quagga.tcl index c210e19..0e2f760 100755 --- a/quagga.tcl +++ b/quagga.tcl @@ -37,6 +37,11 @@ set MODULE router.quagga +proc $MODULE.layer {} { + return NETWORK +} + + proc $MODULE.cfggen { node } { global $node @@ -65,8 +70,8 @@ proc $MODULE.cfggen { node } { foreach line $protocfg { lappend cfg "$line" } + lappend cfg "!" } - lappend cfg "!" } foreach statrte [getStatIPv4routes $node] { diff --git a/rj45.tcl b/rj45.tcl index 0b76a1b..7a5bccb 100755 --- a/rj45.tcl +++ b/rj45.tcl @@ -34,14 +34,22 @@ # -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] } diff --git a/static.tcl b/static.tcl index 423bcae..4309dbf 100755 --- a/static.tcl +++ b/static.tcl @@ -37,6 +37,11 @@ set MODULE router.static +proc $MODULE.layer {} { + return NETWORK +} + + proc $MODULE.cfggen { node } { global $node diff --git a/xorp.tcl b/xorp.tcl index 1a0256a..2020db1 100755 --- a/xorp.tcl +++ b/xorp.tcl @@ -37,6 +37,11 @@ set MODULE router.xorp +proc $MODULE.layer {} { + return NETWORK +} + + proc $MODULE.cfggen { node } { global $node -- 2.39.5