core-extra/gui/cfgparse.tcl

#
# Copyright 2005-2013 the Boeing Company.
# See the LICENSE file included in this distribution.
#

#
# Copyright 2005-2008 University of Zagreb, Croatia.
#
# 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.
#
# THIS SOFTWARE IS PROVIDED BY AUTHOR 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 AUTHOR 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 the Croatian Ministry of Science
# and Technology through the research contract #IP-2003-143.
#

#****h* imunes/cfgparse.tcl
# NAME
#  cfgparse.tcl -- file used for parsing the configuration
# FUNCTION
#  This module is used for parsing the configuration, i.e. reading the 
#  configuration from a file or a string and writing the configuration 
#  to a file or a string. This module also contains a function for returning 
#  a new ID for nodes, links and canvases.
#****

#****f* nodecfg.tcl/dumpputs
# NAME
#   dumpputs -- puts a string to a file or a string configuration 
# SYNOPSIS
#   dumpputs $method $destination $string
# FUNCTION
#   Puts a sting to the file or appends the string configuration (used for 
#   undo functions), the choice depends on the value of method parameter.
# INPUTS
#   * method -- method used. Possiable values are file (if saving the string 
#   to the file) and string (if appending the string configuration)
#   * dest -- destination used. File_id for files, and string name for string 
#   configuration
#   * string -- the string that is inserted to a file or appended to the string
#   configuartion
#****

proc dumpputs {method dest string} {
    switch -exact -- $method {
	file {
	    puts $dest $string
	}
	string {
	    global $dest
	    append $dest "$string
"
	}
    }
}

#****f* nodecfg.tcl/dumpCfg
# NAME
#   dumpCfg -- puts the current configuraton to a file or a string 
# SYNOPSIS
#   dumpCfg $method $destination
# FUNCTION
#   Writes the working (current) configuration to a file or a string.
# INPUTS
#   * method -- used method. Possiable values are file (saving current congif
#   to the file) and string (saving current config in a string)
#   * dest -- destination used. File_id for files, and string name for string 
#   configurations
#****

proc dumpCfg {method dest} {
    global node_list plot_list link_list canvas_list annotation_list

    global g_comments
    if { [info exists g_comments] && $g_comments != "" } {
	dumpputs $method $dest "comments \{"
	foreach line [split $g_comments "\n"] { dumpputs $method $dest "$line" }
	dumpputs $method $dest "\}"
	dumpputs $method $dest ""
    }
    
    foreach node $node_list {
	global $node
	upvar 0 $node lnode
	dumpputs $method $dest "node $node \{"
	foreach element $lnode {
	    if { "[lindex $element 0]" == "network-config" } {
		dumpputs $method $dest "    network-config \{"
		foreach line [lindex $element 1] {
		    dumpputs $method $dest "	$line"
		}
		dumpputs $method $dest "    \}"
	    } elseif { "[lindex $element 0]" == "custom-config" } {
		dumpputs $method $dest "    custom-config \{"
		foreach line [lindex $element 1] {
		    if { $line != {} } {
			if { [catch {set str [lindex $line 0]} err] } {
				puts "error loading config: $err"
				puts "problem section: [lindex $element 0]"
				puts "problem line: $line"
				set str ""
			}
			if { $str == "config" } {
			    dumpputs $method $dest "	config \{"
			    foreach element [lindex $line 1] {
				dumpputs $method $dest "	$element"
			    }
			    dumpputs $method $dest "	\}"
			} else {
			    dumpputs $method $dest "	$line"
			}
		    }
		}
		dumpputs $method $dest "    \}"
	    } elseif { "[lindex $element 0]" == "ipsec-config" } { 
		dumpputs $method $dest "    ipsec-config \{"
		foreach line [lindex $element 1] {
		    if { $line != {} } {
			dumpputs $method $dest "	$line"
		    }
		}
		dumpputs $method $dest "    \}"
	    } elseif { "[lindex $element 0]" == "custom-pre-config-commands" } {
		#Boeing custom pre config commands
		dumpputs $method $dest "    custom-pre-config-commands \{"
		foreach line [lindex $element 1] {
		    dumpputs $method $dest "	$line"
		}
		dumpputs $method $dest "    \}"
	    } elseif { "[lindex $element 0]" == "custom-post-config-commands" } {
		#Boeing custom post config commands
		dumpputs $method $dest "    custom-post-config-commands \{"
		foreach line [lindex $element 1] {
		    dumpputs $method $dest "	$line"
		}
		dumpputs $method $dest "    \}"
	    } elseif { "[lindex $element 0]" == "ine-config" } {
	    # Boeing: INE config support
		dumpputs $method $dest "    ine-config \{"
		foreach line [lindex $element 1] {
		    dumpputs $method $dest "	$line"
		}
		dumpputs $method $dest "    \}"
	    # end Boeing
	    } else {
		dumpputs $method $dest "    $element"
            }
	}
	dumpputs $method $dest "\}"
	dumpputs $method $dest ""
    }

    foreach obj "link annotation canvas plot" {
	upvar 0 ${obj}_list obj_list
	foreach elem $obj_list {
	    global $elem
	    upvar 0 $elem lelem
	    dumpputs $method $dest "$obj $elem \{"
	    foreach element $lelem {
		dumpputs $method $dest "    $element"
	    }
	    dumpputs $method $dest "\}"
	    dumpputs $method $dest ""
	}
    }

    global g_traffic_flows
    if { [info exists g_traffic_flows] && [llength $g_traffic_flows] > 0 } {
	dumpputs $method $dest "traffic \{"
	foreach flow $g_traffic_flows {
	    dumpputs $method $dest "    $flow"
	}
	dumpputs $method $dest "\}"
	dumpputs $method $dest ""
    }

    global g_hook_scripts
    if { [info exists g_hook_scripts] && [llength $g_hook_scripts] > 0 } {
	foreach hook $g_hook_scripts {
	    set name [lindex $hook 0]
	    set state [lindex $hook 1]
	    set script [lindex $hook 2]
	    dumpputs $method $dest "hook $state:$name \{"
	    foreach line [split $script "\n"] {
	        dumpputs $method $dest "$line"
	    }
	    dumpputs $method $dest "\}"
	    dumpputs $method $dest ""
	}
    }

    dumpGlobalOptions $method $dest

    # session options
    dumpputs $method $dest "option session \{"
    foreach kv [getSessionOptionsList] { dumpputs $method $dest "    $kv" }
    dumpputs $method $dest "\}"
    dumpputs $method $dest ""
}

