#
#   File:    topology-d.prc
#   Author:  J.M. Heisz, T. Yuyitung
#   Version: 1.75 02/06/27 13:38:26
#
#   Copyright (c) 1997 Halcyon Inc.
#
#   Procedures for the topology module
#

###########################################################################
#
# Method:  getUpdateEntityDesc
#
# Purpose: Get a unique entity description when updating the description
#
# Inputs:  view
#          entity
#          desc
#
# Output:  newdesc
#
# Notes:   When updating entity attributes, a "!" is used to denote
#          that the attribute is to be changed.
#
###########################################################################
proc getUpdateEntityDesc { view entity desc } {
    if { [ string range $desc 0 0 ] != "!" } {
        return $desc
    }

    set desc [ string range $desc 1 end ]
    if { [ topoDbEntityDesc $view $entity ] == "$desc" } { 
        return "!${desc}"
    }
    return "![ getUniqueEntityDesc $view $desc ]"
}

###########################################################################
#
# Method:  getUniqueEntityDesc
#
# Purpose: Get a unique entity description
#
# Inputs:  view
#          desc
#
# Output:  newdesc
#
# Notes:   Descriptions are made unique by appending "[N]" to the original
#          description string. The next unique description is generated 
#          by incrementing N. 
#
###########################################################################
proc getUniqueEntityDesc { view desc } {
    if { ![ topoDbEntityExists $view $desc ] } {
        return $desc
    }

    set idx "1"
    if { [ regexp {(.*) \[([0-9]*)\]$} $desc dummy desc idx ] } { 
        incr idx 
    }

    set desc [ string trimright $desc ]
    set newdesc "${desc} \[${idx}\]"

    while { [ topoDbEntityExists $view $newdesc ] } {
        incr idx 
        set newdesc "${desc} \[${idx}\]"
    }
    return $newdesc
}

###########################################################################
#
# Method:  isValidPollType
#          isValidTopoType
#
# Purpose: Validate polltype or topotype
# 
# Inputs:  type 
#
# Outputs: 1 - type is valid
#          0 - type is invalid
# 
###########################################################################
proc isValidPollType { type } {
    return [ regexp {^dummy$|^ping$|^snmp$|^aview$|^ahost$|^amod$|^aprox$} $type ]
}

proc isValidTopoType { type } {
    return [ regexp {^node\||^$|^composite$|^platform$|^bus$|^ring$|^link\|} $type ]
} 

#####################################################################
#
# Method:  isAgentPollType
#          isLinkTopoType
#
# Purpose: Check whether polltype is agent 
#          Check whether topotype is link 
#
# Input:   type
#
# Output:  1 - true 
#          0 - false
#
#####################################################################
proc isAgentPollType { type } {
    return [ expr { [ string index $type 0 ] == "a" } ] 
}

proc isLinkTopoType { type } {
    return [ regexp {^link\|} $type ] 
}

###########################################################################
#
# Method:  extractLinkEndPoints
#
# Purpose: Extract link end points from link specification
#
# Inputs:  spec
#
# Outputs: { a z } - link end points
#          "" - invalid link spec
#
###########################################################################
proc extractLinkEndPoints { spec } {
    if { [ regexp {^link\|([^|]+)\|([^|]+)\|(.*)$} $spec d a z ] } {
        return [ list $a $z ]
    } else {
        ddl print error "extractLinkEndPoints: invalid link specification - $spec\n"
        return ""
    }
}

###########################################################################
#
# Method:  verifyLinkSpec
#
# Purpose: Verify the link end points from link specification correspond
#          to existing entities in the topology module instance
#
# Inputs:  instance - topology module instance 
#          spec     - link spec
#
# Outputs: 1 - link spec is ok 
#          0 - link spec is not ok
#
###########################################################################
proc verifyLinkSpec { instance spec } {

    set endpts [ extractLinkEndPoints $spec ] 
    if { $endpts == "" } {
        return 0
    }
    lextract $endpts 0 a 1 z

    #
    # verify link end points are existing entities 
    #
    if { [ catch { topoDbEntityList $instance } ids ] } {
        ddl print error "verifyLinkSpec: failed to get entity list for $instance - $ids\n"
        return 0
    }

    if { [ lsearch -exact $ids $a ] != -1 && [ lsearch -exact $ids $z ] != -1 } { 
        return 1
    }

    ddl print error "verifyLinkSpec: link end point(s) not found\n"
    return 0
}

###########################################################################
#
# Method:  getHostAndIp
#
# Purpose: Determine the hostname and ipaddress. If the hostspec is 
#          not set, derive it from the url.
#
# Inputs:  hostspec - hostname/ipaddress
#          url      - entity url
#
# Outputs: { hostname ipaddress }
#
###########################################################################
proc getHostAndIp { hostspec url } {

    if { $hostspec == "" } {
        set hostspec [ URL2host $url ]
    }

    #
    # Convert the hostspec to a hostname or an ip address
    #
    if { [ isIpAddress $hostspec ] } { 
        set ipaddress $hostspec
        if { [ catch { ip2host $hostspec } hostname ] } {
            set hostname ""
        }
    } else {
        set hostname $hostspec
        if { [ catch { host2ip $hostspec } ipaddress ] } {
            set ipaddress ""
        }
    }
    return [ list $hostname $ipaddress ]
}

###########################################################################
#
# Method:  URL2host
#
# Purpose: Extracts host specification from a url
#
# Input:   url of the form: <scheme>://<hostspec>[:<port>]/...
#
# Output:  hostspec
#
###########################################################################
proc URL2host { url } {
    return [ lindex [ split $url ":/" ] 3 ]
}

###########################################################################
#
# Method:  netloc2host
#
# Purpose: Convert an network location spec (host:port) to a hostname.
#          Also removes the domain name if the host name is fully qualified.
#          If the spec contains a blank host, default to the local hostname.
#
# Input:   net_loc     - host:[port]
#
# Output:  hostname
#
###########################################################################
proc netloc2host { net_loc } {

    set host [ lindex [ split $net_loc ":" ] 0 ]

    #
    # if ip address, convert to hostname
    #
    if { $host != "" && ![ catch { ip2host $host } result ] } {
        set host $result
    } else {
        set host [ sysinfo hostname ]
    }

    if { ![ isIpAddress $host ] } { 
        regsub {[\.].*$} $host {} host
    }
    return $host
}

###########################################################################
#
# Method:  URL2desc
#
# Purpose: Construct a description based on an object URL.
#
# Input:   url
#
# Output:  desc
#
###########################################################################
proc URL2desc { url } {
    #
    # Decompose the URL
    #
    set spec ""
    lextract [ decomposeURL $url ] 0 scheme 1 net_loc
    if { [ string tolower $scheme ] == "snmp" } {
        lextract [ decomposeSnmpURL $url ] 0 net_loc 2 spec
    }

    set host [ netloc2host $net_loc ]
    
    #
    # Remove trailing status from desc spec
    #
    regsub -all {[(..)\{\}\(\)]} $spec "" spec
    regsub -all {[/\.]*status$} $spec "" spec

    if { $spec == "" } { 
        set desc $host
    } else {
        #
        # If topology url - do not include host
        #
        if { [ regexp {topology} $spec ] } {
            lextract [ split $spec "+" ] 0 module 1 instance
            regsub -all {[-/\.]} $instance " " instance
            set desc [ word cap all "$instance [ split $module "-" ]" ]
        } else {
            regsub -all {[\+-/\.]} $spec " " spec
            set spec [ word cap all $spec ]
            set desc "$host $spec"
        }
    }

    return $desc
}

