sim.tcl.in

# -*- tcl -*-
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2004 University of Utah and the Flux Group.
# All rights reserved.
#

######################################################################
# sim.tcl
#
# Defines the Simulator class.  For our purpose a Simulator is a
# topology.  This contains a number nodes, lans, and links.  It
# provides methods for the creation of these objects as well as
# routines to locate the objects.  It also stores common state (such
# as IP subnet usage).  Finally it defines the import 'run' method
# which causes all remaining calculations to be done and updates the
# DB state.
#
# Note: Although NS distinguishs between LANs and Links, we do not.
# We merge both types of objects into a single one called LanLink.  
# See lanlink.tcl and README for more information.
######################################################################

Class Simulator
Class Program -superclass NSObject

Simulator instproc init {args} {
    # A counter for internal ids
    $self set id_counter 0

    # Counters for subnets. 
    $self set subnet_counter 1
    $self set wa_subnet_counter 1

    # This is the prefix used to fill any unassigned IP addresses.
    $self set subnet_base "@IPBASE@"

    # The following are sets.  I.e. they map to no value, all
    # we care about is membership.
    $self instvar node_list;		# Indexed by node id
    array set node_list {}
    $self instvar lanlink_list;		# Indexed by lanlink id
    array set lanlink_list {}
    $self instvar subnets;		# Indexed by IP subnet
    array set subnets {}

    # link_map is indexed by <node1>:<node2> and contains the
    # id of the lanlink connecting them.  In the case of
    # multiple links between two nodes this contains
    # the last one created.
    $self instvar link_map
    array set link_map {}

    # event list is a list of {time vnode vname otype etype args atstring}
    $self set event_list {}
    $self set event_count 0

    # global nse config file. to be split later
    $self set nseconfig ""

    # Program list.
    $self instvar prog_list;
    array set prog_list {}

    var_import ::GLOBALS::last_class
    set last_class $self
}

# renaming the simulator instance
# needed to find the name of the instance
# for use in NSE code
Simulator instproc rename {old new} {
}

# node
# This method adds a new node to the topology and returns the id
# of the node.
Simulator instproc node {args} {
    var_import ::GLOBALS::last_class
    var_import ::GLOBALS::simulated
    $self instvar id_counter
    $self instvar node_list

    if {($args != {})} {
	punsup "Arguments for node: $args"
    }
    
    set curnode tbnode-n[incr id_counter]
    Node $curnode $self

    # simulated nodes have type 'sim'
    if { $simulated == 1 } {
        tb-set-hardware $curnode sim
	# This allows assign to prefer pnodes
	# that already have FBSD-NSE as the default
	# boot osid over others
	$curnode add-desire "FBSD-NSE" 0.9
    } 
    set node_list($curnode) {}
    set last_class $curnode

    return $curnode
}

# duplex-link <node1> <node2> <bandwidth> <delay> <type>
# This adds a new link to the topology.  <bandwidth> can be in any
# form accepted by parse_bw and <delay> in any form accepted by
# parse_delay.  Currently only the type 'DropTail' is supported.
Simulator instproc duplex-link {n1 n2 bw delay type args} {
    var_import ::GLOBALS::last_class
    var_import ::GLOBALS::simulated
    $self instvar id_counter
    $self instvar lanlink_list
    $self instvar link_map

    if {($args != {})} {
	punsup "Arguments for duplex-link: $args"
    }
    set error 0
    if {! [$n1 info class Node]} {
	perror "\[duplex-link] $n1 is not a node."
	set error 1
    }
    if {! [$n2 info class Node]} {
	perror "\[duplex-link] $n2 is not a node."
	set error 1
    }
#    if { [$n1 set isvirt] != [$n2 set isvirt] } {
#	perror "\[duplex-link] Bad link between real and virtual node!"
#	set error 1
#    }

    if { $simulated == 1 && ( [$n1 set simulated] == 0 || [$n2 set simulated] == 0 ) } {
	set simulated 0
	perror "\[duplex-link] Please define links between real and simulated nodes outside make-simulated"
	set simulated 1
	set error 1
    }

    if {$error} {return}

    # Convert bandwidth and delay
    set rbw [parse_bw $bw]
    set rdelay [parse_delay $delay]

    set curlink tblink-l[incr id_counter]

    Link $curlink $self "$n1 $n2" $rbw $rdelay $type	
    set lanlink_list($curlink) {}
    set link_map($n1:$n2) $curlink
    set link_map($n2:$n1) $curlink

    set last_class $curlink
    return $curlink
}