proc dumpGlobalOptions { method dest } {
    global showIfNames showNodeLabels showLinkLabels
    global showIfIPaddrs showIfIPv6addrs
    global showBkgImage showGrid showAnnotations
    global showAPI
    global g_view_locked
    global g_traffic_start_opt
    global mac_addr_start

    dumpputs $method $dest "option global \{"
    if {$showIfNames == 0} { 
	dumpputs $method $dest "    interface_names no" 
    } else {
	dumpputs $method $dest "    interface_names yes" }
    if {$showIfIPaddrs == 0} { 
	dumpputs $method $dest "    ip_addresses no" 
    } else {
	dumpputs $method $dest "    ip_addresses yes" }
    if {$showIfIPv6addrs == 0} { 
	dumpputs $method $dest "    ipv6_addresses no" 
    } else {
	dumpputs $method $dest "    ipv6_addresses yes" }
    if {$showNodeLabels == 0} { 
	dumpputs $method $dest "    node_labels no" 
    } else {
	dumpputs $method $dest "    node_labels yes" }
    if {$showLinkLabels == 0} { 
	dumpputs $method $dest "    link_labels no" 
    } else {
	dumpputs $method $dest "    link_labels yes" }
    if {$showAPI == 0} {
	dumpputs $method $dest "    show_api no"
    } else {
	dumpputs $method $dest "    show_api yes" }
    if {$showBkgImage == 0} {
	dumpputs $method $dest "    background_images no"
    } else {
	dumpputs $method $dest "    background_images yes" }
    if {$showAnnotations == 0} {
	dumpputs $method $dest "    annotations no"
    } else {
	dumpputs $method $dest "    annotations yes" }
    if {$showGrid == 0} {
	dumpputs $method $dest "    grid no"
    } else {
	dumpputs $method $dest "    grid yes" }
    if {$g_view_locked == 1} {
	dumpputs $method $dest "    locked yes" }
    if { [info exists g_traffic_start_opt] } {
	dumpputs $method $dest "    traffic_start $g_traffic_start_opt"
    }
    if { [info exists mac_addr_start] && $mac_addr_start > 0 } {
	dumpputs $method $dest "    mac_address_start $mac_addr_start"
    }
    dumpputs $method $dest "\}"
    dumpputs $method $dest ""
}