#####################################################################
#
# Method:  isIpAddress
#
# Purpose: Check an ip address is valid 
#
# Input:   ip address
#
# Output:  1 - valid ip address
#          0 - invalid ip address
#
#####################################################################
proc isIpAddress { ip } {
    return [ regexp {^[1-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*$} $ip ]
}

#####################################################################
#
# Method:  topoSendRefreshTrap
#          topoRefreshViewAndInfo
#          topoRefreshValueAndTrap
#          topoRefreshViewTable
#          topoRefreshInfoTable
#          topoSendStatusTrap
#
# Purpose: Methods to refresh values and/or send traps in various
#          object contexts.
#
#####################################################################
proc topoSendRefreshTrap {} {
    return [ toe_csend dummy [ locate topology ] setTrapInfo refreshOID ] 
}

proc topoRefreshViewAndInfo {} {
    if { ![ ilookup -d "0" internal pendingRefreshViewAndInfo ] } {
        define internal pendingRefreshViewAndInfo 1
        registerOneShot 0 _topoRefreshViewAndInfo
    }
    return
}

proc _topoRefreshViewAndInfo {} {
    undefine internal pendingRefreshViewAndInfo 
    topoRefreshViewTable
    topoRefreshInfoTable
    topoSendRefreshTrap
    return
}

proc topoRefreshValueAndTrap {} {
    catch { refreshValueAndTrap }
    topoSendRefreshTrap
    return
}

proc topoRefreshInfoTable {} {
    return [ toe_csend dummy [ locate entityInfoTable.entityInfoEntry ] refreshValue ]
}

proc topoRefreshViewTable {} {
    return [ toe_csend dummy [ locate entityViewTable.entityViewEntry ] refreshValue ]
}

proc topoRefreshTopoObjectStatus {} {
    return [ toe_send [ locate .iso.org.dod.internet.private.enterprises.sun.prod.sunsymon.agent.modules.topologyLicense.topoObjectStats ] refreshValue ]
}


proc _topoSendStatusTrap {} {
    return [ triggerCommand status trap "" ] 
}
proc topoSendStatusTrap {} {
    #
    # The inform-dependencies should occur after any
    # scheduled refresh.
    #
    registerOneShot 1 {informDependencies status}
    _topoSendStatusTrap
}

proc topoSendViewStatusTrap {} {
    #
    # The inform-dependencies should occur after any
    # scheduled refresh.
    #
    registerOneShot 1 {informDependencies status}
    return [ toe_csend dummy [ locate entityViewTable.entityViewEntry ] _topoSendStatusTrap ]
}

#############################################################################
#
# Method:  enforceLimit
#
# Purpose: enforce minimum and maximum limits for a numerical value.
#
# Inputs:  min
#          max
#          value
#
# Outputs: returns value if it is within the range of min-max;
#          or min if value < min,
#          or max if value > max.
#
# Note: caller should ensure min < max.
#
#############################################################################
proc enforceLimit { min max value } {
    if { $value < $min } {
        set value $min
    } elseif { $value > $max } {
        set value $max
    }
    return $value
}

#############################################################################
#
# Method:  initializeRequestTimer 
#
# Purpose: Generic method to initialize request timers 
#
# Inputs:  type     - request type
#          min, max - if given, enforces min/max limit on timer period. 
#
# Outputs: none
#
#############################################################################
proc initializeRequestTimer { type { min "" } { max "" } } { 
    if { ![ ilookup -d "0" internal ${type}Timer ] } {
        ddl print debug "initializeRequestTimer: $type\n"
        define internal ${type}Timer 1
        if { $max != "" } {
            define value ${type}Interval [ enforceLimit $min $max [ lookup value ${type}Interval ] ]
        }

        registerAttributeTimer ${type} ${type}Init ${type} true \
                               ${type}TimerCallback ""
    }
}

#####################################################################
#
# Method:  isLocalTopoUrl
#
# Purpose: Determine whether a url references a local topology module
#
# Input:   url
#
# Output:  viewid - if local topology module
#          "" - if not local
#
#####################################################################
proc isLocalTopoUrl { url } {
    set viewid ""
    lextract [ decomposeSnmpURL $url ] 0 netloc 2 spec
    if { $netloc == [ snmp get address ] } {
         regexp {^topology\+(view-[0-9]*).*} $spec dummy viewid
    }
    return $viewid
}

#####################################################################
#
# Method:  registerViewDependency
#
# Purpose: Register a status dependency with a topology group
#
# Input:   object
#          id 
#          url 
#
# Output:  1 - success
#          0 - failure
#
#####################################################################
proc registerViewDependency { object id url } {
 
    if { [ toe_csend result $object registerDependency \
            status [ toe_self ] [ list topoGetAgentStatus $id $url ] ] } {
        ddl print warning "registerViewDependency: failed for $id - $url\n"
        ddl print warning "registerViewDependency: $result\n"
        return 0
    }
    return 1
}

#####################################################################
#
# Method:  topoSetViewId
#          topoSetViewObject
#
# Purpose: Initialize the viewid/viewobject slice spec for a
#          local aview entity, if appropriate. 
#
# Inputs:  id     - entity id
#          url    - entity url
#          viewid - topology instance name
#
# Output:  viewid/viewobject - success
#          ""                - failure
#
#####################################################################
proc topoSetViewId { id url } {
    #
    # check if the url reference a local topology module
    #
    set viewid [ isLocalTopoUrl $url ]
    if { $viewid != "" } {
        define viewid $id $viewid
        return $viewid
    } else {
        undefine viewid $id
        return ""
    }
}

proc topoSetViewObject { id viewid } {

    if { $viewid != "" } {
        set object [ topoLocateView $viewid ]
        if { $object != "" } {
            define viewobject $id $object
            return $object
        }
    }
    undefine viewobject $id
    return ""
}

#####################################################################
#
# Method:  topoInitAgentView
#
# Purpose: Initialize an entity representing a local view and whose 
#          status is to be retrieved using the internal loopback 
#          mechanism. 
#
#          The initialization involves setting the viewid and 
#          viewobject entries and registering a status dependency 
#          with the target view.
#
# Input:   id  - entity id
#          url - entity url
#
# Output:  1 - success
#          0 - failure
#
#####################################################################
proc topoInitAgentView { id url } {
    set viewid [ topoSetViewId $id $url ]
    if { $viewid != "" } {
        set object [ topoSetViewObject $id $viewid ]
        if { $object != "" } {
            return [ registerViewDependency $object $id $url ]
        }
    }
    return 0
}

#####################################################################
#
# Method:  topoValidateView
#
# Purpose: Validate a viewid based on its presence in the module slice
#          in the .iso*base.mibman.modules object 
#
# Input:   id - viewid
#
# Output:  1 - valid
#          0 - not found
#
#####################################################################
proc topoValidateView { id } {
    set object [ ilookup -d "" internal modulesObject ]
    if { $object == "" } {
        set object [ locate .iso*base.mibman.modules ]
        define internal modulesObject $object
    }
    if { [ toe_send $object ilookup -d "" module topology+${id} ] != "" } {
        return 1
    } else {
        return 0
    }
}

#####################################################################
#
# Method:  topoLocateView
#
# Purpose: Locate a viewid based on its entry in the modroot slice
#          in the .iso*base.mibman.modules object 
#
# Input:   id - viewid
#
# Output:  modroot - module root toe id
#          ""      - module not found
#
#####################################################################
proc topoLocateView { id } {
    set object [ ilookup -d "" internal modulesObject ]
    if { $object == "" } {
        set object [ locate .iso*base.mibman.modules ]
        define internal modulesObject $object
    }
    return [ toe_send $object ilookup -d "" modroot topology+${id} ]
}

#####################################################################
#
# Method:  topoGetAgentStatus
#
# Purpose: Get the status of an entity with an agent polltype 
#
# Inputs:  id  - entity id
#          url - entity url
#
# Output:  none
#
# Notes:   - for external entities, use topoSendStatusRequest
#          - for internal entities, use topoGetStatusAndCounts 
#            to get entity status and counts 
#
#          - if an error is encountered, call agentStatusCallback 
#            directly with entity status 
#              
#####################################################################
proc topoGetAgentStatus { id url } {
# ddl print info "topoGetAgentStatus: $id $url\n"

    #
    # check whether entity represents an internal or external topology
    # module instance
    #
    set viewid [ ilookup -d "" viewid $id ]
    if { $viewid == "" } {
        #
        # external topology module instance
        #
        topoSendStatusRequest $id $url
        return
    }

    #
    # internal topology module instance
    #
    set object [ ilookup -d "" viewobject $id ]
    if { $object == "" } {
        #
        # viewobject not set, try to set it
        #
        set object [ topoSetViewObject $id $viewid ]
        if { $object == "" } {
            #
            # viewobject still not set, find out why
            #
            if { [ topoValidateView $viewid ] } {
                #
                # view is valid, just not yet loaded - do nothing since
                # default status is "ok - No status yet" 
                #
                ddl print info "topoGetAgentStatus: $viewid not yet loaded\n"
            } else {
                #
                # view is not valid and will not loaded - return error
                #
                ddl print info "topoGetAgentStatus: $viewid not found\n"
                agentStatusCallback $id [ list error "" "Group not found" ]
            }
            return

        } else {
            #
            # found view object, register status dependency
            #
            if { ![ registerViewDependency $object $id $url ] } {
                undefine viewobject $id
            }
        }
    }
                
    #
    # get status of the local topology module instance
    #
    if { [ toe_csend result $object topoGetStatusAndCounts ] } {
        ddl print warning "topoGetAgentStatus: $result\n"
        if { [ topoInitAgentView $id $url ] } {
            ddl print info "topoGetAgentStatus: initialized info for $id \n"
            return [ topoGetAgentStatus $id $url ]
        } else {
            agentStatusCallback $id [ list error "" "Failed to get status" ]
        }
    } else {
        agentStatusCallback $id $result
    }
    return
}

#####################################################################
#
# Method:  topoGetStatusAndCounts
#
# Purpose: Get the status of the current object
#
# Inputs:  none
#
# Output:  data "" { <status> <statuscounts> }  
#          error "" <reason>
#
#####################################################################
proc topoGetStatusAndCounts {} {
# ddl print info "topoGetStatusAndCounts: [ getModuleParam instanceName ]\n"
# ddl print info "topoGetStatusAndCounts: [ toe_name -full ]\n"
    if { [ catch { list [ statusOf _self ] [ getStatusDetail ] } result ] } {
        ddl print warning "topoGetStatusAndCounts: $result\n"
        return [ list error "" "Cannot obtain view status" ]
    } else {
        return [ list data "" $result ]
    }
}

#####################################################################
#
# Methods: topoSendDetailRequest 
#          topoSendStatusRequest
#          topoSendSnmpRequest
#          topoSendPingRequest
#
#          topoRemoveSnmpRequest
#
# Purpose: Methods to send various snmp and ping requests. Also
#          a method to remove snmp jobs from the job table.
#
#####################################################################
proc topoSendDetailRequest { id url } {
    lextract [ decomposeURL $url ] 0 scheme 1 net_loc 2 path 3 params 4 query 5 frag
    set detailURL [ buildURL $scheme $net_loc $path $params "topologydetail" $frag ]
    set osURL [ buildURL $scheme $net_loc "sym/base/info/system/os" "" "" "0" ]
    setParameters url [ list $detailURL $osURL ]
    set callback [ list [ list detailCallback "$id" %result ] ]
    if { [ catch { triggerCommandOrMethod detail "" $callback } result ] } {
        ddl print error "topoSendDetailRequest: entity=$id url=$url\n"
        ddl print error "topoSendDetailRequest: $result\n" 
    }
    clearParameters url
}

proc topoSendStatusRequest { id url } {
    set statusurl [ setURLQuery ${url} "status" ]
    set statcounturl [ setURLQuery ${url} "statusdetail" ]
    setParameters statusurl [ list $statusurl $statcounturl ]
    set callback [ list [ list agentStatusCallback $id %result ] ]
    if { [ catch { triggerCommandOrMethod agentStatus "" $callback } result ] } {
        ddl print error "topoSendStatusRequest: entity=$id url=$url\n"
        ddl print error "topoSendStatusRequest: $result\n" 
        agentStatusCallback $id [ list error "" "Cannot obtain agent status" ]
    }
    clearParameters statusurl
}

proc topoSendSnmpRequest { id url comm } {
    setParameters url $url community $comm
    set callback [ list [ list snmpPingCallback $id %result ] ]
    if { [ catch { triggerCommandOrMethod snmpPing "" $callback } result ] } {
        ddl print error "topoSendSnmpRequest: entity=$id url=$url community=$comm\n"
        ddl print error "topoSendSnmpRequest: $result\n"
        snmpPingCallback $id [ list error "" "Cannot establish SNMP connection" ]
    }
    clearParameters url community
}

proc topoSendPingRequest { id host } {
    setParameters host $host
    set callback [ list [ list icmpPingCallback $id %result ] ]
    if { [ catch { triggerCommandOrMethod icmpPing "" $callback } result ] } {
        ddl print error "topoSendPingRequest: entity=$id host=$host\n"
        ddl print error "topoSendPingRequest: $result\n"
        icmpPingCallback $id [ list error "" "Cannot establish ICMP connection" ]
    }
    clearParameters host
} 

proc topoRemoveSnmpRequest { id type } {
# ddl print info "topoRemoveSnmpRequest: $id $type\n"
    if { $type == "agentStatus" } {
        set viewid [ ilookup -d "" viewid $id ]
        set viewobject [ ilookup -d "" viewobject $id ]
        if { $viewid != "" } {
            undefine viewobject $id
            undefine viewid $id
            toe_csend result $viewobject removeDependency status [ toe_self ]
            return
        }
    }
 
    set callback [ list [ list ${type}Callback $id %result ] ]
    if { [ catch { evaluateCommand $type "" "" $callback } result ] } {
        ddl print error "topoRemoveSnmpRequest: entity=$id type=$type\n"
        ddl print error "topoRemoveSnmpRequest: $result\n"
    }
}

##################### Entity Management #############################

#######################################################################
#
# Method:  addEntity
#
# Purpose: Thin wrapper for addTopoEntity to ensure hostname and 
#          ipaddress are consistent and generate a description if 
#          necessary. 
#
#          This method services entity addition requests initiated 
#          from the console via the entityAdder node.
#
# Inputs:  spec - comprising a list containing the following:
#
#            - record detail (optional)
#            - standard and full descriptions (optional)
#            - the associated hostname/ipaddress (optional)
#            - the associated  netmask (optional)
#            - an architecture description (optional)
#            - the object family (may be determined)
#            - the topological type and config
#            - the isPolling indicator
#            - the polling type 
#            - the entity url
#
# Output:  "addok <id>"  for success 
#          "addfail"     for failure 
#          "addmax"      for failure due to maximum entity/group limit 
#          "addlicense"  for failure due to maximum object license limit 
#
#######################################################################
proc addEntity { spec } {

ddl print info "addEntity: $spec\n"
    #
    # extract the information
    #
    lextract $spec 0 record 1 desc 2 fulldesc 3 hostname 4 hostip \
                   5 netmask 6 arch 7 family 8 topotype 9 topoconfig \
                   10 isPoll 11 pollType 12 readinfo 13 writeinfo \
                   14 targhost 15 targip 16 url

    #
    # get the hostname and ipaddress
    #
    lextract [ getHostAndIp $hostip $url ] 0 hostname 1 ipaddress

    #
    # Generate an entity description if the user did not provide one.
    # Note that the ! prefix indicates continuous update, if necessary.
    #
    if { $desc == "" } {
        set desc [ URL2desc $url ]
        set desc "!$desc"
    }

    #
    # If no netmask was specified, and it is an agent type, use 255.255.255.255
    #
    if { $netmask == "" && [ isAgentPollType $pollType ] } {
        set netmask 255.255.255.255
    }

    return [ _addEntity "" $desc $fulldesc $hostname $ipaddress \
                        $netmask $arch $family $topotype $topoconfig \
                        $isPoll $pollType $readinfo $writeinfo \
                        $targhost $targip $url ]
}

#############################################################################
#
# Method:  _addEntity
#
# Purpose: Add an entity to a view
#
#          - validates entity spec
#          - adds entry to database
#          - initializes some dictionary data  
#          - if agent entity, trigger status and detail request
#          - refreshes view and info tables
#
# Inputs:  see addEntity
#
# Outputs: "addok <id>" if successful
#          "addfail" if failure
#          "addmax"      for failure due to maximum entity/group limit 
#          "addlicense"  for failure due to maximum object license limit 
#
#############################################################################
proc _addEntity { record desc fulldesc hostname ipaddress netmask arch \
                     family topotype topoconfig isPoll pollType readinfo \
                     writeinfo targhost targip url } {

    set instance [ getModuleParam instance ]
#    ddl print debug "_addEntity: $desc:$url into $instance\n"

    #
    # Confirm polling type/isPolled indicator
    #
    if { $pollType == "dummy" } {
        set isPoll "false"
    }

    #
    # Validate topotype information
    #
    if { ! [ isValidTopoType $topotype ] } {
        ddl print error "_addEntity: invalid topology type - $topotype\n"
        return "addfail"

    } elseif { [ isLinkTopoType $topotype ] && 
               ![ verifyLinkSpec $instance $topotype ] } {

        return "addfail"
    }

    #
    # add entity to the database
    #
    if { [ catch { topoDbTransBegin entity-create } result ] } {
        ddl print error "_addEntity: $result\n"
        return "addfail"
    }

    set desc [ getUniqueEntityDesc $instance $desc ]

    if { [ catch { topoDbEntityCreate $instance "" "" $desc $fulldesc \
                                      $hostname $ipaddress $netmask \
                                      $arch $record $family $topotype \
                                      $topoconfig $isPoll $pollType \
                                      $readinfo $writeinfo $targhost \
                                      $targip $url } entityid ] } {

        set code [ remapObjectCreateErrMsg $entityid ]
        return [ topoTransAbort _addEntity $entityid add${code} ]
    }

    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort _addEntity $result addfail ]
    }

    # entity successfully created to query this agents regards
    # the licensing of its modules
    toe_send [ locate .services.modquery ] "updateDatabaseModuleList 100"


    #
    # Since database changes have been committed, refresh topology license module
    #
    topoRefreshTopoObjectStatus

    #
    # initialize the entity status, rule info, etc.
    #
    initializeEntity $entityid $isPoll $pollType $url $hostname

    #
    # if agent polling, request detail information 
    #
    if { [ isAgentPollType $pollType ] } {
        topoSendDetailRequest $entityid $url
    }
    sendEntityStatusRequest $entityid $isPoll $pollType $url $readinfo

    #
    # refresh the datasets
    #
    topoRefreshViewAndInfo

    return [ list "addok" "$entityid" ]
}