# make-lan <nodelist> <bw> <delay>
# This adds a new lan to the topology. <bandwidth> can be in any
# form accepted by parse_bw and <delay> in any form accepted by
# parse_delay.
Simulator instproc make-lan {nodelist bw delay args} {
    var_import ::GLOBALS::last_class
    var_import ::GLOBALS::simulated
    $self instvar id_counter
    $self instvar lanlink_list

    if {($args != {})} {
	punsup "Arguments for make-lan: $args"
    }

    #
    # The number of virtual nodes has to be zero, or equal to the number
    # of nodes (In other word, no mixing of real and virtual nodes).
    #
#    set acount 0
#    set vcount 0
#    foreach node $nodelist {
#	if { [$node set isvirt] } {
#	    incr vcount
#	}
#	incr acount
#    }
#    if { ($vcount != 0) && ($vcount != $acount) } {
#	perror "\[duplex-link] Bad lan between real and virtual nodes!"
#	set error 1
#	return ""
#    }

    # At this point we have one of the nodes of
    # the lan to be real. We need to make sure
    # that this is not being defined in make-simulated.
    # In other words links or lans from real nodes and
    # simulated nodes should happen outside make-simulated
    if { $simulated == 1 } {

	foreach node $nodelist {
	    if { [$node set simulated] == 0 } {	
		set simulated 0
		perror "Please define lans between real and simulated nodes outside make-simulated"
		set simulated 1
		return ""
	    }
	}
    }

    set curlan tblan-lan[incr id_counter]
    
    # Convert bandwidth and delay
    set rbw [parse_bw $bw]
    set rdelay [parse_delay $delay]
    
    Lan $curlan $self $nodelist $rbw $rdelay {}
    set lanlink_list($curlan) {}
    set last_class $curlan
    
    return $curlan
}