# get the global options into a list of key=value pairs
proc getGlobalOptionList {} {
    global tmp
    set tmp ""
    dumpGlobalOptions string tmp ;# put "options global {items}" into tmp
    set items [lindex $tmp 2]
    return [listToKeyValues $items]
}

proc setGlobalOption { field value } {
    global showIfNames showNodeLabels showLinkLabels
    global showIfIPaddrs showIfIPv6addrs
    global showBkgImage showGrid showAnnotations
    global showAPI
    global mac_addr_start 
    global g_traffic_start_opt
    global g_view_locked

    switch -exact -- $field {
	interface_names {
	    if { $value == "no" } {
		set showIfNames 0
	    } elseif { $value == "yes" } {
		set showIfNames 1
	    }
	}
	ip_addresses {
	    if { $value == "no" } {
		set showIfIPaddrs 0
	    } elseif { $value == "yes" } {
		set showIfIPaddrs 1
	    }
	}
	ipv6_addresses {
	    if { $value == "no" } {
		set showIfIPv6addrs 0
	    } elseif { $value == "yes" } {
		set showIfIPv6addrs 1
	    }
	}
	node_labels {
	    if { $value == "no" } {
		set showNodeLabels 0
	    } elseif { $value == "yes" } {
		set showNodeLabels 1
	    }
	}
	link_labels {
	    if { $value == "no" } {
		set showLinkLabels 0
	    } elseif { $value == "yes" } {
		set showLinkLabels 1
	    }
	}
	show_api {
	    if { $value == "no" } {
		set showAPI 0
	    } elseif { $value == "yes" } {
		set showAPI 1
	    }
	}
	background_images {
	    if { $value == "no" } {
		set showBkgImage 0
	    } elseif { $value == "yes" } {
		set showBkgImage 1
	    }
	}
	annotations {
	    if { $value == "no" } {
		set showAnnotations 0
	    } elseif { $value == "yes" } {
		set showAnnotations 1
	    }
	}
	grid {
	    if { $value == "no" } {
		set showGrid 0
	    } elseif { $value == "yes" } {
		set showGrid 1
	    }
	}
	locked {
	    if { $value == "yes" } {
		set g_view_locked 1
	    } else {
		set g_view_locked 0
	    }
	}
	mac_address_start {
	    set mac_addr_start  $value
	}
	traffic_start {
	    set g_traffic_start_opt $value
	}
    }
}

# reset global vars when opening a new file
proc cleanupGUIState {} {
    global node_list link_list plot_list canvas_list annotation_list
    global mac_addr_start g_comments
    global g_traffic_flows g_traffic_start_opt g_hook_scripts
    global g_view_locked

    set node_list {}
    set link_list {}
    set annotation_list {}
    set plot_list {}
    set canvas_list {}
    set g_traffic_flows ""
    set g_traffic_start_opt 0
    set g_hook_scripts ""
    set g_comments ""
    set g_view_locked 0
    resetSessionOptions
}

#****f* nodecfg.tcl/loadCfg
# NAME
#   loadCfg -- loads the current configuration.
# SYNOPSIS
#   loadCfg $cfg
# FUNCTION
#   Loads the configuration written in the cfg string to a current 
#   configuration. 
# INPUTS
#   * cfg -- string containing the new working configuration.
#****