#############################################################################
#
# Method:  removeEntities
#
# Purpose: Remove a set of logical entities from the topology table, 
#          according to the list of assigned object identifiers.  
#
# Inputs:  ids - list of ids of entities to remove 
#
# Outputs: "removeok"      - success
#          "removefail"    - failure
#          "removepartial" - partial removal
#
#  XXX - Need to handle attached adornments.
#
#############################################################################
proc removeEntities { ids pdu } {

    set instance [ getModuleParam instance ]
    set partial 0

    #
    # Begin the database transaction
    #
    if { [ catch { topoDbTransBegin entity-remove } result ] } {
        ddl print error "removeEntities: $result\n"
        return "removefail"
    }

    #
    # Remove them one by one.  The entity search algorithm gains nothing
    # by bulk operation, so this method should be efficient enough.
    #
    set rm_ids ""
    foreach id $ids {
        if { [ catch { removeEntity $instance $id $pdu } result ] } {
            return [ topoTransAbort removeEntities $result removefail ]
        }
        if { $result == 1 } {
            lappend rm_ids $id
        } elseif { $result == 0 } {
            set partial 1
        } 
    }

    #
    # Get a list of remaining entities
    #
    if { [ catch { topoDbEntityViewInfo $instance } entities ] } {
        return [ topoTransAbort removeEntities $entities removefail ]
    }

    #
    # Remove the connected link entities 
    #
    set rm_links ""
    foreach entity $entities {
        lextract $entity 0 id 5 topotype
        if { [ regexp {^link\|([^|]+)\|([^|]+)\|(.*)$} $topotype D apt zpt ] } {
            if { ( [ lsearch -exact $rm_ids $apt ] != -1 ) ||
                 ( [ lsearch -exact $rm_ids $zpt ] != -1 ) } {
                #
                # link endpoint was removed, remove link as well
                #
                if { [ catch { removeEntity $instance $id $pdu } result ] } {
                    return [ topoTransAbort removeEntities $result removefail ]
                }
                if { $result == 1 } {
                    lappend rm_links $id
                } elseif { $result == 0 } {
                    set partial 1
                }
            }
        }
    }

    #
    # Commit the changes to the database
    #
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort removeEntities $result removefail ]
    }

    #
    # Since the database changes have been committed, refresh topology license module
    #
    topoRefreshTopoObjectStatus
    
    #
    # check if anything was actually removed
    #
    if { $rm_ids != "" || $rm_links != "" || $partial } {
        # 
        # Remove status and rule information and snmp jobs
        # associated with the deleted entities and links
        #
        foreach id $rm_ids {
            unregisterEntity $id
        }

        foreach link $rm_links {
            unregisterEntity $link
        }

        deleteViewsAndEntities 

        #
        # Refresh the view and info tables
        #
        topoRefreshViewAndInfo
        topoSendViewStatusTrap
    }

    if { $partial } {
        ddl print debug "removeEntities: partial removal\n"
        return "removepartial"
    } else { 
        return "removeok"
    }
}

#############################################################################
#
# Method:  removeEntity
#
# Purpose: Delete an entity
#
# Inputs:  viewid
#          entityid
#          pdu
#
# Outputs: 1 - success
#          0 - failure
#         -1 - entity not found
#
# Notes:   Do not catch errors - the caller shall catch it
#
#############################################################################
proc removeEntity { viewid entityid pdu } {
    ddl print debug "removeEntity: $viewid $entityid\n"

    #
    # check if entity has a child view 
    #
    set childviewid [ topoDbEntityChildView $viewid $entityid ] 

    if { $childviewid == "notfound" } {
        #
        # entity not found
        #
        ddl print debug "removeEntity: ${viewid}:${entityid} not found\n"
        return -1
    } 

    if { $childviewid != "" } {
        #
        # entity has a child view
        #
        if { ![ deleteView $childviewid $pdu ] } {
            return 0
        }
    }

    #
    # delete the entity record
    #
    topoDbEntityDelete $viewid $entityid 

    return 1
}

#############################################################################
#
# Method:  unregisterEntity
#
# Purpose: Remove status and rule information and snmp jobs
#          associated with entity
#
# Inputs:  id
#
# Outputs: none
#
#############################################################################
proc unregisterEntity { id } { 

    undefine entityStatus $id
    undefine entityStatusCounts $id

    clearEntityStatusInfo $id

    topoRemoveSnmpRequest $id snmpPing
    topoRemoveSnmpRequest $id agentStatus
}

#############################################################################
#
# Method:  updateEntityViews
#
# Purpose: Update the topology representation information. 
#
# Inputs:  specs - list of lists of view update specs
#
# Outputs: "updateok" 
#          "updatefail" 
#
# Notes:   Blank values imply not change to the existing value.
#          All new values begin with "!".
#
#          This method supports updating multiple entities.  
#
#############################################################################
proc updateEntityViews { specs } {
 
    set instance [ getModuleParam instance ]
 
    if { [ catch { topoDbTransBegin entity-viewupd } result ] } {
        ddl print error "updateEntityViews: $result\n"
        return "updatefail"
    }
 
    foreach spec $specs {
        if { [ llength $spec ] != 7 } {
            return [ topoTransAbort updateEntityViews "bad spec - $spec" updatefail ]
        }
 
        if { [ catch { updateEntityView $instance $spec } result ] } {
            return [ topoTransAbort updateEntityViews $result updatefail ]
        }
    }
 
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort updateEntityViews $result updatefail ]
    }
 
    topoRefreshViewAndInfo
 
    return "updateok"
}

proc updateEntityView { instance spec } {
 
    lextract $spec 0 id 1 x 2 y 3 desc 4 family 5 config 6 ispoll
 
    set desc [ getUpdateEntityDesc $instance $id $desc ]

    topoDbEntityRepModify $instance $id $x $y $desc $family $config $ispoll
 
    set childview [ topoDbEntityChildView $instance $id ]
    if { $childview != "" } {
        topoDbViewModify $childview $desc "" "" "" "" "" $family
        topoUpdateModuleInstanceName $childview $desc
    }
}

#############################################################################
#
# Method:  topoUpdateModuleInstanceName
#
# Purpose: Update the 'instanceName' module parameter by updating it in
#          the following locations:
#
#          - param slice in module root object 
#          - module spec in .iso*base.mibman.modules object
#
# Inputs:  id   - viewid
#          name - instanceName
#
# Outputs: none
#
#############################################################################
proc topoUpdateModuleInstanceName { id name } {
    if { [ getModuleParam instance ] != $id } {
        set object [ locate .contexts.${id}*topology ]
        return [ toe_send $object topoUpdateModuleInstanceName $id $name ]
    } 

    if { [ string range $name 0 0 ] == "!" } {
        set name [ string range $name 1 end ]
        define param instanceName $name
        set param [ list [ list instanceName $name ] ]
        toe_send [ locateMibmanModules ] updateModuleParams topology+${id} $param
    }
}

proc locateMibmanModules {} {
    set object [ ilookup -d "" internal mibmanModules ]
    if { $object == "" } {
        set object [ locate .iso*base.mibman.modules ]
        define internal mibmanModules $object
    }
    return $object
}

#############################################################################
#
# Method:  updateEntityDetails
#
# Purpose: Update the topology detail information.
#
# Inputs:  specs  - entity update specs
#          delkey - optional flag indicating whether to delete entity's
#                   record key
#
# Outputs: "updateok" 
#          "updatefail" 
#
# Notes:   Blank values imply not change to the existing value.
#          All new values begin with "!".
#
#          This method supports updating a singly entity.  
#
#############################################################################
proc updateEntityDetails { spec { delkey "1" } } {
 
    set instance [ getModuleParam instance ]
 
    if { [ llength $spec ] != 19 } {
        ddl print error "updateEntityDetails: invalid spec - $spec\n"
        return "updatefail"
    }
 
    set id [ lindex $spec 0 ]
 
    #
    # save previous target info
    #
    lextract [ getEntityTarget $id ] 0 prevIsPolling 1 prevPollType \
                                     2 prevCommunity 3 prevUrl
 
    #
    # update the database
    #
    if { [ catch { topoDbTransBegin entity-detailupd } result ] } {
        ddl print error "updateEntityDetails: $result\n"
        return "updatefail"
    }
 
    if { [ catch { _updateEntityDetails $instance $spec $delkey } result ] } {
        return [ topoTransAbort updateEntityDetails $result updatefail ]
    }
 
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort updateEntityDetails $result updatefail ]
    }
 
    #
    # get new target info
    #
    lextract [ getEntityTarget $id ] 0 isPolling 1 pollType 2 community 3 url
 
    updateEntity $id $isPolling $pollType $community $url \
                 $prevIsPolling $prevPollType $prevCommunity $prevUrl
 
    sendEntityStatusRequest $id $isPolling $pollType $url $community
 
    topoRefreshViewAndInfo
    topoSendRefreshTrap
 
    return "updateok"
}

proc getUpdateHostAndIp { ip url } {
    set host ""
    if { [ string range $url 0 0 ] == "!" } { 
        set url [ string range $url 1 end ]
        set ip  [ string range $ip 1 end ]
        lextract [ getHostAndIp $ip $url ] 0 host 1 ip
        set host "!${host}"
        set ip "!${ip}"
    }
    return [ list $host $ip ]
}
 
proc _updateEntityDetails { instance spec delkey } {
 
    lextract $spec 0 id 1 desc 2 fulldesc 3 host 4 ip \
                   5 mask 6 arch 7 family 8 ispoll \
                   9 x 10 y 11 type 12 config 13 polltype \
                   14 readinfo 15 writeinfo 16 targethost \
                   17 targetip 18 targeturl

    lextract [ getUpdateHostAndIp $ip $targeturl ] 0 host 1 ip
    set desc [ getUpdateEntityDesc $instance $id $desc ]

    topoDbEntityDetailModify $instance $id $desc $fulldesc $host $ip \
                   $mask $arch $family $ispoll $x $y $type $config \
                   $polltype $readinfo $writeinfo $targethost $targetip \
                   $targeturl
 
    set childview [ topoDbEntityChildView $instance $id ]
    if { $childview != "" } {
        topoDbViewModify $childview $desc $fulldesc $host $ip $mask \
                         $arch $family
        topoUpdateModuleInstanceName $childview $desc
    }

    if { $delkey } {
        topoDbEntityDelKey $instance $id
    }
}