# run
# This method causes the fill_ips method to be invoked on all 
# lanlinks and then, if not running in impotent mode, calls the
# updatedb method on all nodes and lanlinks.  Invocation of this
# method casues the 'ran' variable to be set to 1.
Simulator instproc run {} {
    $self instvar lanlink_list
    $self instvar node_list
    $self instvar event_list
    $self instvar prog_list
    $self instvar simulated
    $self instvar nseconfig
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid
    var_import ::GLOBALS::errors
    var_import ::GLOBALS::irfile
    var_import ::GLOBALS::ran
    var_import ::GLOBALS::impotent
    var_import ::GLOBALS::passmode
    var_import ::GLOBALS::vtypes
    var_import ::GLOBALS::uselatestwadata
    var_import ::GLOBALS::usewatunnels
    var_import ::GLOBALS::wa_delay_solverweight
    var_import ::GLOBALS::wa_bw_solverweight
    var_import ::GLOBALS::wa_plr_solverweight
    var_import ::GLOBALS::uselinkdelays
    var_import ::GLOBALS::forcelinkdelays
    var_import ::GLOBALS::multiplex_factor
    var_import ::GLOBALS::sync_server
    var_import ::GLOBALS::cpu_usage
    var_import ::GLOBALS::mem_usage
    var_import ::GLOBALS::veth_encapsulate
    var_import ::GLOBALS::jail_osname
    var_import ::GLOBALS::delay_osname
    var_import ::TBCOMPAT::objtypes
    var_import ::TBCOMPAT::eventtypes
    
    # Fill out IPs
    foreach obj [concat [array names lanlink_list]] {
	$obj fill_ips
    }

    # Go through the list of nodes, and find subnode hosts - we have to add a
    # desire to them to have the hosts-<type-of-child> feature
    foreach node [lsort [array names node_list]] {
	if { [$node set subnodehost] == 1 } {
	    set child [$node set subnodechild]
	    set childtype [$child set type]
	    $node add-desire "hosts-$childtype" 1.0
	}
    }

    # Default sync server.
    set default_sync_server {}

    # Mark that a run statement exists
    set ran 1

    # Check node names.
    foreach node [lsort [array names node_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $node]} {
	    perror "\[run] Invalid node name $node.  Can only contain \[-0-9A-Za-z\] due to DNS limitations."
	}
    }
    foreach lan [lsort [array names lanlink_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $lan]} {
	    perror "\[run] Invalid lan/link name $lan.  Can only contain \[-0-9A-Za-z\] for symmetry with node DNS limitations."
	}
    }

    # Check for one node lans
    foreach lan [array names lanlink_list] {
	if {[llength [$lan set nodelist]] <= 1} {
	    perror "\[run] $lan has only a single node.  LANs must have at least 2 nodes in them."
	}
    }

    # If any errors occur stop here.
    if {$errors == 1} {return}

    # If we are running in impotent mode we stop here
    if {$impotent == 1 && $passmode == 0} {return}
    
    $self spitxml_init

    # update the global nseconfigs using a bogus vname
    # i.e. instead of the node on which nse is gonna run
    # which was the original vname field, we just put $ns
    # for now. Once assign runs, the correct value will be
    # entered into the database
    if { $nseconfig != {} } {
 
 	set nsecfg_script ""
 	set simu [lindex [Simulator info instances] 0]
 	append nsecfg_script "set $simu \[new Simulator]\n"
 	append nsecfg_script "\$$simu use-scheduler RealTime\n\n"
 	append nsecfg_script $nseconfig

	$self spitxml_data "nseconfigs" [list "vname" "nseconfig" ] [list fullsim $nsecfg_script ]
    }
    
    # Update the DB
    foreach node [lsort [array names node_list]] {
	$node updatedb "sql"

	if { $default_sync_server == {} } {
	    set default_sync_server $node
	}
    }
    
    foreach lan [concat [array names lanlink_list]] {
	$lan updatedb "sql"
    }
    foreach vtype [array names vtypes] {
	$vtype updatedb "sql"
    }
    foreach prog [array names prog_list] {
	$prog updatedb "sql"
    }

    set fields [list "mem_usage" "cpu_usage" "forcelinkdelays" "uselinkdelays" "usewatunnels" "uselatestwadata" "wa_delay_solverweight" "wa_bw_solverweight" "wa_plr_solverweight" "veth_encapsulate"]
    set values [list $mem_usage $cpu_usage $forcelinkdelays $uselinkdelays $usewatunnels $uselatestwadata $wa_delay_solverweight $wa_bw_solverweight $wa_plr_solverweight $veth_encapsulate]

    if { $multiplex_factor != {} } {
	lappend fields "multiplex_factor"
	lappend values $multiplex_factor
    }
    
    if { $sync_server != {} } {
	lappend fields "sync_server"
	lappend values $sync_server
    } elseif { $default_sync_server != {} } {
	lappend fields "sync_server"
	lappend values $default_sync_server
    }

    if { $jail_osname != {} } {
	lappend fields "jail_osname"
	lappend values $jail_osname
    }
    if { $delay_osname != {} } {
	lappend fields "delay_osname"
	lappend values $delay_osname
    }
    
    $self spitxml_data "experiments" $fields $values

    # This could probably be elsewhere.
    $self spitxml_data "virt_agents" [list "vnode" "vname" "objecttype" ] [list "*" $self $objtypes(SIMULATOR) ]

    # This will eventually be under user control.
    $self spitxml_data "virt_agents" [list "vnode" "vname" "objecttype" ] [list "*" "linktest" $objtypes(LINKTEST) ]
    
    foreach event $event_list {
	$self spitxml_data "eventlist" [list "time" "vnode" "vname" "objecttype" "eventtype" "arguments" "atstring" ] [list [lindex $event 0] [lindex $event 1] [lindex $event 2] $objtypes([lindex $event 3]) $eventtypes([lindex $event 4]) [lindex $event 5] [lindex $event 6] ]
    }

    $self spitxml_finish
}