proc loadCfg { cfg } {
    global node_list plot_list link_list canvas_list annotation_list
    global g_traffic_flows g_traffic_start_opt g_hook_scripts
    global g_view_locked
    global g_comments

    # maximum coordinates
    set maxX 0
    set maxY 0
    set do_upgrade [upgradeOldConfig cfg]
    if { $do_upgrade == "no"} { return }

    # Cleanup first
    cleanupGUIState
    set class ""
    set object ""
    foreach entry $cfg {
	if {"$class" == ""} {
	    set class $entry
	    continue
	} elseif {"$object" == ""} {
	    set object $entry
	    if {"$class" == "node"} {
		lappend node_list $object
	    } elseif {"$class" == "link"} {
		lappend link_list $object
	    } elseif {"$class" == "canvas"} {
		lappend canvas_list $object
	    } elseif {"$class" == "plot"} {
		lappend plot_list $object
            } elseif {"$class" == "option"} {
		# do nothing
	    } elseif {"$class" == "traffic"} { ;# save traffic flows
		set g_traffic_flows [split [string trim $object] "\n"]
		set class ""; set object ""; continue
	    } elseif {"$class" == "script"} {
		# global_script (old config) becomes a runtime hook
		set name "runtime_hook.sh"
		set script [string trim $object]
		lappend g_hook_scripts [list $name 4 $script] ;# 4=RUNTIME_STATE
		set class ""; set object ""; continue
	    } elseif {"$class" == "hook"} {
		continue
	    } elseif {"$class" == "comments"} {
		set g_comments [string trim $object]
		set class ""; set object ""; continue
	    } elseif {"$class" == "annotation"} {
		lappend annotation_list $object
	    } else {
		puts "configuration parsing error: unknown object class $class"
		#exit 1
	    }
	    # create an empty global variable named object for most objects
	    global $object
	    set $object {}
	    continue
	} else {
	    set line [concat $entry]
	    # uses 'key=value' instead of 'key value'
	    if  { $object == "session" } {
		# 'key=value', values with space needs quoting 'key={space val}'
		setSessionOptions "" [split $line "\n"]
		set class ""
		set object ""
		continue
	    }
	    # extracts "field { value }"  elements from line
	    if { [catch { set tmp [llength $line] } e] } {
		puts "*** Error with line ('$e'):\n$line"
		puts "*** Line will be skipped. This is a Tcl limitation, "
		puts "*** consider using XML or fixing with whitespace."
		continue
	    }
	    while {[llength $line] >= 2} {
		set field [lindex $line 0]
		if {"$field" == ""} {
		    set line [lreplace $line 0 0]
		    continue
		}

		# consume first two list elements from line
		set value [lindex $line 1]
		set line [lreplace $line 0 1]
    
		if {"$class" == "node"} {
		    switch -exact -- $field {
			type {
			    lappend $object "type $value"
			}
			mirror {
			    lappend $object "mirror $value"
			}
			model {
			    lappend $object "model $value"
			}
			cpu {
			    lappend $object "cpu {$value}"
			}
			interface-peer {
			    lappend $object "interface-peer {$value}"
			}
			network-config {
			    set cfg ""
			    foreach zline [split $value {
}] {
				if { [string index "$zline" 0] == "	" } {
				    set zline [string replace "$zline" 0 0]
				}
				lappend cfg $zline
			    }
			    set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
			    lappend $object "network-config {$cfg}"
			}
			custom-enabled {
			    lappend $object "custom-enabled $value"
			}
			custom-command {
			    lappend $object "custom-command {$value}"
			}
			custom-config {
			    set cfg ""
			    set have_config 0
			    set ccfg {}
			    foreach zline [split $value "\n"] {
				if { [string index "$zline" 0] == \
						"	" } {
				    # remove leading tab character
				    set zline [string replace "$zline" 0 0]
				}

				# flag for config lines
				if { $zline == "config \{" } {
				    set have_config 1
				# collect custom config lines into list
				} elseif { $have_config == 1 } {
				    lappend ccfg $zline
				# add non-config lines
				} else {
				    lappend cfg $zline
				}
  			    }
			    # chop off last brace in config { } block and add it
			    if { $have_config } {
				set ccfg [lrange $ccfg 0 \
					 [expr {[llength $ccfg] - 3}]]
				lappend cfg [list config $ccfg]
			    }
			    #set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
			    lappend $object "custom-config {$cfg}"
			}
			ipsec-enabled {
			    lappend $object "ipsec-enabled $value"
			}
			ipsec-config {
			    set cfg ""
		
			    foreach zline [split $value {
}] {
				if { [string index "$zline" 0] == "	" } {
				    set zline [string replace "$zline" 0 0]
				}
				lappend cfg $zline
			    }
			    set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
				lappend $object "ipsec-config {$cfg}"
			}
			iconcoords {
			    checkMaxCoords $value maxX maxY
			    lappend $object "iconcoords {$value}"
			}
			labelcoords {
			    checkMaxCoords $value maxX maxY
			    lappend $object "labelcoords {$value}"
			}
			canvas {
			    lappend $object "canvas $value"
			}
			hidden {
			    lappend $object "hidden $value"
			}
			/* {
			    set comment "$field $value"
			    foreach c $line {
				lappend comment $c
				# consume one element from line
				set line [lreplace $line 0 0]
				if { $c == "*/" } { break }
			    }
			    lappend $object "$comment"
			}

			custom-pre-config-commands {
			    # Boeing - custom pre config commands
			    set cfg ""
			    foreach zline [split $value {
}] {
				if { [string index "$zline" 0] == "	" } {
				    set zline [string replace "$zline" 0 0]
				}
				lappend cfg $zline
			    }
			    set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]]
			    lappend $object "custom-pre-config-commands {$cfg}"
		        }
			custom-post-config-commands {
			    # Boeing - custom post config commands
			    set cfg ""
			    foreach zline [split $value {
}] {
				if { [string index "$zline" 0] == "	" } {
				    set zline [string replace "$zline" 0 0]
				}
				lappend cfg $zline
			    }
			    set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]]
			    lappend $object "custom-post-config-commands {$cfg}"
		        }
			custom-image {
			    # Boeing - custom-image
			    lappend $object "custom-image $value"
		        }
			ine-config {
			    # Boeing - INE
			    set cfg ""
			    foreach zline [split $value {
}] {
				if { [string index "$zline" 0] == "	" } {
				    set zline [string replace "$zline" 0 0]
				}
				lappend cfg $zline
			    }
			    set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]]
			    lappend $object "ine-config {$cfg}"
			}
			tunnel-peer {
			    # Boeing - Span tunnels
			    lappend $object "tunnel-peer {$value}"
		        }
			range {
			    # Boeing - WLAN range
			    lappend $object "range $value"
			}
			bandwidth {
			    # Boeing - WLAN bandwidth
			    lappend $object "bandwidth $value"
			}
			cli-enabled {
			    puts "Warning: cli-enabled setting is deprecated"
			}
			delay {
			    # Boeing - WLAN delay
			    lappend $object "delay $value"
			}
			ber {
			    # Boeing - WLAN BER
			    lappend $object "ber $value"
			}
			location {
			    # Boeing - node location
			    lappend $object "location $value"
			}
			os {
			    # Boeing - node OS
			    # just ignore it, set at runtime
			}
			services {
			    lappend $object "services {$value}"
			}

			default {
			    # Boeing - added warning
			    puts -nonewline "config file warning: unknown confi"
			    puts "guration item '$field' ignored for $object"
			}
		    }
		} elseif {"$class" == "plot"} {
		    switch -exact -- $field {
		  	name {
			    lappend $object "name $value"
			}	
			height {
			    lappend $object "height $value"
			}
 			width {
			    lappend $object "width $value"
			}
			x {
			    lappend $object "x $value"
			}
			y {
			    lappend $object "y $value"
			}
 			color {	
			    lappend $object "color $value"
			} 
 		    } 
                } elseif {"$class" == "link"} {
		    switch -exact -- $field {
			nodes {
			    lappend $object "nodes {$value}"
			}
			mirror {
			    lappend $object "mirror $value"
			}
			bandwidth -
			delay -
			ber -
			duplicate -
			jitter {
			    if { [llength $value] > 1 } { ;# down/up-stream
				lappend $object "$field {$value}"
			    } else {
				lappend $object "$field $value"
			    }
			}
			color {
			    lappend $object "color $value"
			}
			width {
			    lappend $object "width $value"
			}
			default {
			    # this enables opaque data to be stored along with
			    # each link (any key is stored)
			    lappend $object "$field $value"
			    # Boeing - added warning
			    #puts -nonewline "config file warning: unknown conf"
			    #puts "iguration item '$field' ignored for $object"
			}
		    }
		} elseif {"$class" == "canvas"} {
		    switch -exact -- $field {
			name {
			    lappend $object "name {$value}"
			}
			size {
			    lappend $object "size {$value}"
			}
			bkgImage {
			    lappend $object "wallpaper {$value}"
			}
			wallpaper {
			    lappend $object "wallpaper {$value}"
			}
			wallpaper-style {
			    lappend $object "wallpaper-style {$value}"
			}
			scale {
			    lappend $object "scale {$value}"
			}
			refpt {
			    lappend $object "refpt {$value}"
			}
		    }
		} elseif {"$class" == "option"} {
		    setGlobalOption $field $value
		} elseif {"$class" == "annotation"} {
		    switch -exact -- $field {
			type {
			    lappend $object "type $value"
			}
			iconcoords {
			    lappend $object "iconcoords {$value}"
			}
			color {
			    lappend $object "color $value"
			}
			border {
			    lappend $object "border $value"
			}
			label {
			    lappend $object "label {$value}"
			}
			labelcolor {
			    lappend $object "labelcolor $value"
			}
			size {
			    lappend $object "size $value"
			}
			canvas {
			    lappend $object "canvas $value"
			}
			font {
			    lappend $object "font {$value}"
			}
			fontfamily {
			    lappend $object "fontfamily {$value}"
			}
			fontsize {
			    lappend $object "fontsize {$value}"
			}
			effects {
			    lappend $object "effects {$value}"
			}
			width {
			    lappend $object "width $value"
			}
			rad {
			    lappend $object "rad $value"
			}
		    } ;# end switch
		} elseif {"$class" == "hook"} {
		    set state_name [split $object :]
		    if { [llength $state_name] != 2 } {
			puts "invalid hook in config file"
			continue
		    }
		    set state [lindex $state_name 0]
		    set name [lindex $state_name 1]
		    set lines [split $entry "\n"]
		    set lines [lreplace $lines 0 0] ;# chop extra newline
		    set lines [join $lines "\n"]
		    set hook [list $name $state $lines]
		    lappend g_hook_scripts $hook
		    set line "" ;# exit this while loop
		} ;#endif class
	    }
	}
	set class ""
	set object ""
    }

    #
    # Hack for comaptibility with old format files (no canvases)
    #
    if { $canvas_list == "" } {
	set curcanvas [newCanvas ""]
	foreach node $node_list {
	    setNodeCanvas $node $curcanvas
	}
    }


    # auto resize canvas
    set curcanvas [lindex $canvas_list 0]
    set newX 0
    set newY 0
    if { $maxX > [lindex [getCanvasSize $curcanvas] 0] } {
	set newX [expr {$maxX + 50}]
    }
    if { $maxY > [lindex [getCanvasSize $curcanvas] 1] } {
	set newY [expr {$maxY + 50}]
    }
    if { $newX > 0 || $newY > 0 } {
    	if { $newX == 0 } { set newX [lindex [getCanvasSize $curcanvas] 0] }
    	if { $newY == 0 } { set newY [lindex [getCanvasSize $curcanvas] 1] }
	setCanvasSize $curcanvas $newX $newY
    }

    # extra upgrade steps
    if { $do_upgrade == "yes" } {
	upgradeNetworkConfigToServices
    }
    upgradeConfigRemoveNode0
    upgradeConfigServices
    upgradeWlanConfigs
}