#############################################################################
#
# Method:  pasteElements
#
# Purpose: Support copy-paste and copy-paste-cut operations, depending 
#          on the input spec.  
#
# Inputs:  spec - <cuturl> <entities> <adornments> 
#          pdu  -
#
# Outputs: pasteok          - success
#          pastefail        - failure
#          pastemax         - failure
#          pastelicense     - failure
#          pastecircular    - failure - circular relationship
#          pastecutunknown  - failure - cut url not found
#          pastecutnoaccess - failure - no access to perform cut 
#
# Notes:   The <cuturl> specifies the url of the view from which to delete 
#          the entities/adornments.
#          If the <cuturl> is blank, it implies a copy-paste operation.
#
#          Adornments not currently handled
#
#############################################################################
proc pasteElements { spec pdu } {

    ddl print debug "pasteElements: $spec\n"

    set viewid [ getModuleParam instance ]

    #
    # validate the paste specification
    #
    if { [ catch { lextract $spec 0 cuturl 1 entities 2 adornments } ] } { 
        ddl print error "pasteElements: invalid paste specification - $spec\n"
        return "pastefail"
    }

    #
    # if url is not blank, get the viewid from which the entities are to
    # be cut 
    # 
    if { $cuturl != "" } {
        #
        # extract the cut viewid
        #
        if { [ catch { URL2LocalViewId $cuturl } cutviewid ] } { 
            ddl print error "pasteElements: invalid cut url - $cuturl\n"
            ddl print error "pasteElements: $cutviewid\n"
            return "pastefail"
        }

        #
        # check cut viewid
        #
        if { $cutviewid == "" } {
            ddl print error "pasteElements: invalid cut url - $cuturl\n"
            ddl print error "pasteElements: failed to locate cut object\n"
            return "pastecutunknown"
        }

        #
        # verify that the view exists and check access control for the
        # view 
        #
        if { [ catch { checkViewUnloadAccess $pdu $cutviewid } result ] } {
            ddl print error "pasteElements: failed to locate topology module\n"
            ddl print error "pasteElements: $result\n"
            return "pastefail"
        }

        if { $result == "0" } {
            ddl print error "pasteElements: insufficient privilege to cut entity\n"
            return "pastecutnoaccess"
        }

        set cutviewobject [ locate .contexts.${cutviewid}*topology ]

    } else {
        set cutviewid ""
        set cutviewobject ""
    }

    #
    # start the transactions
    #
    if { [ catch { topoDbTransBegin element-paste } result ] } {
        ddl print error "pasteElements: $result\n"
        return "pastefail"
    }

    undefine entityidRemap

    set links ""

    #
    # process the entities
    #
    foreach entity $entities {
        lextract $entity 0 oldid 10 topotype 

        #
        # validate topotype
        #
        if { ! [ isValidTopoType $topotype ] } {
            set msg "invalid entity topology type - $topotype"
            return [ topoTransAbort pasteElements $msg pastefail ]
        }

        if { [ isLinkTopoType $topotype ] } {
            #
            # do not paste links yet, save them up
            #
            lappend links $entity
            continue
        }

        if { [ catch { pasteElement $viewid $entity $cutviewid } entityid ] } { 
            set code [ remapObjectCreateErrMsg $entityid ]
            return [ topoTransAbort pasteElements $entityid paste${code} ]
        }
        define entityidRemap $oldid $entityid
    }

    #
    # process the links
    #
    foreach link $links {
        lextract $link 0 oldid 10 topotype 
        set newtopotype [ remapLinkSpec $topotype ]
        if { $newtopotype != "" } {
            set link [ lreplace $link 10 10 $newtopotype ] 
            if { [ catch { pasteElement $viewid $link $cutviewid } entityid ] } {
                set code [ remapObjectCreateErrMsg $entityid ]
                return [ topoTransAbort pasteElements $entityid paste${code} ]
            }
            define entityidRemap $oldid $entityid
        }
    }

    #
    # commit changes to the database
    #
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort pasteElements $result pastefail ]
    }

    #
    # Since database changes have been committed, refresh topology license module
    #
    topoRefreshTopoObjectStatus


    set waitEntities {}

    foreach entity $entities {
        lextract $entity 0 oldid 12 isPoll 13 pollType 14 targetcomm 18 targeturl
        set newid [ lookup -d "" entityidRemap $oldid ]

        if { $newid == "" } {
            continue
        }

        #
        # initialize pasted entities
        #
	lextract $entity 5 hostname

        initializeEntity $newid $isPoll $pollType $targeturl $hostname
        if { [ isAgentPollType $pollType ] } {
            topoSendDetailRequest $newid $targeturl 
            lappend waitEntities $newid
        }
        sendEntityStatusRequest $newid $isPoll $pollType $targeturl $targetcomm

        #
        # if paste-cut, unregister entities in cut view
        #
        if { $cutviewobject != "" } {
            toe_send $cutviewobject unregisterEntity $oldid
        }
    }

    undefine entityidRemap
 
    #
    # refresh the view and info tables
    #
    deferRefreshViewAndInfo 7 $waitEntities

    #
    # if paste-cut, refresh the cut view
    #
    if { $cutviewobject != "" } {
        toe_send $cutviewobject topoRefreshViewAndInfo
    }

    return "pasteok"
}

########################################################################
#
# Method:  remapLinkSpec
#
# Purpose: Remap a pasted link spec using the 'entityidRemap' slice.  
#
# Inputs:  spec - original link spec referencing entities in source view
#
# Outputs: newspec - new link spec referencing entities in destination view
#          "" - if endpts not found in source view
#
########################################################################
proc remapLinkSpec { spec } {
    set endpts [ extractLinkEndPoints $spec ]
    if { $endpts == "" } {
        return ""
    }

    set result "link|"
    foreach endpt $endpts {
        set match 0
        sliceforeach oldid newid entityidRemap {
            if { $endpt == $oldid } {
                set match 1
                break
            }
        }

        if { $match } {
            append result "$newid|"
        } else {
            return ""
        }
    }
    return $result
}

########################################################################
#
# Method:  pasteElement
#
# Purpose: Paste an entity record into a view. Delete entity in cut 
#          viewid if specified and reconnect entity views if necessary.
#
# Inputs:  viewid
#          entityspec
#          cutviewid
#
# Outputs: entityid
#
# Notes:   Errors are not caught - the caller should catch errors.   
#          Access control for the cut operation should be checked 
#          by the caller.
#
########################################################################
proc pasteElement { viewid entityspec cutviewid } {
    
    lextract $entityspec 0 oldentityid 3 desc 4 fulldesc 5 hostname \
                         6 hostip 7 netmask 8 arch 9 family 10 topotype \
                         11 topocfg 12 ispoll 13 polltype 14 readinfo \
                         15 writeinfo 16 targethost 17 targetip 18 targeturl


    #
    # check for circular relationships
    #
    set targetviewid [ URL2LocalViewId $targeturl ] 
    if { $targetviewid != "" } {
        if { [ topoDbViewInfo $targetviewid ] == "notfound" } {  
            # Do we allow this, or not...
            error "$targetviewid no longer exists"
        } elseif { [ isChildViewTarget $targetviewid $viewid ] } {
            return [ error "circular relationship between $viewid and $targetviewid"  ]
        }
    }


    #
    # create the entity record, set blank x/y position
    #
    set desc [ getUniqueEntityDesc $viewid $desc ]

    set entityid [ topoDbEntityCreate $viewid "" "" $desc $fulldesc \
                           $hostname $hostip $netmask $arch "" \
                           $family $topotype $topocfg $ispoll \
                           $polltype $readinfo $writeinfo $targethost \
                           $targetip $targeturl ] 

    # entity successfully created to query this agents regards
    # the licensing of its modules
    toe_send [ locate .services.modquery ] "updateDatabaseModuleList 100"

    #
    # if paste-cut operation, cut entity and reconnect if necessary
    #
    if { $cutviewid != "" } {
        #
        # check if entity has a child view
        #
        set childviewid [ getEntityChildView $cutviewid $oldentityid ]
        if { $childviewid != "" } {
            #
            # disconnect child view from old entity and 
            # reconnect it with new entity 
            #
            topoDbViewDisconnect $childviewid
            topoDbViewConnect $childviewid $viewid $entityid 
        }

        #
        # delete the entity in the cut view 
        #
        topoDbEntityDelete $cutviewid $oldentityid 
    }
    return $entityid
}

proc URL2LocalViewId { url } {
    set id ""
    lextract [ decomposeURL $url ] 0 scheme 1 address 2 spec
    if { $scheme == "snmp" && $address == [ snmp get address ] } {
        set parts [ split $spec "/+" ]
        if { [ lindex $parts 1 ] == "topology" } {
            set id [ lindex $parts 2 ] 
        }
    }
    return $id
}  
    
proc getLocalTargetViewIds { viewid } {
    set result ""
    foreach target [ topoDbEntityTargetInfo $viewid ] {
        set id [ URL2LocalViewId [ lindex $target 6 ] ] 
        if { $id != "" } {
            lappend result $id
        }
    }
    return $result
}

proc isChildViewTarget { targetviewid viewid } {
    if { $targetviewid == $viewid } {
        return 1
    }
    foreach target [ getLocalTargetViewIds $targetviewid ] { 
        if { [ isChildViewTarget $target $viewid ] } { 
            return 1
        }
    }
    return 0
}

proc getEntityChildView { viewid entityid } {
    set childviewid [ topoDbEntityChildView $viewid $entityid ]
    if { $childviewid == "notfound" } {
        return ""
    }
    return $childviewid
} 

####################### Data Request Management #############################

#############################################################################
#
# Method:  refreshViewProperties
#
# Purpose: Retrieve the view property information from the database
#
# Input:   none
#
# Output:  view property data
#          "" if not available
#
#############################################################################
proc refreshViewProperties {} {

    #
    # the module instance is the key to the view property data 
    #
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbViewInfo $instance } result ] } {
        #
        # ignore database error, just print a diagnostic message.
        #
        ddl print debug "refreshViewProperties: failed to get data for $instance\n"
        ddl print debug "refreshViewProperties: $result\n" 
        return ""
    }

    #
    # if view information is really not in the database, unload the module.
    #
    if { $result == "notfound" } {
        registerOneShot 0 [ list ClassModule:moduleAction unload ]
        return ""
    }

    return $result
}

#############################################################################
#
# Method:  refreshEntityStatus
#
# Purpose: Refresh the entity status table.  
#
# Input:   none
#
# Output:  list of entity ids and status
#
#############################################################################
proc refreshEntityStatus {} {
#    ddl print debug "refreshEntityStatus: [ getModuleParam instance ]\n"
    return [ toe_send [ getModuleRoot ] getEntityStatusList ]
}

#############################################################################
#
# Method:  getEntityStatusList
#
# Purpose: Lookup the entity status.  
#
# Input:   none
#
# Output:  list of entity ids and status
#
#############################################################################
proc getEntityStatusList {} {
    undefine internal pendingRefresh
    set datalist ""
    sliceforeach entity status entityStatus {
        lappend datalist $entity $status
    }
    return $datalist
}

#############################################################################
#
# Method:  initializeEntities
#
# Purpose: Initialize the entities in module's entity list by 
#          setting its rule info and status. This is invoked
#          when the module is activated.
#
# Input:   none
#
# Output:  none
#
#############################################################################
proc initializeEntities {} {
    if { ![ ilookup -d "0" internal initEntities ] } {
        define internal initEntities 1

        foreach target [ getEntityTargets ] {
            lextract $target 0 id 2 isPolling 3 pollType 6 url 7 hostname
            initializeEntity $id $isPolling $pollType $url $hostname
        }
    }
}

#############################################################################
#
# Method:  initializeEntity
#
# Purpose: Initialize an entity by setting its rule info and status
#
# Input:   id
#          isPolling
#          pollType
#          url
#
# Output:  none
#
#############################################################################
proc initializeEntity { id isPolling pollType url hostname} {

    setEntityStatusInfo $id $url
    if { $hostname != "" } {
        define entityHost $id $hostname
    }
    
    initializeEntityStatus $id $isPolling $pollType
    if { $pollType == "aview" } {
        topoInitAgentView $id $url
    }
}