# attach-agent <node> <agent>
# This creates an attachment between <node> and <agent>.
Simulator instproc attach-agent {node agent} {
    var_import ::GLOBALS::simulated

    if {! [$agent info class Agent]} {
	perror "\[attach-agent] $agent is not an Agent."
	return
    }
    if {! [$node info class Node]} {
	perror "\[attach-agent] $node is not a Node."
	return
    }

    # If the node is real and yet this code is in make-simulated
    # we don't allow it
    if { [$node set simulated] == 0 && $simulated == 1 } {
	set simulated 0
	perror "Please attach agents on to real nodes outside make-simulated"
	set simulated 1
	return ""
    }

    $node attach-agent $agent
}

# connect <src> <dst>
# Connects two agents together.
Simulator instproc connect {src dst} {
    set error 0
    if {! [$src info class Agent]} {
	perror "\[connect] $src is not an Agent."
	set error 1
    }
    if {! [$dst info class Agent]} {
	perror "\[connect] $dst is not an Agent."
	set error 1
    }
    if {$error} {return}
    $src connect $dst
    $dst connect $src
}

# at <time> <event>
# Known events:
#   <traffic> start
#   <traffic> stop
#   <link> up
#   <link> down
#   ...
Simulator instproc at {time eventstring} {
    var_import ::GLOBALS::simulated

    # ignore at statement for simulated case
    if { $simulated == 1 } {
	return
    }

    # Check that time is float
    if {[regexp {(^[0-9]+(\.[0-9]+)?$)|(^\.[0-9]+$)} $time] == 0} {
	perror "Invalid time spec: $time"
	return
    }
    $self instvar event_list
    $self instvar event_count

    if {$event_count > 4000} {
	perror "Too many events in your NS file!"
	exit 1
    }
    set eventlist [split $eventstring ";"]

  foreach event $eventlist {
    # Check otype/command
    set obj [lindex $event 0]
    set cmd [lindex $event 1]
    set atstring "$event"
    set args {}
    set okargs 0
    switch -- [$obj info class] {
	"Application/Traffic/CBR" {
	    set otype TRAFGEN
	    switch -- $cmd {
		"start" {
                    set params [$obj get_params]
		    set etype START
		    set args  $params
		}
		"stop" {
		    set etype STOP
		}
		"reset" {
		    set etype RESET
		}
                "set" {
		    if {[llength $event] < 4} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "packetSize_" {
	                    set args  "PACKETSIZE=$arg"
                        }
                        "rate_" {
			    set bw [parse_bw $arg]
	                    set args  "RATE=$bw"
                        }
                        "interval_" {
	                    set args  "INTERVAL=$arg"
                        }
                        "iptos_" {
	                    set args  "IPTOS=$arg"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode [$obj get_node]
	    set vname $obj
	}
	"Agent/TCP/FullTcp" -
	"Agent/TCP/FullTcp/Reno" -
	"Agent/TCP/FullTcp/Newreno" -
	"Agent/TCP/FullTcp/Tahoe" -
	"Agent/TCP/FullTcp/Sack" - 
	"Application/FTP" -
	"Application/Telnet" {
	    # For events sent to NSE, we don't distinguish
	    # between START, STOP and MODIFY coz the entire
	    # string passed to '$ns at' is sent for evaluation to the node
	    # on which NSE is running: fix needed for the
	    # case when the above string has syntax errors. Maybe
	    # just have a way reporting errors back to the
	    # the user from the NSE that finds the syntax errors
	    set otype NSE
	    set etype NSEEVENT
	    set args "\$$obj $cmd [lrange $event 2 end]"
	    set vnode [$obj get_node]
	    set vname $obj
	}
	"Link" {
	    set otype LINK
	    switch -- $cmd {
		"up"	    {set etype UP}
		"down"	    {set etype DOWN}
		"bandwidth" {
		    if {[llength $event] < 4} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
                    set arg   [lindex $event 2]
		    set bw [parse_bw $arg]
                    set args  "BANDWIDTH=$bw"
		    set etype MODIFY
		}
		"delay" {
		    if {[llength $event] < 3} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
                    set arg   [lindex $event 2]
                    set args  "DELAY=$arg"
		    set etype MODIFY
		}
		"plr" {
		    if {[llength $event] < 3} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
                    if {[scan [lindex $event 2] "%f" plr] != 1 ||
                        $plr < 0 || $plr > 1} {
			perror "Improper argument: at $time $event"
			return
                    }
                    set args  "PLR=$plr"
		    set etype MODIFY
		}
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname $obj
	}
	"Queue" {
	    set otype LINK
	    set pipe [$obj get_pipe]
	    set obj [$obj get_link]
	    switch -- $cmd {
                "set" {
		    if {[llength $event] < 4} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "queue-in-bytes_" {
	                    set args  "QUEUE-IN-BYTES=$arg"
                        }
                        "limit_" {
	                    set args  "LIMIT=$arg"
                        }
                        "maxthresh_" {
	                    set args  "MAXTHRESH=$arg"
                        }
                        "thresh_" {
	                    set args  "THRESH=$arg"
                        }
                        "linterm_" {
	                    set args  "LINTERM=$arg"
                        }
                        "q_weight_" {
			    if {[scan $arg "%f" w] != 1} {
				perror "Improper argument: at $time $event"
				return
			    }
	                    set args  "Q_WEIGHT=$w"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set args "PIPE=$pipe $args"
	    set vnode {}
	    set vname $obj
	}
	"Program" {
	    set otype PROGRAM
	    set vname $obj
	    set vnode [$obj set node]
    
	    switch -- $cmd {
		"start" {
		    set etype START
		    # Must leave this here for the benefit of old
		    # images that expect the command line in the event. 
		    set arg  [$obj set command]
		    set args "COMMAND=$arg"
		}
		"stop" {
		    set etype STOP
		}
		"kill" {
		    set etype KILL
		    if {[llength $event] < 3} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
	            set arg [lindex $event 2]
		    set args "SIGNAL=$arg"
		}
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set okargs 1
	}
	"Simulator" {
	    set vnode "*"
	    set vname $self
	    
	    switch -- $cmd {
		"bandwidth" {
		    set otype LINK
		    set etype MODIFY
		    set vnode {}
		    set vname {}
		}
		"halt" {
		    set otype SIMULATOR
		    set etype HALT
		}
		"terminate" {
		    set otype SIMULATOR
		    set etype HALT
		}
		"swapout" {
		    set otype SIMULATOR
		    set etype SWAPOUT
		}
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set okargs 1
	}
	unknown {
	    punsup "Unknown object type: at $time $event"
	    return
	}
    }

    set event_count [expr $event_count + 1]
    lappend event_list [list $time $vnode $vname $otype $etype $args $atstring]
  }
}

#
# Routing control.
#
Simulator instproc rtproto {type args} {
    var_import ::GLOBALS::default_ip_routing_type
    var_import ::GLOBALS::simulated

    # ignore at statement for simulated case
    if { $simulated == 1 } {
	return
    }

    if {$args != {}} {
	punsup "rtproto: arguments ignored: $args"
    }

    if {($type == "Session") ||	($type == "ospf")} {
	set default_ip_routing_type "ospf"
    } elseif {($type == "Manual")} {
	set default_ip_routing_type "manual"
    } elseif {($type == "Static")} {
	set default_ip_routing_type "static"
    } else {
	punsup "rtproto: unsupported routing protocol ignored: $type"
	return
    }
}

# unknown 
# This is invoked whenever any method is called on the simulator
# object that is not defined.  We interpret such a call to be a
# request to create an object of that type.  We create display an
# unsupported message and create a NullClass to fulfill the request.
Simulator instproc unknown {m args} {
    $self instvar id_counter
    punsup "Object $m"
    NullClass tbnull-null[incr id_counter] $m
}

# rename_* <old> <new>
# The following two procedures handle when an object is being renamed.
# They update the internal datastructures to reflect the new name.
Simulator instproc rename_lanlink {old new} {
    $self instvar lanlink_list
    $self instvar link_map

    unset lanlink_list($old)
    set lanlink_list($new) {}

    # In the case of a link we need to update the link_map as well.
    if {[$new info class] == "Link"} {
	$new instvar nodelist
	set src [lindex [lindex $nodelist 0] 0]
	set dst [lindex [lindex $nodelist 1] 0]
	set link_map($src:$dst) $new
	set link_map($dst:$src) $new
    }
}
Simulator instproc rename_node {old new} {
    $self instvar node_list

    # simulated nodes won't exist in the node_list
    if { [info exists node_list($old)] } {
	unset node_list($old)
	set node_list($new) {}
    }
}

Simulator instproc rename_program {old new} {
    $self instvar prog_list
    unset prog_list($old)
    set prog_list($new) {}
}

# find_link <node1> <node2>
# This is just an accesor to the link_map datastructure.  If no
# link is known between <node1> and <node2> the empty list is returned.
Simulator instproc find_link {src dst} {
    $self instvar link_map
    if {[info exists link_map($src:$dst)]} {
	return $link_map($src:$dst)
    } else {
	return ""
    }
}

Simulator instproc link {src dst} {
    set reallink [$self find_link $src $dst]
	
    if {$src == [$reallink set src_node]} {
	set dir "to"
    } else {
	set dir "from"
    }
    
    var_import GLOBALS::new_counter
    set name sl[incr new_counter]
    
    return [SimplexLink $name $reallink $dir]
}

Simulator instproc lanlink {lan node} {
    if {[$node info class] != "Node"} {
	perror "\[lanlink] $node is not a node."
	return
    }
    if {[$lan info class] != "Lan"} {
	perror "\[lanlink] $lan is not a lan."
	return
    }
    set port [$lan get_port $node]
    if {$port == {}} {
	perror "\[lanlink] $node is not in $lan."
	return
    }
    var_import GLOBALS::new_counter
    set name ll[incr new_counter]
    
    return [LLink $name $lan $node]
}

# get_subnet
# This is called by lanlinks.  When called get_subnet will find an available
# IP subnet, mark it as used, and return it to the caller.
Simulator instproc get_subnet {netmask} {
    $self instvar subnet_base
    $self instvar subnets

    set netmaskint [inet_atohl $netmask]

    set A $subnet_base
    set C [expr ($netmaskint >> 8) & 0xff]
    set D [expr $netmaskint & 0xff]
    set minB 1
    set maxB 254
    set minC 0
    set maxC 1
    set incC 1
    set minD 0
    set maxD 1
    set incD 1

    # allow for 10. or 192.168. I know, could be more general.
    if {[expr [llength [split $subnet_base .]]] == 2} {
	# 192.168.
	set A    [expr [lindex [split $subnet_base .] 0]]
	set minB [expr [lindex [split $subnet_base .] 1]]
	set maxB [expr $minB + 1]
    }
    if {$C != 0} {	
	set minC [expr 256 - $C]
	set maxC 255
	set incC $minC
    } 
    if {$D != 0} {	
	set minD [expr 256 - $D]
	set maxD 255
	set incD $minD
    }

    # We never let the user change the second octet. See tb-set-netmask.
    for {set i $minB} {$i < $maxB} {incr i} {
	for {set j $minC} {$j < $maxC} {set j [expr $j + $incC]} {
	    for {set k $minD} {$k < $maxD} {set k [expr $k + $incD]} {
		set subnet "$A.$i.$j.$k"
		set subnetint [inet_atohl $subnet]

		# No such subnet exists?
		if {! [info exists subnets($subnetint)]} {
		    set okay 1

		    #
		    # See if this subnet violates any existing subnet masks
		    # Is this overly restrictive? Totally wrong?
		    #
		    foreach osubnetint [concat [array names subnets]] {
			set onetmaskint $subnets($osubnetint)

			if {[expr $subnetint & $onetmaskint] == $osubnetint ||
 			    [expr $osubnetint & $netmaskint] == $subnetint} {
			    set okay 0
			    break
			}
		    }
		    if {$okay} {
			$self use_subnet $subnet $netmask
			return $subnet
		    }
		}
	    }
	}
    }
    perror "Ran out of subnets."
}

# get_subnet_remote
# This is called by lanlinks.  When called get_subnet will find an available
# IP subnet, mark it as used, and return it to the caller.
Simulator instproc get_subnet_remote {} {
    $self instvar wa_subnet_counter

    if {$wa_subnet_counter > 255} {
	perror "Ran out of widearea subnets."
	return 0
    }
    set subnet $wa_subnet_counter
    incr wa_subnet_counter
    return "69.69.$subnet.0"
}

# use_subnet
# This is called by the ip method of nodes.  It marks the passed subnet
# as used and thus should never be returned by get_subnet.
Simulator instproc use_subnet {subnet netmask} {
    $self instvar subnets

    set subnetint [inet_atohl $subnet]
    set netmaskint [inet_atohl $netmask]
    
    set subnets($subnetint) $netmaskint
}

# add_program
# Link to a new program object.
Simulator instproc add_program {prog} {
    $self instvar prog_list
    set prog_list($prog) {}
}

# cost
# Set the cost for a link
Simulator instproc cost {src dst c} {
    set reallink [$self find_link $src $dst]
    $reallink set cost([list $src [$reallink get_port $src]]) $c
}

# Now we have an experiment wide 
# simulation specification. Virtual to physical
# mapping will be done in later stages
Simulator instproc make-simulated {args} {

    var_import ::GLOBALS::simulated
    $self instvar nseconfig
    $self instvar simcode_present

    set simulated 1
    global script
    set script [string trim $args "\{\}"]

    if { $script == {} } {
        set simulated 0
        return
    }

    set simcode_present 1

    # we ignore any type of errors coz they have
    # been caught when we ran the script through NSE
    uplevel 1 $script

    append nseconfig $script
    append nseconfig \n

    set simulated 0
}

#
# Spit out XML
#
Simulator instproc spitxml_init {} {
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    puts "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>"
    puts "<virtual_experiment pid='$pid' eid='$eid'>"
}

Simulator instproc spitxml_finish {} {
    puts "</virtual_experiment>"
}

Simulator instproc spitxml_data {tag fields values} {
    ::spitxml_data $tag $fields $values
}

#
# Global function, cause some objects do not hold a sim pointer.
# Should fix.
# 
proc spitxml_data {tag fields values} {
    puts "  <$tag>"
    puts "    <row>"
    foreach field $fields {
	set value  [lindex $values 0]
	set values [lrange $values 1 end]
	set value_esc [xmlencode $value]

	puts "      <$field>$value_esc</$field>"
    }
    puts "    </row>"
    puts "  </$tag>"
}

proc xmlencode {args} {
    set retval [eval append retval $args]
    regsub -all "&" $retval "\\&amp;" retval
    regsub -all "<" $retval "\\&lt;" retval
    regsub -all ">" $retval "\\&gt;" retval
    regsub -all "\"" $retval "\\&\#34;" retval
    regsub -all "]" $retval "\\&\#93;" retval
    
    return $retval
}