#****f* nodecfg.tcl/newObjectId
# NAME
#   newObjectId -- new object Id 
# SYNOPSIS
#   set obj_id [newObjectId $type]
# FUNCTION
#   Returns the Id for a new object of the defined type. Supported types
#   are node, link and canvas. The Id is in the form $mark$number. $mark is the 
#   first letter of the given type and $number is the first available number to
#   that can be used for id. 
# INPUTS
#   * type -- the type of the new object. Can be node, link or canvas.
# RESULT
#   * obj_id -- object Id in the form $mark$number. $mark is the 
#   first letter of the given type and $number is the first available number to
#   that can be used for id. 
#****

proc newObjectId { type } {
    global node_list link_list annotation_list canvas_list

    set mark [string range [set type] 0 0]
    set id 1 ;# start numbering at 1, not 0
    while {[lsearch [set [set type]_list] "$mark$id"]  != -1} {
	incr id
    }
    return $mark$id
}



# Boeing: pick a new link id for temporary newlinks
proc newlinkId { } {
    global link_list
    set id [newObjectId link]
    set mark "l"
    set id 0

    # alllinks contains a list of all existing and new links
    set alllinks $link_list
    foreach newlink [.c find withtag "newlink"] {
    	set newlinkname [lindex [.c gettags $newlink] 1]
    	lappend alllinks $newlinkname
    }

    while {[lsearch $alllinks "$mark$id"] != -1 } {
	incr id
    }
    return $mark$id
}