#############################################################################
#
# Methods: setEntityStatusInfo
#          clearEntityStatusInfo
#          
# Purpose: Cache the host and agent info for the entity status messages,
#          making sure that we convert any ip addresses 1st
#
# Inputs:  id
#          url
#
# Outputs: none
#
#############################################################################
proc setEntityStatusInfo { id url } { 
    set parts [ split $url ":/" ]

    set host [ lindex $parts 3 ]
    set port [ lindex $parts 4 ]

#    if { $host != "" } {
#         if { ![ catch {ip2host $host} result ] } {
#	    set host $result
#	}
#    } else {
#        set host "Invalid host"
#    }
    if { $host == "" } {
        set host "Invalid host"
    }

    define entityHost $id $host
    define entityPort $id $port

    return
}

proc clearEntityStatusInfo { id } { 
    undefine entityHost $id 
    undefine entityPort $id 
}

#############################################################################
#
# Method:  initializeEntityStatus
#
# Purpose: Set an entity's default status
#
# Inputs:  id
#          isPolling
#          pollType
#
# Outputs: none
#
#############################################################################
proc initializeEntityStatus { id isPolling pollType } {

    if { $pollType == "dummy" || $isPolling != "true" } {
        setEntityStatusAndCounts $id ok "Not being monitored"
    } else {
        setEntityStatusAndCounts $id ok "No status yet"
    }
}

proc updateEntity { id isPolling pollType community url \
                    prevIsPolling prevPollType prevCommunity prevUrl } {

    #
    # if previously actively snmp or agent polling, check if
    # the previous snmp jobs have to be removed  
    #
    if { $prevIsPolling == "true" && 
       ( $prevPollType == "snmp" || [ isAgentPollType $prevPollType ] ) } {    

        #
        # polling has been turned off, url has changed, or 
        # community has changed, remove old job
        #
        if { $isPolling == "false" || $url != $prevUrl ||
             $prevCommunity != $community } {

            clearEntityStatusInfo $id 

            if { [ isAgentPollType $prevPollType ] } { 
                topoRemoveSnmpRequest $id agentStatus
            } elseif { $prevPollType == "snmp" } {
                topoRemoveSnmpRequest $id snmpPing
            }
        }
    }

    setEntityStatusInfo $id $url
    updateEntityStatus $id $isPolling $pollType
    if { $pollType == "aview" } {
        topoInitAgentView $id $url
    }
}

proc updateEntityStatus { id isPolling pollType } {
    if { $pollType == "dummy" || $isPolling != "true" } {
        setEntityStatusAndCounts $id ok "Not being monitored"

    } elseif { [ lookup -d "" entityStatus $id ] == "" } {
        setEntityStatusAndCounts $id ok "No status yet"
    }
}

#############################################################################
#
# Method:  getEntityStatus
#          getEntityStatusCounts
#
# Purpose: Retrieve entity status or counts
#
# Inputs:  id
#
# Outputs: status or counts
#
#############################################################################
proc getEntityStatus { id } {
    return [ lookup -d "internal\tok\tNo status yet" entityStatus $id ]
}

proc getEntityStatusCounts { id } {
    return [ lookup -d "0 0 0 0 0 0 0 0 0" entityStatusCounts $id ]
}

#############################################################################
#
# Method:  setEntityStatusAndCounts
#
# Purpose: Set entity status and counts and refresh the entityView table
#
# Inputs:  id
#          state
#          info
#
# Outputs: none
#
#############################################################################
proc setEntityStatusAndCounts { id state info } {

#    ddl print debug "setEntityStatusAndCounts: $id $state $info\n"

    set prevStatus [ ilookup -d "" entityStatus $id ]
    set status "internal\t${state}\t${info}"
    if { $prevStatus == $status } {
        return
    }

    define entityStatus $id $status

    switch $state \
   	{ok} {
            set counts "0 0 0 0 0 0 0 0 0"
        } \
   	{ack} {
            set counts "1 0 0 0 0 0 0 0 0"
        } \
        {down} {
            set counts "0 1 0 0 0 0 0 0 0"
        } \
   	{error} - {error-dn} {
            set counts "0 0 1 0 0 0 0 0 0"
        } \
        {warning} {
            set counts "0 0 0 1 0 0 0 0 0"
        } \
        {info} {
            set counts "0 0 0 0 1 0 0 0 0"
        } \
   	{irr} {
            set counts "0 0 0 0 0 1 0 0 0"
        } \
        {disabled} {
            set counts "0 0 0 0 0 0 1 0 0"
        } \
   	{off} {
            set counts "0 0 0 0 0 0 0 1 0"
        } \
        {prf} {
            set counts "0 0 0 0 0 0 0 0 1"
        } \
        default {
            ddl print warning "setEntityStatusAndCounts: [ toe_name -full ]\n"
            ddl print warning "setEntityStatusAndCounts: unknown $state for $id\n"
            set counts "0 0 0 0 0 0 0 0 0"
        }

    define entityStatusCounts $id $counts

    deferRefreshViewTable 2
    return

}

#############################################################################
#
# Method:  deferRefreshViewTable
#
# Purpose: Refresh the entityViewTable.entityViewEntry object in N seconds 
#          and set a flag to indicate that a refresh is pending.
#
# Input:   delay - seconds
#
#############################################################################
proc deferRefreshViewTable { delay } {

    if { ! [ ilookup -d 0 internal pendingRefresh ] } {
        define internal pendingRefresh 1
        registerOneShot $delay topoRefreshViewTable
    }
}

#############################################################################
#
# Method:  deferRefreshViewAndInfo
#
# Refresh the view and info tables now, but defer sending a refresh trap for
# N seconds, or until the last pending detail request is received.
#
# Input: delay in seconds, entities to wait for.
#
#############################################################################

proc deferRefreshViewAndInfo { delay entities } {
    if { $entities == {} && [ entries pendingDetail ] == {} } {
        topoRefreshViewAndInfo
        return
    }
    foreach entity $entities {
        define pendingDetail $entity true
    }
    topoRefreshViewTable
    topoRefreshInfoTable
    if { [ ilookup -d "" internal pendingRefreshTrap ] == "" } {
        define internal pendingRefreshTrap [ registerOneShot $delay _sendRefreshTrap ]
    }
}

proc _sendRefreshTrap {} {
    undefine internal pendingRefreshTrap
    undefine pendingDetail
    topoSendRefreshTrap
}

#############################################################################
#
# Method:  expediteRefreshTrap
#
# Send a pending refresh trap immediately if all pending detail requests
# are in.
#
# Input: entity id of detail response received.
# 
#############################################################################

proc expediteRefreshTrap { entity } {
    undefine pendingDetail $entity
    if { [ entries pendingDetail ] != {} } {
        return
    }
    set timer [ ilookup -d "" internal pendingRefreshTrap ]
    if { $timer != "" } {
        cancelOneShot $timer
        undefine internal pendingRefreshTrap
    }
    topoSendRefreshTrap
}
  

#############################################################################
#
# Method:  refreshEntityDetails
#
# Purpose: Update the view detail information (from the database)
#
#############################################################################
proc refreshEntityDetails {} {
    return [ topoDbEntityDetailInfo [ getModuleParam instance ] ]
}

#############################################################################
#
#  Handle the detail update request
#
#############################################################################
proc detailTimerCallback {} {
    ddl print debug "detailTimerCallback: [ getModuleParam instance ]\n"
    set stagger [ lookup -d 0 value detailStagger ]
    set interval 0
    foreach target [ getEntityTargets ] {
        lextract $target 0 id 2 isPolling 3 pollType 6 url
        if { [ isAgentPollType $pollType ] && $isPolling == "true" } {
	    if { $stagger } {
		registerOneShot [ incr interval $stagger ] [
		    list topoSendDetailRequest $id $url
		]
	    } else {
		topoSendDetailRequest $id $url
	    }
        }
    }
}

#############################################################################
#
#  Handle incoming topology detail information
#
#############################################################################
proc detailCallback { id result } {
    set instance [ getModuleParam instance ]
#    ddl print debug "detailCallback: $instance:$id -> $result\n"

    switch -- [ lindex $result 0 ] {
        {wait} {
            # Not a problem
        }
        {error} {
            # Not much can be done here.  Show what is currently available
            # (fallback mode).
        }
        {update} -
        {data} {
            lextract [ lindex $result 2 ] 0 info 1 os 

            #
            # Save the detail information in the database
            #
            if { [ setEntityDetail $instance $id $info $os ] == "true" } {
                topoRefreshInfoTable
                expediteRefreshTrap $id
            }
        }
    }
}

#############################################################################
#
# Push the detail information into the database
#
#############################################################################
proc setEntityDetail { instance id info os } {

    if { [ llength $info ] != 7 } { 
        ddl print debug "setEntityDetail: $instance $id info=<$info>\n"
        return false
    }

    #
    # ignore patchlevel part of os
    #
    set os [ lindex [ split $os "," ] 0 ]

    lextract $info 0 desc 1 fulldesc 2 family 3 eventdest 4 trapdest \
                   5 branch 6 attr

    if { [ catch { topoDbTransBegin detail-update } result ] } {
        ddl print error "setEntityDetail: $result\n"
        return false
    }

    set desc [ getUpdateEntityDesc $instance $id $desc ]

    if { [ catch { topoDbEntityTargetModify $instance $id $desc \
                              $fulldesc $family $branch $attr \
                              $eventdest $trapdest $os } flag ] } {
        return [ topoTransAbort setEntityDetail $flag false ]
    }

    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort setEntityDetail $result false ]
    }

    return $flag 
}

#############################################################################
#
# Method:  getEntityTargets
#
# Purpose: Get the entities and their corresponding target information
#
# Inputs:  none
#
# Outputs: lists of list of target info for each entity 
#          { id eventDest isPolling pollType needDetail community url }
#
#############################################################################
proc getEntityTargets {} {
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbEntityTargetInfo2 $instance } targets ] } {
        ddl print error "getEntityTargets: failed to get target info for $instance\n"
        ddl print error "getEntityTargets: $targets\n"
        return ""
    }
    return $targets
}

proc getTargetsByPollType { polltype } {
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbEntityTargetByPollType $instance $polltype } targets ] } {
        ddl print error "getTargetsByPollType: failed to get target info for $instance\n"
        ddl print error "getTargetsByPollType: $targets\n"
        return ""
    }
    return $targets
}


proc getEntityTarget { id } {
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbEntityInfo $instance $id } info ] } {
        ddl print error "getEntityTarget: failed to get target info for $instance/$id\n"
        ddl print error "getEntityTarget: $target\n"
        return [ list "" "" "" "" ]
    }

    set info [ join $info ]
    if { [ llength $info ] == 20 } {
        lextract $info 12 isPolling 13 pollType 15 community 19 url
        return [ list $isPolling $pollType $community $url ]
    } else {
        return [ list "" "" "" "" ]
    }
}

#########################################################################
#
# Method:  agentStatusTimerCallback
#          snmpPingTimerCallback
#          icmpPingTimerCallback
#
# Purpose: Sends a status request for each agent entity
#          Sends an snmp ping request for each snmp entity
#          Sends an icmp ping request for each ping entity
#
# Inputs:  none
#
# Outputs: none
#
#########################################################################
proc agentStatusTimerCallback {} {

    ddl print debug "agentStatusTimerCallback: [ getModuleParam instance ]\n"
    foreach target [ getTargetsByPollType a ] {
        lextract $target 0 id 2 url
	topoGetAgentStatus $id $url
    } 
}

proc snmpPingTimerCallback {} {

    ddl print debug "snmpPingTimerCallback: [ getModuleParam instance ]\n"
    foreach target [ getTargetsByPollType snmp ] {
        lextract $target 0 id 1 community 2 url
        topoSendSnmpRequest $id $url $community 
    } 
}

proc icmpPingTimerCallback {} {

    ddl print info "icmpPingTimerCallback: [ getModuleParam instance ]\n"
    foreach target [ getTargetsByPollType ping ] {
        lextract $target 0 id 2 url
        set host [ URL2host $url ]
        if { $host != "" } {
            topoSendPingRequest $id $host
        } else {
            setEntityStatusAndCounts $id irr "Invalid host/URL specification"
        }
    } 
}

proc sendEntityStatusRequest { id isPolling pollType url community } {
#    ddl print debug "sendEntityStatusRequest: $id $isPolling $pollType $url $community\n"      
    if { $isPolling == "true" } {
        if { $pollType == "ping" } {
            set host [ URL2host $url ]
            if { $host != "" } {
                topoSendPingRequest $id $host
            } else {
                setEntityStatusAndCounts $id irr "Invalid host/URL specification"
            }
        } elseif { $pollType == "snmp" } {
            topoSendSnmpRequest $id $url $community 
        } elseif { [ isAgentPollType $pollType ] } {
            topoGetAgentStatus $id $url 
        } else {
            ddl print warning "sendEntityStatusRequest: unknown pollType $pollType for $id\n"      
        }
    }
}


#########################################################################
#
# Method:  agentStatusCallback
#          snmpPingCallback
#          icmpPingCallback
#
# Purpose: Handle responses to the icmp ping, snmp ping and agent status
#          requests
#
# Inputs:  id  - entity id
#          arc - asynchronous return code { type tid data } 
#
# Outputs: none
#
#########################################################################
proc icmpPingCallback { id arc } {

    switch -- [ lindex $arc 0 ] \
        {wait} {
            return
        } \
        {error} {
            setEntityStatusAndCounts $id irr [ lindex $arc 2 ]
        } \
        {update} - {data} {
            if { [ lindex $arc 2 ] == "up" } {
                setEntityStatusAndCounts $id ok "Host is alive"
            } else {
                set host [ ilookup -d "" entityHost $id ]
                setEntityStatusAndCounts $id down "Host $host not responding"
            }
        }
}

proc snmpPingCallback { id arc } {

    switch -- [ lindex $arc 0 ] \
        {wait} {
            return
        } \
        {error} {
            set msg [ lindex $arc 2 ]
            if { $msg == "" } {
                set msg [ lindex $arc 1 ]
            }
            lextract [ remapSnmpPingErrorMessage $id $msg ] 0 state 1 msg 
            setEntityStatusAndCounts $id $state $msg
        } \
        {update} - {data} {
            #
            # if data is blank, snmp job was just removed
            # do not set entity status
            #
            if { [ ilookup -d "" entityHost $id ] == "" && 
                 [ lindex $arc 2 ] == "" } {
                return
            }

            setEntityStatusAndCounts $id ok "Agent is alive"
        }
}

#
#  Handle incoming agent status requests
#
proc agentStatusCallback { id arc } {

#ddl print debug "agentStatusCallback: $id - $arc\n"

    switch -- [ lindex $arc 0 ] \
        {wait} {
            return
        } \
        {error} {
            set msg [ lindex $arc 2 ]
            if { $msg == "" } {
                set msg [ lindex $arc 1 ]
            }
            lextract [ remapAgentStatusErrorMessage $id $msg ] 0 state 1 msg 
            setEntityStatusAndCounts $id $state $msg
        } \
        {update} - {data} {
            #
            # if data is blank, snmp job was just removed
            # do not set entity status
            #
	    set data [ lindex $arc 2 ]
            if { [ ilookup -d "" entityHost $id ] == "" && $data == "" } {
                return
            }

            #
            # get previous state and counts
            #
            set prevState [ getPrevState $id ]
	    set prevCounts [ getEntityStatusCounts $id ]

	    #
            # Validate the returned data
	    #
	    if { [ llength $data ] != 2 } {
		ddl print debug "agentStatusCallback: invalid data <$data>\n"
                setEntityStatusAndCounts $id irr "Invalid status information"
		set state "irr"
                set statusCounts [ getEntityStatusCounts $id ]

	    } else {

	        lextract $data 0 status 1 statusCounts
 
                set parts [ split $status "\t" ]
                if { [ llength $parts ] == 11 } {

                    define entityStatus $id "$status"
	            define entityStatusCounts $id $statusCounts
                    deferRefreshViewTable 2

		    set code [ lindex $parts 0 ] 
		    if { [ string range $code 0 0 ] == "*" } {
                        set state ack
                    } else {
		        set state [ lookup -d $code remap [ string range $code 1 3 ] ]
                    }

                } else {
		    ddl print debug "agentStatusCallback: invalid agent status <$status>\n"
                    setEntityStatusAndCounts $id irr "Invalid status information"
		    set state "irr"
                    set statusCounts [ getEntityStatusCounts $id ]
                }
            }

	    if { $statusCounts != $prevCounts && $state == $prevState } {
		ddl print debug "agentStatusCallback: alarm counts changed, sending status trap\n"
                #
                # refresh view table before sending trap
                #
		topoRefreshViewTable
                topoSendViewStatusTrap
	    }
        }
}

proc getPrevState { id } {
    set object [ locate entityViewTable.entityViewEntry.entityStatus ]
    return [ toe_send $object lookup -d "" alarmstatus $id ]
}

######################################################################
#
# Method:  remapSnmpPingErrorMessage
#          remapAgentStatusErrorMessage
#
# Purpose: Remap an snmp error response to a state and message 
#
# Input:   snmp error message
#
# Outputs: <state> <message>
#
######################################################################
proc remapSnmpPingErrorMessage { id message } {
    switch $message \
        {Module Not Responding} - \
        {Data Query Error} - \
        {Access Denied} - \
        {Operation Failed} - \
        {Unknown security name} - \
        {Wrong authentication key} - \
        {Unsupported security level} - \
        {Unauthorized operation} {
            return [ list ok "Agent is alive" ]
        } \
        {Agent Not Responding} {
            set host [ ilookup -d "" entityHost $id ]
            set port [ ilookup -d "" entityPort $id ]


            set desc [ getRowValue entityInfoTable.entityInfoEntry.entityDesc $id ]
            set name "Agent"
            if { [regexp {base.console.ConsoleTopology:domain.defaultdomain.(.*$)} $desc dummy comp ] } {
                set name [ lookup -d "Agent" value .config.${comp}.description ]
            }

            return [ list error-dn "$name on host $host, port $port not responding" ]

        } \
        {Host Not Responding} {
            set host [ ilookup -d "" entityHost $id ]
            return [ list down "Host $host not responding" ]
        } \
        {Unknown Host} {
            set host [ ilookup -d "" entityHost $id ]
            return [ list irr "Unknown host $host" ]
        } \
        default {
            return [ list irr "$message" ]
        }
}

proc remapAgentStatusErrorMessage { id message } {
    switch $message \
        {Agent Not Responding} {
            set host [ ilookup -d "" entityHost $id ]
            set port [ ilookup -d "" entityPort $id ]
            set desc [ getRowValue entityInfoTable.entityInfoEntry.entityDesc $id ]
            set name "Agent" 
            if { [regexp {base.console.ConsoleTopology:domain.defaultdomain.(.*$)} $desc dummy comp ] } {
                set name [ lookup -d "Agent" value .config.${comp}.description ]
            }

            return [ list error-dn "$name on host $host, port $port not responding" ]
        } \
        {Host Not Responding} {
            set host [ ilookup -d "" entityHost $id ]
            return [ list down "Host $host not responding" ]
        } \
        {Module Not Responding} {
            return [ list irr "Module not responding" ]
        } \
        {Data Query Error} {
            return [ list irr "Data query error" ]
        } \
        {Access Denied} {
            return [ list error "Access denied" ]
        } \
        {Operation Failed} {
            return [ list irr "Operation failed" ]
        } \
        {Unknown Host} {
            set host [ ilookup -d "" entityHost $id ]
            return [ list irr "Unknown host $host" ]
        } \
        default {
            return [ list irr "$message" ]
        }
}

#
##################### Adornment Management #############################
#

#
#  Add adornment information.  Data is the adornment type and the
#  configuration data.  Returns "addok" or "addfail" depending on
#  the outcome of the add.
#
proc addAdornment { param } {
    # Adornment add parameters are the position, type and configuration
    lextract $param 0 x 1 y 2 type 3 config
    ddl print debug "adding \[$type:$config\] to topology adornment list\n"

    # Push it into the database
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbTransBegin adorn-create } result ] } {
        ddl print error "Adornment add error $result\n"
        return "addfail"
    }
    if { [ catch { topoDbAdornmentCreate $instance $x $y $type $config } result ] } {
        return [ topoTransAbort addAdornment $result addfail ]
    }
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort addAdornment $result addfail ]
    }

    # And refresh the dataset
    topoRefreshValueAndTrap

    return "addok"
}

#
#  Update the adornment x/y/configuration information.  The type cannot
#  be modified.  Returns "updateok" or "updatefail" depending on the
#  outcome of the modify.
#
proc updateAdornments { updateInfo } {
    # Open the transaction
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbTransBegin adorn-modify } result ] } {
        ddl print error "Adornment modify error $result\n"
        return [ list "updatefail" ]
    }

    # Handle each of the updates.  Note that the update method does
    # not take the set as a whole, but handles one modification at a 
    # time.  This overhead is irrelevant due to the database lookup
    # model.
    set paramChanged false
    foreach update $updateInfo {
        if { [ llength $update ] != 4 } {
            return [ topoTransAbort updateAdornments "invalid spec - $update" updatefail ]
        }
        lextract $update 0 id 1 newx 2 newy 3 newconfig

        if { [ catch { topoDbAdornmentModify $instance $id $newx $newy $newconfig } result ] } {
            return [ topoTransAbort updateAdornments "$result" updatefail ]
        }
    }

    # Commit the update
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort updateAdornments "$result" updatefail ]
    }

    # And refresh the dataset
    topoRefreshValueAndTrap

    return "updateok"
}

#
#  Remove the adornment information according to the list of
#  assigned identifiers.  Returns "removeok" or "removefail" 
#  depending on the outcome.
#
proc removeAdornments { ids } {
    # Open the transaction
    set instance [ getModuleParam instance ]
    if { [ catch { topoDbTransBegin adorn-remove } result ] } {
        ddl print error "Adornment removal error $result\n"
        return "removefail"
    }

    # Remove them one by one.  See update note above regarding the
    # efficiency of the single delete database method.
    foreach id $ids {
        ddl print debug "removing \[$id\] from adornment list\n"
        if { [ catch { topoDbAdornmentDelete $instance $id } result ] } {
            return [ topoTransAbort removeAdornments $result removefail ]
        }
    }

    # Commit the update
    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort removeAdornments $result removefail ]
    }

    # And refresh the dataset
    topoRefreshValueAndTrap

    return "removeok"
}

#
#  Refresh the adornment information.
#
proc refreshAdornments { } {
    set instance [ getModuleParam instance ]
    return [ topoDbAdornmentInfo $instance ]
}

#
##################### View Creation Support #############################
#

#########################################################################
#
# Method:  createView
#
# Purpose: Support view creation from the topology editor.  
#
#          - create view record
#          - create entity record
#          - associate view record with entity record
#          - load topology module
#
# Inputs:  spec
#          pdu
#
#          spec is list comprised of the following: 
#
#          - view type (data|entity) ***not used***
#          - record detail (optional)
#          - view descriptions (optional)
#          - hostname (optional)
#          - ip address (optional)
#          - netmask (optional)
#          - architecture (optional)
#          - view rep family
#
# Outputs: "createok <entity id> <module instance>" 
#          "createfail" 
#          "createmax" 
#          "createlicense" 
#
#########################################################################
proc createView { spec pdu } {
    set viewid [ getModuleParam instance ]
    set userid [ bob get $pdu securityName ]

    if { [ catch { topoDbTransBegin view-create } result ] } { 
        ddl print error "createView: $result\n"
        return "createfail"
    }

    #
    # create the view and entity
    #
    if { [ catch { _createView $viewid $spec $userid } result ] } {
        set code [ remapObjectCreateErrMsg $result ]
        return [ topoTransAbort createView $result create${code} ]
    }

    lextract $result 0 entityid 1 childviewid 2 url

    #
    # commit the changes to the database
    #
    if { [ catch { topoDbTransCommit } result ] } { 
        #
        # unload the module
        #
        catch { topoUnloadModule $childviewid }
        return [ topoTransAbort createView $result createfail ]
    }

    initializeEntity $entityid "true" "aview" $url ""

    #
    # Refresh the datasets
    #
    topoRefreshViewAndInfo
 
    return [ list "createok" $entityid $url ]
}