# Boeing: helper fn to determine canvas size during load
proc checkMaxCoords { str maxXp maxYp } {
    upvar 1 $maxXp maxX
    upvar 1 $maxYp maxY
    set x [lindex $str 0]
    set y [lindex $str 1]
    if { $x > $maxX } {
	set maxX $x
    }
    if { $y > $maxY } {
	set maxY $y
    }
    if { [llength $str] == 4 } {
	set x [lindex $str 2]
	set y [lindex $str 3]
	if { $x > $maxX } {
	    set maxX $x
	}
	if { $y > $maxY } {
	    set maxY $y
	}
    }
}

# Boeing: pick a router for OSPF
proc newRouterId { type node } {
    set mark [string range [set type] 0 0]
    for { set id 0 } { $node != "$mark$id" } { incr id } {
    }
    return "0.0.0.${id}"
}
# end Boeing

# Boeing: load servers.conf file into exec_servers array
proc loadServersConf { } {
    global CONFDIR exec_servers DEFAULT_API_PORT
    set confname "$CONFDIR/servers.conf"
    if { [catch { set f [open "$confname" r] } ] } {
	puts "Creating a default $confname" 
	if { [catch { set f [open "$confname" w+] } ] } {
	    puts "***Warning: could not create a default $confname file."
	    return
	}
	puts $f "core1 192.168.0.2 $DEFAULT_API_PORT"
	puts $f "core2 192.168.0.3 $DEFAULT_API_PORT"
	close $f
    	if { [catch { set f [open "$confname" r] } ] } {
	    return
	}
    }

    array unset exec_servers

    while { [ gets $f line ] >= 0 } {
	if { [string range $line 0 0] == "#" } { continue } ;# skip comments
	set l [split $line] ;# parse fields separated by whitespace
	set name [lindex $l 0]
	set ip   [lindex $l 1]
	set port [lindex $l 2]
	set sock -1
	if { $name == "" } { continue } ;# blank name
	# load array of servers
	array set exec_servers [list $name [list $ip $port $sock]]
    }
    close $f
}
# end Boeing