#########################################################################
#
# Method:  _createView
#
# Purpose: Create and connect a view and a corresponding entity record   
#          in the database.
#
# Inputs:  viewid - parent viewid
#          spec   - child view and entity spec
#          userid - child view owner
#
# Outputs: entityid
#          childviewid
#          url
#
# Notes:   Errors are not caught - caller should catch errors
#
#########################################################################
proc _createView { viewid spec userid } {

    lextract $spec 0 type 1 record 2 desc 3 fulldesc 4 host 5 ipaddr \
                   6 netmask 7 arch 8 family

    set desc [ getUniqueEntityDesc $viewid $desc ]

    #
    # create child view record
    #
    set childviewid [ topoDbViewCreate $desc $fulldesc $host $ipaddr \
                                       $netmask $arch $record $family ]

    set url "snmp://[snmp get address]/mod/topology+${childviewid}"

    #
    # add the entity record into the parent view
    #
    set entityid [ topoDbEntityCreate $viewid "" "" $desc $fulldesc $host \
                                      $ipaddr $netmask $arch $record $family \
                                      "" "" "true" "aview" [ getGeneralUser ] \
                                      "" $host $ipaddr $url ] 

    # entity successfully created to query this agents regards
    # the licensing of its modules
    toe_send [ locate .services.modquery ] "updateDatabaseModuleList 100"


    #
    # connect the child view with the entity  
    #
    topoDbViewConnect $childviewid $viewid $entityid 

    #
    # load a topology module instance for the child view and
    # verify that it was loaded successfully
    #
    if { ![ topoLoadModule $childviewid $desc $userid ] } {
        error "module load failed" 
    }

    return [ list $entityid $childviewid $url ] 
}

proc topoTransAbort { name msg code } {
    ddl print error "$name: $msg\n"
    catch { topoDbTransAbort }
    return $code
}

##############################################################################
#
# Method:  deleteDomainView
#
# Purpose: Delete a domain view 
#          - delete discovery requests 
#          - recursively remove child entity views
#          - check access control
#
# Input:   domain view id
#          pdu
#
# Output:  unloadok      - success
#          unloadfail    - failure
#          unloadpartial - partial deletion
#
##############################################################################
proc deleteDomainView { id pdu } {

    ddl print debug "deleteDomainView: $id\n"

    #
    # get the domain name
    #
    set name [ getDomainNameById $id ]
    if { $name == "" } {
        ddl print error "deleteDomainView: $id is not a domain\n"
        return "unloadfail"
    }

    #
    # remove discovery requests
    #
    if { ! [ deleteDiscoveryRequests $name ] } {
        ddl print error "deleteDomainView: failed to delete discovery request\n"
        return "unloadfail"
    }
    
    #
    # proceed with the domain view deletion
    #
    if { [ catch { topoDbTransBegin view-delete } result ] } {
        ddl print error "deleteDomainView: $result\n"
        return "unloadfail"
    } 

    if { [ catch { deleteView $id $pdu } domainDeleted ] } {
        return [ topoTransAbort deleteDomainView $domainDeleted unloadfail ]
    } 

    if { [ catch { topoDbTransCommit } result ] } {
        return [ topoTransAbort deleteDomainView $result unloadfail ]
    }

    #
    # delete child views and entities
    #
    deleteViewsAndEntities
    
    if { [ catch { topoRefreshDomainTable } result ] } {
        ddl print warning "deleteDomainView: failed to refresh domain table\n"
        ddl print warning "deleteDomainView: $result\n"
    }

    if { $domainDeleted } { 
        return "unloadok"
    } else {
        ddl print warning "deleteDomainView: domain $id not deleted\n"
        return "unloadpartial"
    }
}

##############################################################################
#
# Method:  getDomainNameById
#
# Purpose: Get the domain name, given the id
#
# Input:   domain id
#
# Output:  domain name - success
#          ""          - if not found
#
##############################################################################
proc getDomainNameById { domainid } {
    foreach domain [ topoDbDomainList ] {
        lextract $domain 0 name 1 id
        if { "$domainid" == "$id" } {
            return $name
        }
    }
    return ""
}

##############################################################################
#
# Method:  isDomainView
#
# Purpose: Determine whether an view is a domain view
#
# Input:   view id
#
# Output:  true
#          false
#
##############################################################################
proc isDomainView { id } {
    if { [ catch { topoDbViewIsDomain $id } isdomain ] } {
        ddl print error "isDomainView: $isdomain\n"
        return "false"
    }

    if { $isdomain == "notfound" } {
        ddl print error "isDomainView: failed to find view $id\n"
        return "false"
    }

    return $isdomain
}

##############################################################################
#
# Method:  deleteView
#
# Purpose: Recursively removes child views/entities from the database.
#          Checks access control before proceeding with delete.
#
# Input:   view id
#          pdu
#
# Output:  1 - success
#          0 - failure
#
# Notes:   Do not catch errors in this method. Errors should be caught be
#          the original caller. The caller should abort the transaction
#          in case of error. 
#
#          This method only deletes the views/entities from the database.
#          The list of views and entities deleted are saved in the 'delids'
#          slice.
#
#          The 'deleteViewsAndEntities' method should be called after this
#          method to resynchronize the agent mib with the database.
#
##############################################################################
proc deleteView { id pdu } {
    undefine delids
    return [ _deleteView $id $pdu ]
}

proc _deleteView { id pdu } {
    #
    # check access control
    #
    if { ![ checkViewUnloadAccess $pdu $id ] } {
        return 0
    }
    
    #
    # loop for each child views
    #
    foreach spec [ topoDbViewChildViews $id ] {
        lextract $spec 0 entityid 1 childviewid

        #
        # delete child views recursively
        #
        if { [ _deleteView $childviewid $pdu ] } {
            #
            # a child view was removed, remove the corresponding entity
            #
            topoDbEntityDelete $id $entityid 

            define delids $id [ concat [ ilookup -d "" delids $id ] $entityid ]
        }
    }
 
    #
    # check if the view still has child views
    #
    if { [ topoDbViewChildViews $id ] != "" } {
        return 0
    }

    #
    # disconnect and delete view record
    #
    topoDbViewDisconnect $id
    topoDbViewDelete $id 

    define delids $id ""

    return 1
}

#############################################################################
#
# Method:  deleteViewsAndEntities
#
# Purpose: This method must called after 'deleteView' has been called.
#          The deleteView method removes views/entities from the database.
#          This method deletes the corresponding views/entities from the mib.
#          For instance, topology modules are unloaded for deleted views. 
#
# Inputs:  none
# 
# Outputs: none
#
# Notes:   The 'delids' slice is used to pass information about which
#          views and entities have been deleted from the database. 
#
#          The delids slice contains keys corresponding to affected viewids.
#          If the value is blank, the view has been deleted.
#          If the value is non-blanks, the deleted entities have been deleted. 
#           
#          All errors are caught to allow the clean up proceed. We are 
#          committed to deleting as much as possible since undoing the
#          clean up is not trivial (and errors should only result from
#          programming errors).
# 
#############################################################################
proc deleteViewsAndEntities {} {

    sliceforeach viewid entityids delids {
        if { $entityids == "" } {
            #
            # view deleted, unload module 
            #
            if { [ catch { topoUnloadModule $viewid } result ] } {
                ddl print warning "deleteViewsAndEntities: $result\n"
            } elseif { ! $result } {
                ddl print warning "deleteViewsAndEntities: failed to unload topology module - $viewid\n"
            }
             
        } else {
            #
            # entities deleted, unregister entities
            #
            if { [ catch { locate .contexts.${viewid}*topology } object ] } {
                ddl print warning "deleteViewsAndEntities: $object\n"
            } else {
                foreach entityid $entityids { 
                    toe_csend result $object unregisterEntity $entityid
                }
            }
        }
    }
    undefine delids
}

##############################################################################
#
# Methods:  checkViewTreeUnloadAccess
#           checkViewUnloadAccess
#
# Purpose:  Check whether user has privilege to unload module(s).
#
# Inputs:   pdu  - snmp pdu
#           id   - view id
#
# Outputs:  1 - sufficient privilege
#           0 - insufficient privilege
#
##############################################################################
proc checkViewTreeUnloadAccess { pdu id } {
    if { ![ checkViewUnloadAccess $pdu $id ] } {
        return 0
    }
    foreach spec [ topoDbViewChildViews $id ] {
        set childviewid [ lindex $spec 1 ]
        if { ![ checkViewTreeUnloadAccess $pdu $childviewid ] } {
            return 0
        }
    }
    return 1
}

proc checkViewUnloadAccess { pdu id } { 
    set object [ locate .contexts.${id}*topology ]
    return [ toe_send $object checkAccessShadow moduleadminaction $pdu ]
}

##############################################################################
#
# Methods:  topoLoadModule
#           topoUnloadModule
#
# Purpose:  Load/unload a topology module
#
# Inputs:   id
#           desc
#           user
#
# Outputs:  1 - success
#           0 - failure
#
##############################################################################
proc topoLoadModule { id desc user } {
    ddl print debug "topoLoadModule: $id $desc $user\n"
    set object [ locate .iso*domainControl ] 
    set modroot [ getModuleRoot ]
    if { [ toe_send $object loadTopologyModule $id $desc $user $modroot ] == "createok" } { 
        return 1
    }
    return 0
}

proc topoUnloadModule { id } {
    ddl print debug "topoUnloadModule: $id\n"
    set object [ locate .iso*domainControl ] 
    if { [ toe_send $object unloadTopologyModule $id ] == "unloadok" } {
        return 1
    }
    return 0
}

proc topoRefreshDomainTable {} {
#    ddl print debug "topoRefreshDomainTable\n"
    set object [ locate .iso*domainControl ] 
    toe_send $object refreshDomainTable
}

proc remapObjectCreateErrMsg { message } {

    set code "fail"
    if { [ regexp {maximum number of (.*) exceeded} $message d type ] } {

        if { $type == "objects" } { 
            set code "license"

        } elseif { $type == "entities" } {
            set code "max"
        }

    } elseif { [ regexp {circular relationship} $message ] } { 
        set code "circular"
    } elseif { [ regexp {no longer exists} $message ] } {
        set code "deadref"
    }

    return $code
}

proc getTopoObjectPath {} {
    set currentid [ getModuleParam instance ]
    set parents [ topoDbViewParents $currentid ]
    set path ""
    for { set i [ expr [ llength $parents ] - 1 ] } { $i >= 0 } { incr i -1 } {  
        set id [ lindex $parents $i ]
        append path [ lindex [ topoDbViewInfo $id ] 0 ]/
    }
    append path [ lindex [ topoDbViewInfo $currentid ] 0 ]
        
    return $path
}

#
##################### Discovery Support #############################
#
# The following methods are used by the discovery module to create
# views, add entities, and locate previously created views and entities.
#
#       - createDiscoveryView
#       - addDiscoveryEntity
#       - findDiscoveryView
#       - findDiscoveryEntity
#
#
# Note: A discovery record detail is used to define entities in the 
#       discovery-related methods:
#
#       This record is required because the entity id is internally 
#       generated and the description can be changed by the user.  
#       This record is a string which the discovery module needs to 
#       uniquely identify records between discovery invocations.
#
##############################################################################

##############################################################################
#
# Method:  addDiscoveryEntity
#
# Purpose: Method for creating elements from the discovery module.
#
# Inputs:  record - discovery record information (for subsequent matching)
#          desc
#          fulldesc
#          hostname
#          ipaddr
#          netmask
#          arch
#          family
#          topotype
#          topoconfig
#          ispoll
#          polltype
#          readinfo
#          writeinfo
#          targethost
#          targetip
#          url
#          
# Outputs: "addok <id>" - success  
#          "addfail"    - failure 
#
#          where <id> is the internally generated entity identifier
#
# Notes:   This method does not add duplicate discovery records.  
#          However, it shall update entities if the polltype is being
#          upgraded (i.e. icmp -> snmp -> agent) or if the polltype
#          is unchanged but one or more the other fields have changed.
#          (e.g. "polltype = ahost, family = ultra-1" can be updated to
#                "polltype = ahost, family = enterprise-4000").
#
#          Poll types and corresponding entity urls are listed below:
#
#          poll type               url format
#          ---------               ----------
#          aview|ahost|amod|aprox  snmp://host:port/mod/module/objectpath
#          snmp                    snmp://host:port/oid/#.#.#.#.#.#.#
#          ping                    ping://host
#          dummy                   <ignored>
#
##############################################################################
proc addDiscoveryEntity { record desc fulldesc hostname ipaddr netmask \
                          arch family topotype topoconfig ispoll polltype \
                          readinfo writeinfo targethost targetip url } {

    #
    # check whether entity was previously discovered by searching database
    # for entity by record key (entity record keys are host_<ipaddress>)
    #
    set entityid [ findDiscoveryEntity $record ]
    if { $entityid != "" } {
        #
        # found entity with a matching record key, determine whether the
        # entity should be updated with the new discovery information
        #
        set spec [ list $desc $fulldesc $hostname $ipaddr $netmask \
                        $arch $family $topotype $topoconfig $ispoll \
                        $polltype $readinfo $writeinfo $targethost \
                        $targetip $url ]
 
        set flag [ compareDiscoveryEntity $entityid $spec ]
 
        if { !$flag } {
            #
            # entity does not need to be updated, return ok
            #
            return [ list "addok" $entityid ]
 
        } elseif { $flag == 2 } {
            #
            # entity to be updated, create update spec
            # set desc to be blank so it is not updated
            #
            set spec [ list $entityid "" !${fulldesc} !${hostname} !${ipaddr} \
                   !${netmask} !${arch} !${family} !${ispoll} "" "" \
                   !${topotype} !${topoconfig} !${polltype} !${readinfo} \
                   !${writeinfo} !${targethost} !${targetip} !${url} ]
 
        } else {
            #
            # entity to be updated, create update spec
            # desc may be changed
            #
            set spec [ list $entityid !${desc} !${fulldesc} !${hostname} \
                   !${ipaddr} !${netmask} !${arch} !${family} !${ispoll} \
                   "" "" !${topotype} !${topoconfig} !${polltype} \
                   !${readinfo} !${writeinfo} !${targethost} !${targetip} \
                   !${url} ]
        }
 
        #
        # call updateEntityDetails with delkey flag set to 0 to indicate that
        # the record key should not be deleted
        #
        set result [ toe_send [ getModuleRoot ] updateEntityDetails $spec "0" ]
 
        if { $result == "updateok" } {
            ddl print info "addDiscoveryEntity: updated entity $desc\n"
        } else {
            ddl print warning "addDiscoveryEntity: failed to update $desc\n"
            ddl print warning "addDiscoveryEntity: $result\n"
        }
        #
        # always return ok for now, even if update failed
        #
        return [ list "addok" $entityid ]
    }
 
    #
    # new entity, add it
    #
    if { $record != "" } {
        set record "d:$record"
    }
 
    set result [ toe_send [ getModuleRoot ] _addEntity $record $desc \
                 $fulldesc $hostname $ipaddr $netmask $arch $family \
                 $topotype $topoconfig $ispoll $polltype $readinfo \
                 $writeinfo $targethost $targetip $url ]
 
    return [ list $result ]
}

##############################################################################
#
# Method:  compareDiscoveryEntity
#
# Purpose: Determine whether an existing entity should be updated with
#          newly discovered information
#
# Inputs:  entityid
#          spec
#
# Output:  2 - update entity - all fields
#          1 - update entity but do not update description
#          0 - do not update entity
#
# Notes:   The criteria to determine whether the entity should be updated
#          if as follows:
#
#          - if pollType changes in one of the following ways:
#            - icmp -> agent
#            - icmp -> snmp
#            - snmp -> agent
#
#          - if any one or more other field has changed
#
##############################################################################
proc compareDiscoveryEntity { entityid spec } {
    set viewid [ getModuleParam instance ]
    set oldspec [ getEntityComparisonInfo $viewid $entityid ]
    lextract $oldspec 0 oldDesc 10 oldPollType
    lextract $spec 0 desc 10 polltype
 
    #
    # check if polltype has been upgraded or if polltype is the
    # same and the spec changed
    #
    if { ( $oldPollType == $polltype ) ||
         ( $oldPollType == "ping" && $polltype == "snmp" ) ||
         ( $oldPollType == "ping" && [ isAgentPollType $polltype ] ) ||
         ( $oldPollType == "snmp" && [ isAgentPollType $polltype ] ) } {
 
        #
        # parse off the desc index, if one exists
        # and set return flag accordingly
        #
        # e.g. xxx [1] --> xxx
        #
        if { [ regexp {(.*) \[([0-9]*)\]$} $oldDesc dummy olddesc idx ] } {
            set oldspec [ lreplace $oldspec 0 0 $olddesc ]
            if { $desc != $olddesc } {
                set flag 1
            } else {
                set flag 2
            }
        } else {
            set flag 1
        }
 
        if { $spec != $oldspec } {
            return $flag
        }
    }
    return 0
}
 
proc getEntityComparisonInfo { viewid entityid } {
    set spec [ lindex [ topoDbEntityInfo $viewid $entityid ] 0 ]
    set spec [ lrange $spec 3 end ]
    set spec [ lreplace $spec 11 11 ]
 
    return $spec
}

##############################################################################
#
# Method:  findDiscoveryEntity
#
# Purpose: Locate an existing topology entity based on the discovery 
#          record information specified on creation.  
#
# Input:   record
#
# Output:  entity id - if record is found
#          "" - if no matching entity exists
#
##############################################################################
proc findDiscoveryEntity { record } {
    return [ topoDbEntityLocate [ getModuleParam instance ] "d:$record" ]
}
 
##############################################################################
#
# Method:  createDiscoveryView
#
# Purpose: Create a view within the view's domain.  
#
# Inputs:  record - view record identifier
#          desc
#          fulldesc
#          hostname
#          ipaddr
#          netmask 
#          arch 
#          family
#          userid
#
# Output:  "createok <viewid>" - success
#          "createfail"        - failure
#
# Notes:   This method does not create duplicate views. It returns the 
#          view id of the existing matching view.
#
##############################################################################
proc createDiscoveryView { record desc fulldesc host ipaddr netmask arch \
                           family userid } {
    #
    # check if the view already exists
    #
    set viewid [ findDiscoveryView $record ]
    if { $viewid != "" } {
        return [ list "createok" $viewid ]
    }

    if { $record != "" } {
        set record "d:$record"
    }

    set parentviewid [ getModuleParam instance ]

    #
    # begin transaction 
    #
    if { [ catch { topoDbTransBegin view-create } result ] } { 
        ddl print error "createDiscoveryView: $result\n"
        return "createfail"
    }

    set spec [ 
        list "" $record $desc $fulldesc $host $ipaddr $netmask $arch $family 
    ]

    #
    # create the view 
    #
    if { [ catch { _createView $parentviewid $spec $userid } result ] } { 
        return [ topoTransAbort createDiscoveryView $result createfail ]
    }

    lextract $result 0 entityid 1 viewid 2 url

    #
    # commit the changes
    #
    if { [ catch { topoDbTransCommit } result ] } { 
        #
        # commit failed, unload the module and abort transaction 
        #
        catch { topoUnloadModule $viewid }
        return [ topoTransAbort createDiscoveryView $result createfail ]
    }

    initializeEntity $entityid "true" "aview" $url ""

    #
    # Refresh the datasets
    #
    topoRefreshViewAndInfo

    return [ list "createok" $viewid ]
}

##############################################################################
#
# Method:  findDiscoveryView
#
# Purpose: Locate an existing view based on the discovery record information
#
# Input:   record
#
# Output:  view id - if view is found
#          ""      - if no matching view exists
#
##############################################################################
proc findDiscoveryView { record } {
    set domainid [ topoDbViewDomain [ getModuleParam instance ] ]
    return [ topoDbViewLocate $domainid "d:$record" ]
}

##############################################################################
#
# Method:  deleteDiscoveryRequests
#
# Purpose: Delete discovery requests for a domain
#
# Inputs:  name - domain name
#
# Outputs: 1 - no error
#          0 - error
#
# Notes:   This method is executed when a domain is deleted. It calls 
#          'deleteDomainRequests' in the discovery module
#
##############################################################################
proc deleteDiscoveryRequests { name } {
    #
    # locate the discovery module
    #
    if { [ catch { locate .iso.org.dod.internet.private.enterprises.sun.prod.sunsymon.agent.modules.discovery } object ] } {
        return 1
    }

    #
    # delete the discovery requests for this domain
    #
    ddl print debug "Deleting domain requests for $name\n"
    if { [ toe_csend result $object deleteDomainRequests $name ] } {
        ddl print error "deleteDiscoveryRequests: $result\n"
        ddl print error "Failed to delete domain requests for $name\n"
        return 0
    }
    return 1
}

proc createGroups { count } {
    set id [ getModuleParam instance ]
    set user [ lindex [ lookup -d "" value adminUsers ] 0 ]
 
    ddl print info "createGroups: creating $count group in $id for $user\n"
 
    for { set i 0 } { $i < $count } { incr i } {
        set spec [ list topo {} group${i} {} {} {} {} {} building-view ]
        if { [ catch { _createView $id $spec $user } result ] } {
            ddl print warning "createGroups: $result\n"
            return
        }
        lextract $result 0 entityid 2 url
        initializeEntity $entityid "true" "aview" $url ""
        topoGetAgentStatus $entityid $url
    }
    topoRefreshViewAndInfo
}

###################################################################
# Method: getTopoActionCommandStates
# Propuse: returns the allowed alarm states for which action commands 
#          may be run in the topology agent.
#
# Input:  row - optional rowname
#
# Output: None
#
###################################################################
proc getTopoActionCommandStates { row } { 
    if { $row == "" } { 
	return [list hostdown agentdown] 
    } else { 
	if {[getRowValue entityInfoTable.entityInfoEntry.entityPollType $row] == "ping"} { 
		return [list hostdown] 
	} else { 
		return [list hostdown agentdown] 
	} 
    } 
}


################################################################### 
# Method: getTopoGrpActCheckByIndex 
# Propuse: returns check box value indicating whether it will inherit 
#          a certain group action. 
# 
# Input:  row - optional rowname 
#         index - index into list of allowed alarm states 
# 
# Output: None 
# 
# Notes: 
# 
################################################################### 
proc getTopoGrpActCheckByIndex { row index } { 
	set anObject [locate entityViewTable.entityViewEntry.entityStatus] 
	set levels [ toe_send $anObject getActionCommandStates ] 
	set name [lindex $levels $index] 
	
	#set default value as true 
	toe_send $anObject getAttribute includeGroupAction($name+$row) 1 
} 

################################################################### 
# Method: setTopoGrpActCheckByIndex 
# Propuse: set check box value indicating whether it will inherit 
#          a certain group action.  
# 
# Input:  row - optional rowname 
#         index - index into list of allowed alarm states 
#         value - the value to be set 
# 
# Output: None 
# 
# Notes: 
# 
################################################################### 
proc setTopoGrpActCheckByIndex { row index value } { 
	set anObject [locate entityViewTable.entityViewEntry.entityStatus] 
	set levels [ toe_send $anObject getActionCommandStates ] 
	set name [lindex $levels $index] 
	toe_send $anObject setAttribute includeGroupAction($name+$row) $value 
}

proc defaultDomainFilter { index name } {
    #
    # Hack for internationalization.
    #
    if { $name == "Default Domain" } {
        set name "base.console.ConsoleTopology:domain.defaultdomain"
    }
    return $name
}
#
# Methods for topology alarm window.
# Can't use standard alarm window because this messes up
# proxy alarms; we only want to supress internal (host/agent down)
# alarms.
#

proc topoAlarmsEnabled { row } {
    set window [ ilookup -d "" topowindow $row ]
    if { $window == "" } {
        set spec [ getAttribute topoWindow($row) "" ]
        if { $spec == "" } {
            set spec [ getAttribute topoWindow() "" ]
            if { $spec == "" } {
                define topowindow $row true
                return 1
            }
        }
        set window [ periodic parse $spec ]
        define topowindow $row $window
    }
    if { $window == "true" } {
        return 1
    }
    return [ periodic inrange $window ]
}

proc topoGetAlarmWindow { row } {
    set spec [ getAttribute topoWindow($row) "" ]
    if { $spec == "" && $row != "" } {
        set spec [ getAttribute topoWindow() "" ]
    }
    return $spec
}

proc topoSetAlarmWindow { row window } {
    setAttribute topoWindow($row) $window
    if { $row == "" } {
        sliceforeach {} window topowindow {
            if { $window != "true" } {
                periodic free $window
            }
        }
        undefine topowindow
    } else {
        set window [ ilookup -d "true" topowindow $row ]
        if { $window != "true" } {
            periodic free $window
        }
        undefine topowindow $row
    }
    refreshValue
}

  