# Boeing: write servers.conf file from exec_servers array
proc writeServersConf { } {
    global CONFDIR exec_servers
    set confname "$CONFDIR/servers.conf"
    if { [catch { set f [open "$confname" w] } ] } {
	puts "***Warning: could not write servers file: $confname"
	return
    }

    set header "# servers.conf: list of CORE emulation servers for running"
    set header "$header remotely."
    puts $f $header
    foreach server [lsort -dictionary [array names exec_servers]] {
	set ip   [lindex $exec_servers($server) 0]
	set port [lindex $exec_servers($server) 1]
	puts $f "$server $ip $port"
    }
    close $f
}
# end Boeing

# display the preferences dialog
proc popupPrefs {} {
    global EDITORS TERMS

    set wi .core_prefs
    catch { destroy $wi }
    toplevel $wi

    wm transient $wi .
    wm resizable $wi 0 0
    wm title $wi "Preferences"

    global g_prefs g_prefs_old
    array set g_prefs_old [array get g_prefs]

    #
    # Paths
    #
    labelframe $wi.dirs -borderwidth 4 -text "Paths" -relief raised
    frame $wi.dirs.conf
    label $wi.dirs.conf.label -text "Default configuration file path:"
    entry $wi.dirs.conf.entry -bg white -width 40 \
	-textvariable g_prefs(default_conf_path)
    pack $wi.dirs.conf.label $wi.dirs.conf.entry -side left
    pack $wi.dirs.conf -side top -anchor w -padx 4 -pady 4

    frame $wi.dirs.mru
    label $wi.dirs.mru.label -text "Number of recent files to remember:"
    entry $wi.dirs.mru.num -bg white -width 3 \
	-textvariable g_prefs(num_recent)
    button $wi.dirs.mru.clear -text "Clear recent files" \
	-command "addFileToMrulist \"\""
    pack $wi.dirs.mru.label $wi.dirs.mru.num $wi.dirs.mru.clear -side left
    pack $wi.dirs.mru -side top -anchor w -padx 4 -pady 4
    
    pack $wi.dirs -side top -fill x

    #
    # Window
    #
    labelframe $wi.win -borderwidth 4 -text "GUI Window" -relief raised
    frame $wi.win.win
    checkbutton $wi.win.win.savepos -text "remember window position" \
	-variable g_prefs(gui_save_pos)
    checkbutton $wi.win.win.savesiz -text "remember window size" \
	-variable g_prefs(gui_save_size)
    pack $wi.win.win.savepos $wi.win.win.savesiz -side left -anchor w -padx 4
    pack $wi.win.win -side top -anchor w -padx 4 -pady 4
 
    frame $wi.win.a
    checkbutton $wi.win.a.snaptogrid -text "snap to grid" \
	-variable g_prefs(gui_snap_grid)
    checkbutton $wi.win.a.showtooltips -text "show tooltips" \
	-variable g_prefs(gui_show_tooltips)
    pack $wi.win.a.snaptogrid $wi.win.a.showtooltips \
	-side left -anchor w -padx 4
    pack $wi.win.a -side top -anchor w -padx 4 -pady 4

    frame $wi.win.canv
    label $wi.win.canv.label -text "Default canvas size:"
    entry $wi.win.canv.x -bg white -width 5 -textvariable g_prefs(gui_canvas_x)
    entry $wi.win.canv.y -bg white -width 5 -textvariable g_prefs(gui_canvas_y)
    label $wi.win.canv.label2 -text "Default # of canvases:"
    entry $wi.win.canv.num -bg white -width 5 \
	-textvariable g_prefs(gui_num_canvases)
    pack $wi.win.canv.label $wi.win.canv.x $wi.win.canv.y \
	$wi.win.canv.label2 $wi.win.canv.num \
	-side left -anchor w -padx 4
    pack $wi.win.canv -side top -anchor w -padx 4 -pady 4
    pack $wi.win -side top -fill x

    #
    # Programs
    #
    labelframe $wi.pr -borderwidth 4 -text "Programs" -relief raised

    frame $wi.pr.editor
    label $wi.pr.editor.label -text "Text editor:"
    set editors [linsert $EDITORS 0 "EDITOR"]
    ttk::combobox $wi.pr.editor.combo -width 10 -exportselection 0 \
    	-values $editors -textvariable g_prefs(gui_text_editor)
    label $wi.pr.editor.label2 -text "Terminal program:"
    set terms [linsert $TERMS 0 "TERM"]
    ttk::combobox $wi.pr.editor.combo2 -width 20 -exportselection 0 \
    	-values $terms -textvariable g_prefs(gui_term_prog)
    pack $wi.pr.editor.label $wi.pr.editor.combo -padx 4 -pady 4 -side left
    pack $wi.pr.editor.label2 $wi.pr.editor.combo2 -padx 4 -pady 4 -side left
    pack $wi.pr.editor -side top -anchor w -padx 4 -pady 4

    frame $wi.pr.3d
    label $wi.pr.3d.label -text "3D GUI command:"
    entry $wi.pr.3d.entry -bg white -width 40 -textvariable g_prefs(gui_3d_path)
    pack $wi.pr.3d.label $wi.pr.3d.entry -side left -padx 4 -pady 4
    pack $wi.pr.3d -side top -anchor w -padx 4 -pady 4

    pack $wi.pr -side top -fill x

    #
    # Buttons at the bottom
    #
    frame $wi.bot -borderwidth 0
    button $wi.bot.apply -text "Save" -command "savePrefsFile; destroy $wi"
    button $wi.bot.defaults -text "Load defaults" -command initDefaultPrefs
    button $wi.bot.cancel -text "Cancel" -command {
	global g_prefs g_prefs_old
	array set g_prefs [array get g_prefs_old]
	destroy .core_prefs
    }
    pack $wi.bot.cancel $wi.bot.defaults $wi.bot.apply -side right
    pack $wi.bot -side bottom -fill x
    after 100 {
    	catch { grab .core_prefs }
    }
}

# initialize preferences array with default values
proc initDefaultPrefs {} {
    global g_prefs CONFDIR SBINDIR DEFAULT_REFPT tcl_platform

    # variable expansions must be done here
    array set g_prefs [list default_conf_path	"$CONFDIR/configs"]
    array set g_prefs [list gui_canvas_refpt	"$DEFAULT_REFPT"]
    if { $tcl_platform(os) == "FreeBSD" } { set shell "/usr/local/bin/bash"
    } else { set shell "bash" }
    array set g_prefs [list shell $shell] 
    array set g_prefs [list gui_text_editor	[get_text_editor true]]
    array set g_prefs [list gui_term_prog	[get_term_prog true]]
    setDefaultAddrs ipv4
    setDefaultAddrs ipv6
    # preferences will be reordered alphabetically
    array set g_prefs {
	num_recent		4
	log_path		"/tmp/core_logs"
	gui_save_pos		0
	gui_save_size		0
	gui_snap_grid		0
	gui_show_tooltips	1
	gui_canvas_x		1000
	gui_canvas_y		750
	gui_canvas_scale	150.0
	gui_num_canvases	1
	gui_3d_path		"/usr/local/bin/sdt3d.sh"
    }
    # add new preferences above; keep this at the end of the file
}