home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 March B / SCO_CASTOR4RRT.iso / nics / root.2 / usr / lib / netcfg / bin / ncfgBE / ncfgBE~
Text File  |  1998-08-19  |  53KB  |  2,211 lines
  1. #!/bin/osavtcl
  2. #ident "@(#)ncfgBE    29.4"
  3. #ident "$Header: $"
  4. #
  5. #  Based on OpenServer ncfgBE version 11.1
  6. #
  7. #    Copyright (C) 1993-1997 The Santa Cruz Operation, Inc.  
  8. #        All Rights Reserved.
  9. #
  10. #       The information in this file is provided for the exclusive use of
  11. #       the licensees of The Santa Cruz Operation, Inc.  Such users have the
  12. #       right to use, modify, and incorporate this code into other products
  13. #       for purposes authorized by the license agreement provided they include
  14. #       this notice and the associated copyright notice with any such product.
  15. #       The information in this file is provided "AS IS" without warranty.
  16. #
  17.  
  18. #cmdtrace on [ open /tmp/ncfgBE.log a+ ]
  19.  
  20. loadlibindex /usr/lib/sysadm.tlib
  21.  
  22. set NCFG_DIR        /usr/lib/netcfg
  23. set NDCFG_PATH        $NCFG_DIR/bin/ndcfg
  24. set NCFG_INFODIR    $NCFG_DIR/info
  25. set NCFG_CHAINSFILE    $NCFG_DIR/chains
  26. set NCFG_RECONFDIR    $NCFG_DIR/reconf
  27. set NCFG_LISTDIR    $NCFG_DIR/list
  28. set PROMPTER_PATH    /usr/sbin/ncfgprompter
  29.  
  30. source $NCFG_DIR/bin/ncfgBE.msg.tcl
  31. source $NCFG_DIR/lib/libSCO.tcl
  32.  
  33. # This script manipulates the following objects:
  34. # MESH:        A structure representing all chains, both possible and
  35. #        actually configured, that can be manipulated given the
  36. #        current networking componentes installed into the netconfig
  37. #        framework.
  38. # MESH = list of NODEs
  39. #
  40. # NODE:        A structure representing one element of one chain.
  41. # NODE = list of NODEs            ( Children of that node )
  42. #          list of ELEMENTdescriptor    ( The chain itself )
  43. #         element-index        ( Index into above list )
  44. #         actually-configured    ( 1=Yes, 0=Potentially, but not at mo. )
  45. #
  46. # ELEMENT:    A structure containing all the information about an element
  47. #        in a chain.
  48. # ELEMENT = component            ( The name of the component )
  49. #        element            ( The name of the element )
  50. #        info-path            ( The path of the info file )
  51. #        description            ( The description of the element )
  52. #        hw-sw            ( 1=Hardware, 0=Software )
  53. #        up                ( UP interface )
  54. #        down            ( DOWN interface )
  55. #        reconfigurable        ( 1=Yes,0=No )
  56. #        listable            ( 1=Yes,0=No )
  57.  
  58. # Returns an ELEMENT when given an nodeinfo
  59. proc GetElement {nodeinfo} \
  60. {
  61.     global ELEMENT
  62.  
  63.     set elementindex [ keylget nodeinfo INDEX ]
  64.     set chain [ keylget nodeinfo CHAIN ]
  65.  
  66.     set elementdescriptor [ lindex $chain $elementindex ]
  67.  
  68.     set indexes [array names ELEMENT]
  69.     if { [ lsearch $indexes $elementdescriptor ] == -1 } {
  70.         echo "SCO_NETCONFIG_UI_ERR_BE_INFO_MISSING"
  71.         exit 1
  72.     }
  73.  
  74.     return $ELEMENT($elementdescriptor)
  75. }
  76.  
  77. proc IsWANInterface {if} \
  78. {
  79.  
  80.         if { [ crange $if 0 3 ] == "wan-" } {
  81.             return 1
  82.         } else {
  83.             return 0
  84.         }
  85. }
  86.  
  87. proc IsNetX {el} \
  88. {
  89.         if [ regexp "^net(\[0-9\])+$" $el ] {
  90.             return 1
  91.         } else {
  92.             return 0
  93.         }
  94. }
  95.  
  96. proc SetElement {name {infofile ""}} \
  97. {
  98.     global ELEMENT
  99.     global NCFG_INFODIR NCFG_RECONFDIR NCFG_LISTDIR
  100.  
  101.     set component $name
  102.     if { $infofile != "" } {
  103.         set element ${component}(${infofile})
  104.         set infoPath $NCFG_INFODIR/$component/$infofile
  105.     } else {
  106.         set element $component
  107.         set infoPath $NCFG_INFODIR/$component
  108.     }
  109.  
  110.     set reconfable [ file exists $NCFG_RECONFDIR/$component ]
  111.     set listable [ file exists $NCFG_LISTDIR/$component ]
  112.  
  113.     # Search Info file for DESCRIPTION=, HWSW=
  114.     set description ""
  115.     set hwsw ""
  116.     set up ""
  117.     set down ""
  118.     set sd [ scancontext create ]
  119.     set fd [ open $infoPath ]
  120.     scanmatch $sd "^DESCRIPTION=" {
  121.         set description [ string trim [ csubstr $matchInfo(line) 12 end ] \" ]
  122.     }
  123.     scanmatch $sd "^UP=" {
  124.         set up [ string trim [ csubstr $matchInfo(line) 3 end ] \" ]
  125.     }
  126.     scanmatch $sd "^DOWN=" {
  127.         set down [ string trim [ csubstr $matchInfo(line) 5 end ] \" ]
  128.     }
  129.     scanmatch $sd "^HWSW=" {
  130.         set hwsw [ string trim [ csubstr $matchInfo(line) 5 end ] \" ]
  131.     }
  132.     scanfile $sd $fd
  133.     scancontext delete $sd
  134.     close $fd
  135.  
  136.     if { $down == "" } {
  137.         set ndcfgreturn [ lindex [ SendNDRequest "GETHWKEY $element" ] 0 ]
  138.         keylget ndcfgreturn INFO hwkey
  139.         set description "$description$hwkey"
  140.     }
  141.  
  142.     if { $up == "" } {
  143.         set up NULL
  144.     }
  145.     if { $down == "" } {
  146.         set down NULL
  147.     }
  148.  
  149.     if { $hwsw == "" && $down == "NULL" } {
  150.         if [ IsWANInterface $up ] {
  151.             set hwsw "SW"
  152.         } else {
  153.             set hwsw "HW"
  154.         }
  155.     }
  156.  
  157.     keylset ELEMENT($element) COMPONENT $component
  158.     keylset ELEMENT($element) ELEMENT $element
  159.     keylset ELEMENT($element) DESCRIPTION $description
  160.     keylset ELEMENT($element) HWSW $hwsw
  161.     keylset ELEMENT($element) UP $up
  162.     keylset ELEMENT($element) DOWN $down
  163.     keylset ELEMENT($element) RECONFABLE $reconfable
  164.     keylset ELEMENT($element) LISTABLE $listable
  165.  
  166.     return $element
  167. }
  168.  
  169. proc AddChainToNode {node ni_list} \
  170. {
  171.     global ELEMENT
  172.  
  173. #puts stderr "AddChainToNode(<$node> <$ni_list>"
  174.     if { [ llength $ni_list ] < 2 } {
  175.         return $node
  176.     }
  177.     set tail [ lrange $ni_list 0 [ expr { [ llength $ni_list ] - 2 } ] ]
  178.  
  179.     set end [ lindex $tail [ expr { [ llength $tail ] - 1 } ] ]
  180.     set end_element [ GetElement $end ]
  181.     set end_name [ keylget end_element COMPONENT ]
  182.  
  183.     set nodechildren [ lindex $node 0 ]
  184.     set nodeinfo [ lindex $node 1 ]
  185.     set found 0
  186.     set newchildren ""
  187.     foreach child $nodechildren {
  188.         set childinfo [ lindex $child 1 ]
  189.         set child_element [ GetElement $childinfo ]
  190.         set component_name [ keylget child_element COMPONENT ]
  191.  
  192.         if { $component_name == $end_name } {
  193.             lappend newchildren [ AddChainToNode $child $tail ]
  194.             set found 1
  195.         } else {
  196.             lappend newchildren $child
  197.         }
  198.     }
  199.     set nodechildren $newchildren
  200.  
  201.     if {! $found } {
  202.         set ni_tree ""
  203.         foreach i $tail {
  204.             if { $ni_tree == "" } {
  205.                 set ni_tree [ list $ni_tree $i ]
  206.             } else {
  207.                 set ni_tree [ list [ list $ni_tree ] $i ]
  208.             }
  209.         }
  210.         lappend nodechildren $ni_tree
  211.     }
  212.     set result [ list $nodechildren $nodeinfo ]
  213.     return $result
  214. }
  215.  
  216. proc AddChainsToNode {node} \
  217. {
  218.     global AOLOPCchains AOLOPCactually_configured ELEMENT
  219.  
  220. #puts stderr "AddChainToNodes(<$node>)"
  221.     set nodechildren [ lindex $node 0 ]
  222.     set nodeinfo [ lindex $node 1 ]
  223.  
  224.     set element [ GetElement $nodeinfo ]
  225.     set component_name [ keylget element COMPONENT ]
  226.     
  227.     set newchains ""
  228.     foreach i $AOLOPCchains {
  229.         set tail [ lindex $i [ expr { [ llength $i ] - 1 } ] ]
  230.         set name [ keylget ELEMENT($tail) COMPONENT ]
  231.         if { $name == $component_name } {
  232.             set ni_list ""
  233.             for {set j 0} { $j < [ llength $i ] } { incr j } {
  234.                 keylset ni CHAIN $i
  235.                 keylset ni INDEX $j
  236.                 keylset ni CONFIGURED $AOLOPCactually_configured
  237.                 lappend ni_list $ni
  238.             }
  239.             set node [ AddChainToNode $node $ni_list ]
  240.         } else {
  241.             lappend newchains $i
  242.         }
  243.     }
  244.     set AOLOPCchains $newchains
  245.     return $node
  246. }
  247.  
  248. proc AddChainsToTree {tree} \
  249. {
  250. #puts stderr "AddChainsToTree(<$tree>)"
  251.     set children [ lindex $tree 0 ]
  252.     set nodeinfo [ lindex $tree 1 ]
  253.  
  254.     set newchildren ""
  255.     foreach i $children {
  256.         lappend newchildren [ AddChainsToTree $i ]
  257.     }
  258.     set newtree [ list $newchildren $nodeinfo ]
  259.     return [ AddChainsToNode $newtree ]
  260. }
  261.  
  262. proc AddOneLayerOfChains {mesh chains actually_configured} \
  263. {
  264.     global AOLOPCactually_configured AOLOPCchains
  265.  
  266.     set AOLOPCchains $chains
  267.     set AOLOPCactually_configured $actually_configured
  268.  
  269.     set newmesh ""
  270.     foreach tree $mesh {
  271. set AOLOPCchains $chains
  272.         lappend newmesh [ AddChainsToTree $tree ]
  273.     }
  274.  
  275.     return [ list $newmesh $AOLOPCchains ]
  276. }
  277.  
  278. # Return a list of the root components of a list of chains
  279. proc FindRoots {chain_list} \
  280. {
  281.     # Set roots to the list of all chain ends (ie last component of chain)
  282.     set roots ""
  283.     foreach i $chain_list {
  284.         set found 0
  285.         set end [ lindex $i [ expr { [ llength $i ] - 1 } ] ]
  286.  
  287.         foreach j $roots {
  288.             if { $j == $end } {
  289.                 set found 1
  290.                 break
  291.             }
  292.         }
  293.         if { ! $found } {
  294.             lappend roots $end
  295.         }
  296.     }
  297.  
  298.     # Filter out any chain ends which have corresponding chain heads
  299.     # E.g. nfs->tcp  tcp->net0
  300.     set newroots ""
  301.     foreach k $roots {
  302.         set found 0
  303.         foreach l $chain_list {
  304.             if { [ llength $l ] != 1 } {
  305.                 if { $k == [ lindex $l 0 ] } {
  306.                     set found 1
  307.                     break
  308.                 }
  309.             }
  310.         }
  311.         if { ! $found } {
  312.             keylset nodeinfo CHAIN $k
  313.             keylset nodeinfo INDEX 0
  314.             keylset nodeinfo CONFIGURED 1
  315.             lappend newroots [ list "" $nodeinfo ]
  316.         }
  317.     }
  318.     return $newroots
  319. }
  320.  
  321. # Read the chains file and build a list representing it
  322. proc ReadChainsFile {} \
  323. {
  324.     global NCFG_CHAINSFILE
  325.  
  326.     set list ""
  327.     if [ file exists $NCFG_CHAINSFILE ] {
  328.         set fd [ open $NCFG_CHAINSFILE ]
  329.     } else {
  330.         set fd [ open $NCFG_CHAINSFILE w+ ]
  331.     }
  332.     while { [ gets $fd line ] != -1 } {
  333.         set c [ translit "#" " " $line ]
  334.         if { [ llength $c ] > 0 } {
  335.             lappend list $c
  336.         }
  337.     }
  338.     close $fd
  339.  
  340.     set sorted_list ""
  341.     while { $list != "" } {
  342.         set s [ lindex $list 0 ]
  343.         set s_len [ llength $s ]
  344.         set l ""
  345.         foreach i [ lrange $list 1 end ] {
  346.             set i_len [ llength $i ]
  347.             if { $i_len < $s_len } {
  348.                 lappend l $s
  349.                 set s $i
  350.                 set s_len $i_len
  351.             } else {
  352.                 lappend l $i
  353.             }
  354.         }
  355.         lappend sorted_list $s
  356.         set list $l
  357.     }
  358.     return $sorted_list
  359. }
  360.  
  361. # Returns a list of chains, and a MESH representing all currently configured chains
  362. proc GetCurrentChains {} \
  363. {
  364.     global ELEMENT
  365.  
  366.     if [ info exists ELEMENT ] { unset ELEMENT }
  367.  
  368.     global NCFG_INFODIR
  369.     set olddir [ pwd ]
  370.     cd $NCFG_INFODIR
  371.     set file_list [ glob -nocomplain * ]
  372.     cd $olddir
  373.  
  374.     foreach i $file_list {
  375.         if [ file isdirectory $NCFG_INFODIR/$i ] {
  376.             cd $NCFG_INFODIR
  377.             set file_list2 [ glob -nocomplain $i/* ]
  378.             cd $olddir
  379.             foreach j $file_list2 {
  380.                 SetElement $i [ file tail $j ]
  381.             }
  382.         } else {
  383.             SetElement $i
  384.         }
  385.     }
  386.     set chain_list [ ReadChainsFile ]
  387.     set root_list [ FindRoots $chain_list ]
  388.  
  389.     # Add all chains to root_list, creating a mesh of all currently
  390.     # configured nodes.
  391.     set c $chain_list
  392.     while { $c != "" } {
  393.         set x [ AddOneLayerOfChains $root_list $c 1 ]
  394.         set root_list [ lindex $x 0 ]
  395.         set new_c [ lindex $x 1 ]
  396.  
  397.         if { $new_c == $c } {
  398. #            puts stderr "ncfg: Warning screwy chains DB"
  399.             break
  400.         }
  401.         set c $new_c
  402.     }
  403.  
  404.     return [ list $root_list $chain_list ]
  405. }
  406.  
  407. proc GPC {partial_chain} \
  408. {
  409.     global ELEMENT GPCchains
  410.  
  411.     set tail $ELEMENT([ lindex $partial_chain [ expr { [ llength $partial_chain ] -1 } ] ])
  412.     set up [ keylget tail UP ]
  413.     set down [ keylget tail DOWN ]
  414.  
  415.     if { [ llength $partial_chain ] > 1 } {
  416.         foreach i $up {
  417.             if { $i == "NULL" } {
  418.                 lappend GPCchains $partial_chain
  419.                 return
  420.             }
  421.         }
  422.         foreach i $down {
  423.             if { $i == "NULL" } {
  424.                 lappend GPCchains $partial_chain
  425.                 return
  426.             }
  427.         }
  428.     }
  429.  
  430.     foreach i [ array names ELEMENT ] {
  431.         set loop 0
  432.         foreach j $partial_chain {
  433.             if { $j == $i } {
  434.                 set loop 1
  435.                 break
  436.             }
  437.         }
  438.         if { $loop } {
  439.             continue
  440.         }
  441.         set element $ELEMENT($i)
  442.         set up [ keylget element UP ]
  443.         set match 0
  444.         foreach j $down {
  445.             if { $down == "NULL" } {
  446.                 continue
  447.             }
  448.             foreach k $up {
  449.                 if { $j == $k } {
  450.                     set match 1
  451.                     break
  452.                 }
  453.             }
  454.             if { $match } {
  455.                 set c $partial_chain
  456.                 lappend c $i
  457.                 GPC $c
  458.             }
  459.         }
  460.     }
  461. }
  462.  
  463. # Returns a list of chains that are not currently configured in the system,
  464. # but could be
  465. proc GetPossibleChains {current_chains} \
  466. {
  467.     global ELEMENT GPCchains
  468.  
  469.     set GPCchains ""
  470.     # Find all the elements that can be at the end of a chain
  471.     foreach i [ array names ELEMENT ] {
  472.         set up [ keylget ELEMENT($i) UP ]
  473.         foreach u $up {
  474.             if { $u == "NULL" } {
  475.                 GPC $i
  476.                 break
  477.             }
  478.         }
  479.     }
  480.  
  481.     set new_chains ""
  482.     foreach i $GPCchains {
  483.         set found 0
  484.         foreach j $current_chains {
  485.             if { $j == $i } {
  486.                 set found 1
  487.                 break
  488.             }
  489.         }
  490.         if { ! $found } {
  491.             lappend new_chains $i
  492.         }
  493.     }
  494.     return $new_chains
  495. }
  496.  
  497. # This portion of the script filters a Mesh structure based on several
  498. # criteria.  It returns a flattened list:
  499. # TREE:        A flat list of icons and descriptions which is displayed
  500. #        within a DrawnList widget.
  501. # TREE = list of TREL
  502. #
  503. # TREL:        An element of the tree, represents one element in a chain
  504. # TREL = selectable            ( 1=Yes, 0=No )
  505. #     iconlist            ( The list of icons to be displayed )
  506. #     indent                ( Offset of text within list )
  507. #     description            ( Description from NODEINFO )
  508. #     nodeinfodescriptor        ( Pointer to nodeinfo )
  509.  
  510. proc BuildTree {node indent tree_type} \
  511. {
  512.     set children [ lindex $node 0 ]
  513.     set nodeinfo [ lindex $node 1 ]
  514. #puts stderr "BT(<$node>,<$indent>,<$tree_type>)"
  515. #puts stderr "C($nodeinfo,$children)"
  516.  
  517.     # Look up the element
  518.     set element [ GetElement $nodeinfo ]
  519.     set element_name [ keylget element DESCRIPTION ]
  520.     set element_hwsw [ keylget element HWSW ]
  521.     set element_up [ keylget element UP ]
  522.  
  523.     # Build TREL
  524.     set t_indent $indent
  525.     set t_desc $element_name
  526.     set t_nodeinfo $nodeinfo
  527.  
  528.     case $tree_type {
  529.         ADD_SW {
  530.             set t_is_solid [ expr { ! [ keylget t_nodeinfo CONFIGURED ] } ]
  531.             set t_selectable [ expr { $t_is_solid } ]    
  532.         }
  533.         DEL_SW {
  534.             set t_is_solid 1
  535.             set t_selectable [ expr { ! [ keylget t_nodeinfo CONFIGURED ] } ]
  536.         }
  537.         MAIN {
  538.             set t_is_solid 1
  539.             set t_selectable 1
  540.         }
  541.     }
  542.  
  543.     set prev_one_is_solid 0
  544.     set list ""
  545.     set c_len_minus_1 [ expr { [ llength $children ] -1 } ]
  546.     for {set i $c_len_minus_1} { $i >= 0 } {incr i -1} {
  547.         set child [ lindex $children $i ]
  548.  
  549.         set new [ BuildTree $child [ expr { $indent + 2 } ] $tree_type ]
  550.  
  551.         #figure out what to prefix the child tree with...
  552.         set one_is_solid 0
  553.         set new_len [ llength $new ]
  554.         set l ""
  555.         for {set j 0} {$j < $new_len} {incr j} {
  556.             set item [ lindex $new $j ]
  557.  
  558.             set x_iconlist [ keylget item ICONLIST ]
  559.             set x_nodeinfo [ keylget item NODEINFO ]
  560.  
  561.             case $tree_type {
  562.                 ADD_SW {
  563.                     set x_is_solid [ expr { ! [ keylget x_nodeinfo CONFIGURED ] } ]
  564.                 }
  565.                 DEL_SW {
  566. #                    set x_is_solid [ expr { ! [ keylget x_nodeinfo CONFIGURED ] } ]
  567.                     set x_is_solid 1
  568.                 }
  569.                 MAIN {
  570.                     set x_is_solid 1
  571.                 }
  572.             }
  573.             if { $x_is_solid } {
  574.                 set one_is_solid 1
  575.             }
  576.  
  577.             if { $j ==  0 } {
  578.                 if { $i == $c_len_minus_1 } {
  579.                     if { $x_is_solid } {
  580.                         set x_iconlist [ concat 5 3 $x_iconlist ]
  581.                     } else {
  582.                         set x_iconlist [ concat 5 10 $x_iconlist ]
  583.                     }
  584.                 } else {
  585.                     if { $x_is_solid } {
  586.                         if { $prev_one_is_solid } {
  587.                             set x_iconlist [ concat 5 1 $x_iconlist ]
  588.                         } else {
  589.                             set x_iconlist [ concat 5 13 $x_iconlist ]
  590.                         }
  591.                     } else {
  592.                         if { $prev_one_is_solid } {
  593.                                 set x_iconlist [ concat 5 12 $x_iconlist ]
  594.                         } else {
  595.                                 set x_iconlist [ concat 5 8 $x_iconlist ]
  596.                         }
  597.                     }
  598.                 }
  599.             } else {
  600.                 if { $i == $c_len_minus_1 } {
  601.                         set x_iconlist [ concat 5 5 $x_iconlist ]
  602.                 } else {
  603.                     if { $prev_one_is_solid } {
  604.                         set x_iconlist [ concat 5 2 $x_iconlist ]
  605.                     } else {
  606.                         set x_iconlist [ concat 5 9 $x_iconlist ]
  607.                     }
  608.                 }
  609.             }
  610.             keylset item ICONLIST $x_iconlist
  611.  
  612.             lappend l $item
  613.         }
  614.         if { $one_is_solid } {
  615.             set prev_one_is_solid 1
  616.         }
  617.         set list [ concat $l $list ]
  618.     }
  619.  
  620.  
  621.     if { $indent == 2 } {
  622.         if { [ IsWANInterface $element_up ] } {
  623.             set t_iconlist [ list 18 21 ]
  624.         } else {
  625.             if { $t_is_solid } {
  626.                 set t_iconlist [ list 6 20 ]
  627.             } else {
  628.                 set t_iconlist [ list 17 22 ]
  629.             }
  630.         }
  631.     } else {
  632.         if { $list == "" } {
  633.             if { $t_is_solid } {
  634.                 set t_iconlist [ list 0 15 ]
  635.             } else {
  636.                 set t_iconlist [ list 7 16 ]
  637.             }
  638.         } else {
  639.             if { $t_is_solid } {
  640.                 if { $prev_one_is_solid } {
  641.                     set t_iconlist [ list 0 4 ]
  642.                 } else {
  643.                     set t_iconlist [ list 0 14 ]
  644.                 }
  645.             } else {
  646.                 if { $prev_one_is_solid } {
  647.                     set t_iconlist [ list 7 19 ]
  648.                 } else {
  649.                     set t_iconlist [ list 7 11 ]
  650.                 }
  651.             }
  652.         }
  653.     }
  654.     keylset t SELECTABLE $t_selectable
  655.     keylset t ICONLIST $t_iconlist
  656.     keylset t INDENT $t_indent
  657.     keylset t DESCRIPTION $t_desc
  658.     keylset t NODEINFO $t_nodeinfo
  659.     set result [ linsert $list 0 $t ]
  660.  
  661.     return $result
  662. }
  663.  
  664. # Turn a mesh into a tree
  665. proc MeshToTree {mesh tree_type} \
  666. {
  667.     set tree ""
  668.     foreach root $mesh {
  669.         if { $root != {} } {
  670.             set tree [ concat $tree [ BuildTree $root 2 $tree_type ] ]
  671.         }
  672.     }
  673.     return $tree
  674. }
  675.  
  676. # Filter irrelevant chains out of mesh for LAN/WAN display modes
  677. proc FilterMesh {mesh confchains lan_wan} \
  678. {
  679.     global ELEMENT
  680.  
  681.     case $lan_wan {
  682.     LAN {
  683.         set bottomtype HW
  684.     }
  685.     WAN {
  686.         set bottomtype SW
  687.     }
  688.     WAN_HW {
  689.         set bottomtype HW
  690.     }
  691.     default {
  692.         return $mesh
  693.     }
  694.     }
  695.     set nmesh ""
  696.     upvar lanwancount count
  697.     set count 0
  698.     loop inx 0 [ llength $confchains ] {
  699.         set chain [ lindex $confchains $inx ]
  700.         set bel [ lindex $chain end ]
  701.         if { [ keylget ELEMENT($bel) HWSW ] == $bottomtype } {
  702.             if { $lan_wan == "LAN" && [ keylget ELEMENT($bel) UP ] == "NULL" } {
  703.                 continue
  704.             }
  705.             if { $lan_wan == "WAN_HW" && [ keylget ELEMENT($bel) UP ] != "NULL" } {
  706.                 continue
  707.             }
  708.             lappend nmesh [ lindex $mesh $inx ]
  709.             incr count
  710.         }
  711.     }
  712.     return $nmesh
  713. }
  714.  
  715.  
  716. proc GetSerialPorts {} \
  717. {
  718.     set objCall [ list ObjectGet -filter {state eq ENABLED} \
  719.             {sco SerialPorts} NULL {} ]
  720.     set bmipList [ SaMakeObjectCall $objCall ]
  721.  
  722.     foreach bmip $bmipList {
  723.         lappend portlist [ BmipResponseObjectInstance bmip ]
  724.     }
  725.  
  726.     set objCall [ list ObjectGet {sco UUCPdevices} NULL {} ]
  727.     set bmipList [ SaMakeObjectCall $objCall ]
  728.  
  729.     foreach bmip $bmipList {
  730.         set attrs [ BmipResponseAttrValList bmip ]
  731.         lappend portlist [ keylget attrs port ]
  732.  
  733.         set objCall [ list ObjectGet {sco ModemModel} [keylget attrs dialer] {} ]
  734.         set modembmipresponse  [ SaMakeObjectCall $objCall ]
  735.         set modembmip [ lindex $modembmipresponse 0 ]
  736.         set modemattrs  [ BmipResponseAttrValList modembmip ] 
  737. #        puts [ keylget modemattrs desc ] 
  738.     }
  739.  
  740.     set portlist [ lrmdups $portlist ]
  741.  
  742.     foreach port $portlist {
  743.  
  744.         set tmp {{SELECTABLE 0} {ICONLIST {6 20}} {INDENT 2} {DESCRIPTION { XXX }} {NODEINFO {{CHAIN net3} {INDEX 1} {CONFIGURED 1}}}}
  745.  
  746.         keylset tmp DESCRIPTION "$port"
  747.  
  748.         lappend w $tmp
  749.     }
  750.     
  751.     return $w
  752. }
  753.  
  754.  
  755. proc seriallist {} \
  756. {
  757.     set DEVLIST ""
  758.  
  759.     # Get Outgoing devices from uucp devices
  760.  
  761.     set objCall [ list ObjectGet {sco UUCPdevices} NULL {} ]
  762.     set bmipList [ SaMakeObjectCall $objCall ]
  763.  
  764.     foreach bmip $bmipList {
  765.         set DEVINFO ""
  766.         
  767.         set attrs [ BmipResponseAttrValList bmip ]
  768.         if { [keylget attrs dialer] != "ISDN" } {
  769.  
  770.             #get driver
  771.             set objCall [ list ObjectGet {sco SerialPorts} [ keylget attrs port ] {} ]
  772.             set driverbmipresponse  [ SaMakeObjectCall $objCall ]
  773.             set driverbmip [ lindex $driverbmipresponse 0 ]
  774.             set driverattrs  [ BmipResponseAttrValList driverbmip ] 
  775.             keylset DEVINFO DRIVER [ keylget driverattrs driver ] 
  776.             
  777.             
  778.             #get port
  779.             keylset DEVINFO PORT [ keylget attrs port ]
  780.             keylset DEVINFO DESC [ keylget attrs desc ]
  781.             
  782.             #get modem type
  783.             set objCall [ list ObjectGet {sco ModemModel} [keylget attrs dialer] {} ]
  784.             set modembmipresponse  [ SaMakeObjectCall $objCall ]
  785.             set modembmip [ lindex $modembmipresponse 0 ]
  786.             set modemattrs  [ BmipResponseAttrValList modembmip ] 
  787.             if { "$modemattrs" != {} } {
  788.                 keylset DEVINFO MODEM [ keylget modemattrs desc ] 
  789.                 keylset DEVINFO DIRECTION [ keylget driverattrs direction ]
  790.             
  791.                 set DEVARRAY([ keylget DEVINFO PORT ]) $DEVINFO
  792.                 lappend DEVLIST $DEVINFO
  793.             }
  794.         }
  795.     }
  796.     
  797.     # Get ENABLED Incoming devices
  798. #    set objCall [ list ObjectGet -filter {state eq ENABLED} {sco SerialPorts} NULL {} ]
  799.     set objCall [ list ObjectGet {sco SerialPorts} NULL {} ]
  800.     set bmipList [ SaMakeObjectCall $objCall ]
  801.     
  802.     foreach bmip $bmipList {
  803.         
  804.         set DEVINFO ""
  805.         set attrs [ BmipResponseAttrValList bmip ]
  806.  
  807. # puts stderr "$attrs"
  808.  
  809.         if { [keylget attrs state ret] && "$ret" == "ENABLED" } {
  810.             keylset DEVINFO DRIVER [ keylget attrs driver ]
  811.             set port [ BmipResponseObjectInstance bmip ]
  812.             keylset DEVINFO DESC [ keylget attrs desc ]
  813.             keylset DEVINFO PORT [ BmipResponseObjectInstance bmip ]
  814.             if { [ info exists DEVARRAY($port) ] } {
  815.                 set DEVINFO $DEVARRAY($port)
  816.             } else {
  817.                 keylset DEVINFO MODEM ""
  818.                 keylset DEVINFO DIRECTION [ keylget attrs direction ]
  819.             }   
  820.             set DEVARRAY($port) $DEVINFO
  821.             lappend DEVLIST $DEVINFO
  822.         }
  823.     }
  824.     
  825.     set DEVLIST [ lrmdups $DEVLIST ]
  826.     return [ lsort $DEVLIST ]
  827.  
  828. }
  829.  
  830. proc infoentry { select icon indent desc node } \
  831. {
  832.     keylset item SELECTABLE $select
  833.     keylset item ICONLIST $icon
  834.     keylset item INDENT $indent
  835.     keylset item DESCRIPTION $desc
  836.     keylset item NODEINFO $node
  837.  
  838.     return $item
  839. }
  840.  
  841.  
  842. proc serialtree {} \
  843. {
  844.     set tlist [ seriallist ]
  845.     if { "$tlist" == "" } {
  846.         return ""
  847.     }
  848.     set olddriver ""
  849.     set port [ lindex $tlist 0 ]
  850.  
  851.     foreach nextport [ lrange $tlist 1 end ] {
  852.         set iconlist ""
  853.         set driver [ keylget port DRIVER ]
  854.         set nextdriver [ keylget nextport DRIVER ]
  855.         set modem [ keylget port MODEM ]
  856.         keylset nodeinfo PORT [ keylget port PORT ] 
  857.  
  858.         if { $olddriver != $driver } {
  859.             keylset nodeinfo WHAT "driver"  
  860.             lappend olist "[ infoentry 1 {6 20} 2 $driver $nodeinfo]"
  861.         }
  862.         if { $nextdriver == $driver } {
  863.             lappend iconlist 5 1 0
  864.             set miconlist { 5 2 5 3 0 15 }
  865.         } else {
  866.             lappend iconlist 5 3 0
  867.             set miconlist { 5 5 5 3 0 15 }
  868.         }
  869.  
  870.     # jaw intl
  871.         set portdesc "[keylget port DESC] ([keylget port DIRECTION])"
  872.  
  873.         if { $modem != "" } {
  874.             lappend iconlist 4
  875.             keylset nodeinfo WHAT "port"  
  876.             lappend olist "[ infoentry 1 $iconlist 4 $portdesc $nodeinfo]"
  877.             keylset nodeinfo WHAT "modem"  
  878.             lappend olist "[ infoentry 1 $miconlist 6 $modem $nodeinfo]"
  879.         } else { 
  880.             lappend iconlist 15
  881.             keylset nodeinfo WHAT "port"  
  882.             lappend olist "[ infoentry 1 $iconlist 4 $portdesc $nodeinfo]"
  883.         }
  884.  
  885.         set olddriver $driver
  886.         set port $nextport
  887.     }
  888.     set iconlist ""
  889.     set miconlist ""
  890.     set driver [ keylget port DRIVER ]
  891.     set modem [ keylget port MODEM ]
  892.     keylset nodeinfo PORT [ keylget port PORT ] 
  893.     # jaw intl
  894.     set portdesc "[keylget port DESC] ([keylget port DIRECTION])"
  895.     if { $olddriver != $driver } {
  896.         keylset nodeinfo WHAT "driver"  
  897.         lappend olist "[ infoentry 1 {6 20} 2 $driver $nodeinfo]"
  898.     }
  899.     lappend iconlist 5 3 0
  900.     set miconlist { 5 5 5 3 0 15 }
  901.     if { $modem != "" } {
  902.         lappend iconlist 4
  903.         keylset nodeinfo WHAT "port"  
  904.         lappend olist "[ infoentry 1 $iconlist 4 $portdesc $nodeinfo]"
  905.         keylset nodeinfo WHAT "modem"  
  906.         lappend olist "[ infoentry 1 $miconlist 6 $modem $nodeinfo]"
  907.     } else { 
  908.         lappend iconlist 15
  909.         keylset nodeinfo WHAT "port"  
  910.         lappend olist "[ infoentry 1 $iconlist 4 $portdesc $nodeinfo]"
  911.     }
  912.  
  913.     return $olist
  914. }
  915.  
  916.  
  917. # uses uucpOSA to add netx devices to the uucp Devices file
  918. proc AddOutgoing {netx} \
  919. {
  920.     keylset attrs type ISDN_SYNC
  921.     keylset attrs port /dev/$netx
  922.     keylset attrs dialerline -
  923.     keylset attrs speed -
  924.     keylset attrs dialer ISDN
  925.     keylset attrs tokens {}
  926.     set objcall [list ObjectCreate \
  927.         {sco UUCPdevices} DUMMY $attrs]
  928.     set bmipResponse [SaMakeObjectCall $objcall]
  929.     set firstBmip [lindex $bmipResponse 0]
  930.     set errStack [BmipResponseErrorStack firstBmip]
  931.     if { ! [lempty $errStack] } {
  932. #puts stderr "AddOutgoing: $errStack"
  933.     }
  934.     keylset attrs type ISDN_ASYNC
  935.     keylset attrs port /dev/$netx
  936.     keylset attrs dialerline -
  937.     keylset attrs speed -
  938.     keylset attrs dialer ISDN
  939.     keylset attrs tokens {}
  940.     set objcall [list ObjectCreate \
  941.         {sco UUCPdevices} DUMMY $attrs]
  942.     set bmipResponse [SaMakeObjectCall $objcall]
  943.     set firstBmip [lindex $bmipResponse 0]
  944.     set errStack [BmipResponseErrorStack firstBmip]
  945.     if { ![lempty $errStack] } {
  946. #puts stderr "AddOutgoing: $errStack"
  947.     }
  948. }
  949.  
  950.  
  951. #   returns 1 if port monitor is configured with sac, else 0
  952. proc PortMonitorConfigured { portmonitor } \
  953. {
  954.     set results [CallNonStdCmd /usr/sbin/sacadm "-L -p $portmonitor" \
  955.         SCO_NETCONFIG_BE_MSG_SERIAL_OSA errStack]
  956.     
  957.     if {[string length $errStack] == 0} {
  958.         return 1
  959.     } else {
  960.         return 0
  961.     }
  962. }
  963.  
  964. #  configures port monitor with sac
  965. proc ConfigurePortMonitor { portmonitor } \
  966. {
  967.     set results [CallNonStdCmd /usr/sbin/sacadm \
  968.         "-a -p $portmonitor -t isdnmon -c /usr/lib/saf/isdnmon -v 1" \
  969.         SCO_NETCONFIG_BE_MSG_SERIAL_OSA errStack]
  970.     return $results
  971. }
  972.  
  973. # adds a service to the port monitor, starts port monitor if necessary
  974. proc AddIncoming {netx} \
  975. {
  976.     if { ![PortMonitorConfigured isdnmon] } {
  977.         ConfigurePortMonitor isdnmon
  978.     }
  979.  
  980.     set results [CallNonStdCmd /usr/sbin/pmadm "-a -p isdnmon -s $netx -m auto -v 1" \
  981.         SCO_NETCONFIG_BE_MSG_SERIAL_OSA errStack]
  982. }
  983.  
  984. # Build the TREE structure for the main screens
  985. proc BuildMainTree {lan_wan tree_count} \
  986. {
  987.     set x [ GetCurrentChains ]
  988.  
  989.     set mesh [ lindex $x 0 ]
  990.     set confchains [ lindex $x 1 ]
  991.     set mesh [ FilterMesh $mesh $confchains $lan_wan ]
  992.  
  993.     if { $tree_count == "TREE" } {
  994.         set tree [ MeshToTree $mesh MAIN ]
  995.         if { $lan_wan == "WAN_HW" } {
  996. # jaw put serial stuff here
  997. #            set tmp [ GetSerialPorts ]
  998.             set tmp [ serialtree ]
  999. #            set tmp ""
  1000.             foreach tmp2 $tmp {
  1001.                 lappend tree $tmp2
  1002.                 
  1003.             }
  1004.             
  1005. #puts stderr "BluidMainTree ($tmp)"
  1006.  
  1007.         }
  1008.  
  1009. #puts stderr "BluidMainTree ($tree)"
  1010.         flush stderr
  1011.         return $tree
  1012.     } else {
  1013.         set wan_sw_chains 0
  1014.         if { $lan_wan == "WAN" } {        # also count WAN hardware
  1015.             set wan_sw_chains $lanwancount
  1016.             set mesh [ FilterMesh $mesh $confchains WAN_HW ]
  1017.         }
  1018.         return [ expr $wan_sw_chains + $lanwancount ]
  1019.     }
  1020. }
  1021.  
  1022. # Generate parameter list for prompter
  1023. proc PrompterList {basadv adv_button ncfg_element} \
  1024. {
  1025.     global ATTR
  1026.     set Plist ""
  1027.  
  1028.     foreach attr [ keylget ATTR ] {
  1029. #puts stderr "PrompterList $attr: [ keylget ATTR $attr ]"
  1030.         if { [ keylget ATTR $attr.BASADV ] == "$basadv" } {
  1031.             if { [ cequal [ keylget ATTR $attr.VALUES ] "__STRING__" ] } {
  1032.                 if { [ cequal [ keylget ATTR $attr.CURRENT ] "__STRING__" ] } {
  1033.                     keylset ATTR $attr.CURRENT {}
  1034.                 }
  1035.                 lappend Plist "$attr {[ keylget ATTR $attr.LABEL ]} LABEL {[ keylget ATTR $attr.SHELP ]}"
  1036.             } else {
  1037.                 case [ keylget ATTR $attr.CURRENT ] {
  1038.                 __STRING__ {
  1039.                     keylset ATTR $attr.CURRENT {}
  1040.                     lappend Plist "$attr {[ keylget ATTR $attr.LABEL ]} LABEL {[ keylget ATTR $attr.SHELP ]}"
  1041.                 }
  1042.                 __TOGGLE__ {
  1043.                     set inout {}
  1044.                     if [ InDevices $ncfg_element ] {
  1045.                         lappend inout "Outgoing"
  1046.                     }
  1047.                     if [ InPortMonitor $ncfg_element ] {
  1048.                         lappend inout "Incoming"
  1049.                     }
  1050.                     keylset ATTR $attr.CURRENT [ list $inout ]
  1051.                     lappend Plist "$attr {[ keylget ATTR $attr.LABEL ]} TOGGLE {[ keylget ATTR $attr.SHELP ]}"
  1052.                 }
  1053.                 __SKIP__ {
  1054.                 }
  1055.                 __UNUSED__ {
  1056.                 }
  1057.                 default {
  1058.                     lappend Plist "$attr {[ keylget ATTR $attr.LABEL ]} ROLIST {[ keylget ATTR $attr.SHELP ]}"
  1059.                 }
  1060.                 }
  1061.             }
  1062.         }
  1063.     }
  1064.     if { "$basadv" == "BASIC" && $adv_button } {
  1065.         lappend Plist "ADVANCED {[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_ADV_OPTIONS ]} NEWSCREEN {[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_ADV_TITLE ]}"
  1066.     }
  1067. #puts stderr "PrompterList Plist: <$Plist>"
  1068.     return $Plist
  1069. }
  1070.  
  1071.  
  1072. # Prompt communicates with ncfgprompter
  1073. proc Prompt {action item} \
  1074. {
  1075.     global PROMPTER_PATH ATTR
  1076.     set isdn_param __ISDN_inout__
  1077.     set do_adv 0
  1078.     set topo ""
  1079.  
  1080. #puts stderr "Prompt(action=<$action> item=<$item>)"
  1081.  
  1082.     set ATTR ""
  1083.     if { $action == "INIT" } {
  1084.         set bus [ keylget item GHOST.BUS ]
  1085.         set bcfgindex [ keylget item GHOST.BCFGINDEX ]
  1086.         set description [ keylget item GHOST.DESCRIPTION ]
  1087.         set ncfg_element [ keylget item GHOST.NCFGELEMENT ]
  1088.         set topo [ keylget item GHOST.TOPOLOGIES ]
  1089.         set helpfile  [ lindex [ SendNDRequest "SHOWVARIABLE $bcfgindex HELPFILE" ] 0 ]
  1090.     } else {
  1091.         set ncfg_element $item
  1092.         set ndbi [ lindex [ SendNDRequest "ELEMENTTOINDEX $ncfg_element" ] 0 ]
  1093.         set bcfgindex [ keylget ndbi INDEX ]
  1094.         set ndbus [ lindex [ SendNDRequest "SHOWBUS $bcfgindex" ] 0 ]
  1095.         set bus [ keylget ndbus BUS ]
  1096.         set nddesc [ lindex [ SendNDRequest "SHOWNAME $bcfgindex" ] 0 ]
  1097.         set description [ keylget nddesc NAME ]
  1098.         set kkey [ lindex [ SendNDRequest "RESSHOWKEY $ncfg_element" ] 0 ]
  1099.         set key [ keylget kkey KEY ]
  1100.         set ktopo [ lindex [ SendNDRequest "RESGET $key TOPOLOGY,s" ] 0 ]
  1101.         set topo [ keylget ktopo VALUE ]
  1102.         set helpfile  [ lindex [ SendNDRequest "SHOWVARIABLE $bcfgindex HELPFILE" ] 0 ]
  1103.     }
  1104.     set helpfile [ keylget helpfile HELPFILE ]
  1105.     if { $helpfile == "foo bar" } {
  1106.         set helpfile "{} {}"
  1107.     }
  1108.     if { $action == "LIST" } {
  1109.         set umsg [ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_PROMPTER_VIEW_UPPER  [ list $description ] ]
  1110.     } else {
  1111.         set umsg [ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_PROMPTER_UPPER  [ list $description ] ]
  1112.     }
  1113.  
  1114.     set ckey [ lindex [ SendNDRequest "SHOWCUSTOMNUM $bcfgindex" ] 0 ]
  1115.     set custom_params [ keylget ckey CUSTOM_NUM ]
  1116.  
  1117.     if { $bus == "ISA" } {
  1118.         if { $action != "INIT" } {
  1119.             set ic [ lindex [ SendNDRequest "SHOWISACURRENT $ncfg_element" ] 0 ]
  1120.             set isa [ lindex [ SendNDRequest "SHOWALLISAPARAMS $ncfg_element" ] 0 ]
  1121.         } else {
  1122.             set isa [ lindex [ SendNDRequest "SHOWISAPARAMS $bcfgindex" ] 0 ]
  1123.         }
  1124.         foreach param [ keylget isa ] {
  1125.             set vals [ keylget isa $param ]
  1126.             keylset ATTR $param.RESMGR $param
  1127.             keylset ATTR $param.LABEL "[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_$param ]"
  1128.             keylset ATTR $param.BASADV BASIC
  1129.             keylset ATTR $param.SHELP ""
  1130.             keylset ATTR $param.VALUES $vals
  1131.             if { $action != "INIT" } {
  1132.                 keylset ATTR $param.CURRENT [ keylget ic $param ]
  1133.             } else {
  1134.                 keylset ATTR $param.CURRENT [ lindex $vals 0 ]
  1135.                 set aparam "_$param"
  1136.                 if [ keylget item GHOST.$aparam autoval ] {
  1137.                     keylset ATTR $param.CURRENT $autoval
  1138.                 }
  1139.             }
  1140.             set cur [ keylget ATTR $param.CURRENT ]
  1141.             if { [ cequal "$cur" { } ] || [ cequal $cur {} ] } {
  1142.                 keylset ATTR $param.CURRENT __SKIP__
  1143.             }
  1144.         }
  1145.     } else {
  1146.         if { ! $custom_params && "$topo" != "ISDN" } {
  1147.             return "0 $ATTR"
  1148.         }
  1149.     }
  1150.  
  1151.     if { $custom_params } {
  1152.         if { $action != "INIT" } {
  1153.             set cc [ lindex [ SendNDRequest "SHOWCUSTOMCURRENT $ncfg_element" ] 0 ]
  1154.         }
  1155.         for {set i 1} {$i <= $custom_params} {incr i} {
  1156.             set c($i) [ lindex [ SendNDRequest "SHOWCUSTOM $bcfgindex $i" ] 0 ]
  1157.             set cptopo [ keylget c($i) TOPOLOGIES ]
  1158.             set numtopos [ llength $cptopo ]
  1159.             for {set j 0} {$j < $numtopos} {incr j} {
  1160.                 if { [ cequal [lindex $cptopo $j] "$topo" ] } {
  1161.                     break
  1162.                 }
  1163.             }
  1164.             if { $j == $numtopos } {
  1165.                 continue
  1166.             }
  1167.             set param [ keylget c($i) RESMGRPARAM ]
  1168.             keylset ATTR $param.RESMGR $param
  1169.             keylset ATTR $param.CUSTOM 1
  1170.             keylset ATTR $param.LABEL [ keylget c($i) CHOICETITLE ]
  1171.             keylset ATTR $param.BASADV [ keylget c($i) BASADV ]
  1172.             if { [ keylget c($i) BASADV ] == "ADVANCED" } {
  1173.                 set do_adv 1
  1174.             }
  1175.             keylset ATTR $param.SHELP ""
  1176.  
  1177.             set vals [ keylget c($i) CHOICES ]
  1178.             keylset ATTR $param.VALUES $vals
  1179.             set resvals [ keylget c($i) RESVALUES ]
  1180.             keylset ATTR $param.RESVALUES $resvals
  1181.             if { $action != "INIT" } {
  1182.                 keylset ATTR $param.CURRENT [ keylget cc $param ]
  1183.             } else {
  1184.                 keylset ATTR $param.CURRENT [ lindex $vals 0 ]
  1185.                 if [ keylget item GHOST.$param autoval ] {
  1186.  
  1187.                     if { [ cequal $autoval "__UNUSED__" ] } {
  1188.                         keylset ATTR $param.CURRENT $autoval
  1189.                     } else {
  1190.                         set custidx [ lsearch -exact $resvals $autoval ]
  1191.                         if { $custidx != -1 } {
  1192.                             set dispval [ lindex $vals $custidx ]
  1193.                             keylset ATTR $param.CURRENT $dispval
  1194.                         }
  1195.                     }
  1196.                 }
  1197.             }
  1198.         }
  1199.     }
  1200.     if { "$topo" == "ISDN" } {
  1201.         keylset ATTR $isdn_param.RESMGR $isdn_param
  1202.         keylset ATTR $isdn_param.CURRENT __TOGGLE__
  1203.         if { $action == "INIT" } {
  1204.             AddIncoming $ncfg_element
  1205.             AddOutgoing $ncfg_element
  1206.         }
  1207.         keylset ATTR $isdn_param.LABEL "Line Direction"
  1208.         keylset ATTR $isdn_param.VALUES "Incoming Outgoing"
  1209.         keylset ATTR $isdn_param.RESVALUES [ keylget ATTR $isdn_param.VALUES ]
  1210.         keylset ATTR $isdn_param.BASADV BASIC
  1211.         keylset ATTR $isdn_param.SHELP "[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_ISDN_SHELP ]"
  1212.     }
  1213.  
  1214.     set args no_output
  1215.     if { $action == "LIST" } {
  1216.         lappend args readonly
  1217.     }
  1218.     pipe a Pstdin 
  1219.     pipe Pstdout b
  1220.  
  1221.     set childPid [ fork ]
  1222.     case $childPid {
  1223.         -1 {
  1224.             echo "SCO_NETCONFIG_UI_ERR_FORK_FAIL"
  1225.             exit 1
  1226.         }
  1227.         0 {
  1228.             close $Pstdin
  1229.             close $Pstdout
  1230.  
  1231.             dup $a stdin
  1232.             close $a
  1233.  
  1234.             dup $b stdout
  1235.             close $b
  1236.  
  1237.             execl $PROMPTER_PATH "$args"
  1238.         }
  1239.     }
  1240.  
  1241.     close $a
  1242.     close $b
  1243.  
  1244.  
  1245.     while { [ gets $Pstdout line ] != -1 } {
  1246. #puts stderr "line <$line>"
  1247.         case [ lindex $line 0 ] {
  1248.  
  1249.         PAGEINIT {
  1250.             case [ lindex $line 1 ] {
  1251.                 BASIC {
  1252.                     puts $Pstdin "{[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_PROMPTER_TITLE ]} {$umsg} $helpfile {} {}"
  1253.                 }
  1254.                 ADVANCED {
  1255.                     puts $Pstdin "{[ IntlLocalizeMsg SCO_NETCONFIG_BE_MSG_ADV_TITLE ]} {$umsg} $helpfile {} {}"
  1256.                 }
  1257.             }
  1258.         }
  1259.         LIST {
  1260.             puts $Pstdin [ PrompterList [ lindex $line 1 ] $do_adv $ncfg_element ]
  1261.         }
  1262.         CURRENT {
  1263.             set Pcurr ""
  1264.             foreach attr [ keylget ATTR ] {
  1265.                 set cur [ keylget ATTR $attr.CURRENT ]
  1266.                 if { [ cequal "$cur" "__UNUSED__" ] || [ cequal "$cur" "__SKIP__" ] } {
  1267.                     continue
  1268.                 }
  1269.                 if { [ keylget ATTR $attr.BASADV ] ==  [ lindex $line 1 ] } {
  1270.                     lappend Pcurr "$attr 1 [ keylget ATTR $attr.CURRENT ]"
  1271.                 }
  1272.             }
  1273.             puts $Pstdin "$Pcurr"
  1274.         }
  1275.         VALUES {
  1276.             set attr [ lindex $line 1 ]
  1277.             puts $Pstdin "[ keylget ATTR $attr.VALUES ]"
  1278.         }
  1279.         SET {
  1280.             set attr [ lindex $line 1 ]
  1281.             set val [ lrange $line 2 end ]
  1282.             keylset ATTR $attr.CURRENT "$val"
  1283.             puts $Pstdin OK
  1284.         }
  1285.         USER_DONE {
  1286.             puts $Pstdin OK
  1287.             flush $Pstdin
  1288.             # map custom values from prompter labels to RESVALUES for idinstall
  1289.             for {set i 1} {$i <= $custom_params} {incr i} {
  1290.                 set cptopo [ keylget c($i) TOPOLOGIES ]
  1291.                 set numtopos [ llength $cptopo ]
  1292.                 for {set j 0} {$j < $numtopos} {incr j} {
  1293.                     if { [ cequal [lindex $cptopo $j] "$topo" ] } {
  1294.                         break
  1295.                     }
  1296.                 }
  1297.                 if { $j == $numtopos } {
  1298.                     continue
  1299.                 }
  1300.                 set param [ keylget c($i) RESMGRPARAM ]
  1301.                 set choices [ keylget c($i) CHOICES ]
  1302.                 set resvalues [ keylget c($i) RESVALUES ]
  1303.                 set current [ keylget ATTR $param.CURRENT ]
  1304.                 if { [ cequal "$current" "__UNUSED__" ] } {
  1305.                     set custidx [ lsearch -exact $resvalues "__UNUSED__" ]
  1306.                     set current [ lindex $choices $custidx ]
  1307.                 }
  1308.                 keylset ATTR ${param}_.RESMGR ${param}_
  1309.                 keylset ATTR ${param}_.CURRENT $current
  1310.                 set idx -1
  1311.                 if { "$choices" != "__STRING__" } {
  1312.                     set idx [ lsearch $choices $current ]
  1313.                 }
  1314.                 if { $idx != -1 } {
  1315.                     keylset ATTR $param.CURRENT [ lindex $resvalues $idx ]
  1316.                 }
  1317.             }
  1318.             
  1319.             # If this card has been isaautodetected and the IOADDR has been
  1320.             # changed we need to give ndcfg the old IOADDR
  1321.             if { $action == "INIT" } {
  1322.                 if [ keylget ATTR IOADDR.CURRENT curio ] {
  1323.                     if [ keylget item GHOST._IOADDR autoio ] {
  1324.                         if { $curio != $autoio } {
  1325.                             #puts stderr "OLDIO = $curio AUTOIO = $autoio"
  1326.                             keylset ATTR OLDIOADDR.RESMGR "OLDIOADDR"
  1327.                             keylset ATTR OLDIOADDR.CURRENT $autoio
  1328.                         }
  1329.                     }
  1330.                 }
  1331.             } 
  1332.  
  1333. # JAW - not needed for idmodify
  1334. #
  1335. #else {
  1336. #                if [ info exists origioaddr ] {
  1337. #                    if [ keylget ATTR IOADDR.CURRENT curio ] {
  1338. #                        if { $curio != $origioaddr } {
  1339. #puts stderr "ORIGIO = $origioaddr NEWIO = $curio"
  1340. #                            keylset ATTR OLDIOADDR.RESMGR "OLDIOADDR"
  1341. #                            keylset ATTR OLDIOADDR.CURRENT $origioaddr
  1342. #                        }
  1343. #                    }
  1344. #                }
  1345. #            }
  1346.  
  1347.  
  1348.             if { "$topo" == "ISDN" } {
  1349.                 set isdninout [ lindex [ keylget ATTR $isdn_param.CURRENT ] 0 ]
  1350.                 RemoveIncoming $ncfg_element
  1351.                 RemoveOutgoing $ncfg_element
  1352.                 foreach inout $isdninout {
  1353.                     case $inout {
  1354.                     Incoming {
  1355.                         AddIncoming $ncfg_element
  1356.                     }
  1357.                     Outgoing {
  1358.                         AddOutgoing $ncfg_element
  1359.                     }
  1360.                     }
  1361.                 }
  1362.             }
  1363.             break
  1364.         }
  1365.         }
  1366.         flush $Pstdin
  1367.     }
  1368.  
  1369.     set ret [ wait $childPid ]
  1370.     close $Pstdin
  1371.     close $Pstdout
  1372.     return "[ lindex $ret 2 ] [ list $ATTR ]"
  1373. }
  1374.  
  1375.  
  1376. # Send a request to the Network Driver component back end tool, ndcfg
  1377. proc SendNDRequest {request} \
  1378. {
  1379.     global NDstdin NDstdout ErrorCode
  1380.  
  1381. #puts stderr "SendNDRequest(<$request>)"
  1382.     puts $NDstdin $request
  1383.     catch { flush $NDstdin }
  1384.  
  1385.     if { [ gets $NDstdout message ] == -1 } {
  1386.         echo "SCO_NETCONFIG_UI_ERR_BE_SCRIPT_DIED"
  1387.         exit 1
  1388.     }
  1389.     while { [ select "$NDstdout" {} {} 0 ] != {} } {
  1390.         if { [ gets $NDstdout msg ] == -1 } {
  1391.             echo "SCO_NETCONFIG_UI_ERR_BE_SCRIPT_DIED"
  1392.             exit 1
  1393.         }
  1394.         append message $msg
  1395.     }
  1396.     # returns a list, first element is error code, NOERROR is magic string
  1397.     # error code should be an internationalized string name, if not just die
  1398.     set NDResponse [ lindex $message 0 ]
  1399.     if { $NDResponse != "NOERROR" } {
  1400.         echo "SCO_NETCONFIG_UI_ERR_BE_SCRIPT_ERROR $NDResponse"
  1401.         exit 1
  1402.     } else {
  1403.         set message [ lrange $message 1 end ]
  1404.     }
  1405. #puts stderr "SendNDRequest: message <$message>"
  1406.     return $message
  1407. }
  1408.  
  1409. # Build the list structure for the AddHW confirmation box
  1410. proc StartNDSCRIPT {} \
  1411. {
  1412.     global NDstdin NDstdout
  1413.     global NDCFG_PATH
  1414.  
  1415.     pipe a NDstdin 
  1416.     pipe NDstdout b
  1417.  
  1418.     set childPid [ fork ]
  1419.     case $childPid {
  1420.         -1 {
  1421.             #puts stderr "netconfig: Unable to fork back-end-script"
  1422.             echo "SCO_NETCONFIG_UI_ERR_FORK_FAIL"
  1423.             exit 1
  1424.         }
  1425.         0 {
  1426.             close $NDstdin
  1427.             close $NDstdout
  1428.  
  1429.             dup $a stdin
  1430.             close $a
  1431.  
  1432.             dup $b stdout
  1433.             close $b
  1434.  
  1435.  
  1436.  
  1437.             if {[id userid] == "0"} {
  1438.                 execl $NDCFG_PATH "-t -b"
  1439.             } else {
  1440.                 set RETCODE [ catch {  exec /sbin/tfadmin -t NETCFG: $NDCFG_PATH ] } ]
  1441.                 if { $RETCODE == "0" } {
  1442.                     execl /sbin/tfadmin "$NDCFG_PATH -t -b"
  1443.                 } else {
  1444.                     #should never get here  but execl
  1445.                     #just in case 
  1446.                     execl $NDCFG_PATH "-t -b"
  1447.                 }
  1448.             }
  1449.  
  1450.  
  1451. #            execl $NDCFG_PATH "-t -b"
  1452.         }
  1453.     }
  1454.     close $a
  1455.     close $b
  1456. }
  1457.  
  1458. proc StopNDSCRIPT {} \
  1459. {
  1460.     global NDstdin NDstdout
  1461.  
  1462.     if { [ info exists NDstdin ] } {
  1463.         puts $NDstdin QUIT
  1464.         catch { flush $NDstdin }
  1465.         close $NDstdin
  1466.         close $NDstdout
  1467.  
  1468.         unset NDstdin
  1469.     }
  1470. }
  1471.  
  1472. proc GhostTOTree {ghost node} \
  1473. {
  1474.     if { $node == "netX" } {    # called from AddHWVendorList
  1475.         keylset nodeinfo CHAIN [ keylget ghost NCFGELEMENT ]
  1476.         set node net00000000
  1477.     } else {
  1478.         keylset nodeinfo CHAIN $node
  1479.     }
  1480.     keylset nodeinfo INDEX 0
  1481.     keylset nodeinfo CONFIGURED 0
  1482.  
  1483.     keylset result SELECTABLE 1
  1484.     keylset result INDENT 2
  1485.     keylset result NODEINFO $nodeinfo
  1486.     if [ IsNetX $node ] {
  1487.         keylset result DESCRIPTION [ keylget ghost DESCRIPTION ]
  1488.         if { ! [ keylget ghost DANGEROUS_SEARCH detectable ] } {
  1489.             set detectable 0
  1490.         }
  1491.         keylset result DETECTABLE $detectable
  1492.         keylset result ICONLIST [ list 6 20 ]
  1493.         keylset result GHOST $ghost
  1494.     } else {
  1495.         global ELEMENT
  1496.  
  1497.         keylset result DESCRIPTION [keylget ELEMENT($node) DESCRIPTION ]
  1498.         keylset result DETECTABLE 0
  1499.  
  1500.         set up [ keylget ELEMENT($node) UP ]
  1501.         if { [ IsWANInterface $up ] } {
  1502.             keylset result ICONLIST [ list 18 21 ]
  1503.         } else {
  1504.             keylset result ICONLIST [ list 17 22 ]
  1505.         }
  1506.     }
  1507.  
  1508.     return $result
  1509. }
  1510.  
  1511. proc RemoveHW {element} \
  1512. {
  1513.     set NetISL 0
  1514.  
  1515. # puts stderr "RemoveHW($element)\n"
  1516.  
  1517.     RemoveOutgoing $element
  1518.     RemoveIncoming $element
  1519.  
  1520.  
  1521.     set result [ SendNDRequest "IDREMOVE $element $NetISL" ]
  1522.     return $result
  1523. }
  1524.  
  1525. proc TestHW {element} \
  1526. {
  1527. #puts stderr "TestHW($element)"
  1528.     set result [ SendNDRequest "TEST $element" ]
  1529.     return $result
  1530. }
  1531.  
  1532. proc ListORReconfHW {action element} \
  1533. {
  1534.     global ErrorCode
  1535.     set NetISL 0
  1536.     set result ""
  1537.     set idargs {}
  1538.  
  1539. #puts stderr "ListORReconfHW(<$action> <$element>)"
  1540.     set prompter_ret [ Prompt $action $element ]
  1541.     case [ lindex $prompter_ret 0 ] {
  1542.     3 {        # user cancelled prompter session - return OK
  1543.         set result [ list [ list {STATUS cancel} ] ]
  1544.     }
  1545.     0 {
  1546.         set ATTR [ lindex $prompter_ret 1 ]
  1547.         foreach attr [ keylget ATTR ] {
  1548.             case [ keylget ATTR $attr.CURRENT ] {
  1549.             __SKIP__ {}
  1550.             {} {
  1551.                 lappend idargs "[ keylget ATTR $attr.RESMGR ]=__STRING__"
  1552.             }
  1553.             default {
  1554.                 if { [ keylget ATTR $attr.CUSTOM ret ] } {
  1555.                     lappend idargs "[ keylget ATTR $attr.RESMGR ]=\{[ keylget ATTR $attr.CURRENT ]\}"
  1556.                 } else {
  1557.                     lappend idargs "[ keylget ATTR $attr.RESMGR ]=[ keylget ATTR $attr.CURRENT ]"
  1558.                 }
  1559.             }
  1560.             }
  1561.         }
  1562.     }
  1563.     default {
  1564.         set ErrorCode SCO_NETCONFIG_UI_ERR_BE_PROMPTER_FAILED
  1565.         set result [ lindex $prompter_ret 0 ]
  1566.     }
  1567.     }
  1568.     if { $idargs != {} && $action == "RECONF" } {
  1569.         set result [ SendNDRequest "IDMODIFY $element $idargs" ]
  1570.     }
  1571.  
  1572.     return $result
  1573. }
  1574.  
  1575. proc AddHWSelect {lan_wan topo charm item} \
  1576. {
  1577.     global NDVList ErrorCode
  1578.  
  1579.     keylset item GHOST.TOPOLOGIES $topo
  1580.     set FailOver 0
  1581.     set result ""
  1582.  
  1583.     set idargs {}
  1584.     set key [ keylget item GHOST.KEY ]
  1585.     if { $key != {} } {
  1586.         set idargs KEY=$key
  1587.     }
  1588.     set prompter_ret [ Prompt INIT $item ]
  1589. #puts stderr "AddHWSelect: $prompter_ret"
  1590.  
  1591.     case [ lindex $prompter_ret 0 ] {
  1592.     3 {        # user cancelled prompter session - return OK
  1593.         set idargs {}
  1594.         set result [ list [ list {STATUS cancel} ] ]
  1595.     }
  1596.     0 {
  1597.         set ATTR [ lindex $prompter_ret 1 ]
  1598.         foreach attr [ keylget ATTR ] {
  1599.             case [ keylget ATTR $attr.CURRENT ] {
  1600.             __SKIP__ {}
  1601.             {} {
  1602.                 lappend idargs "[ keylget ATTR $attr.RESMGR ]={__STRING__}"
  1603.             }
  1604.             default {
  1605.                 if { [ keylget ATTR $attr.CUSTOM ret ] } {
  1606.                     lappend idargs "[ keylget ATTR $attr.RESMGR ]=\{[ keylget ATTR $attr.CURRENT ]\}"
  1607.                 } else {
  1608.                     lappend idargs "[ keylget ATTR $attr.RESMGR ]=[ keylget ATTR $attr.CURRENT ]"
  1609.                 }
  1610.             }
  1611.             }
  1612.         }
  1613.     }
  1614.     default {
  1615.         set ErrorCode SCO_NETCONFIG_UI_ERR_BE_PROMPTER_FAILED
  1616.         set result [ lindex $prompter_ret 0 ]
  1617.     }
  1618.     }
  1619.     if { $idargs != {}} {
  1620.         set bi [ keylget item GHOST.BCFGINDEX ]
  1621.         case $lan_wan {
  1622.         LAN {
  1623.             set lw 1
  1624.         }
  1625.         WAN {
  1626.             set lw 2
  1627.         }
  1628.         }
  1629.         if { $charm } {
  1630.             lappend idargs __CHARM=1
  1631.         } else {
  1632.             lappend idargs __CHARM=0
  1633.         }
  1634.  
  1635.         set result ""
  1636.         keylset result STATUS IDINSTALL
  1637.         keylset result ARGS [ list IDINSTALL $bi $topo $FailOver $lw $idargs ]
  1638.  
  1639. #puts stderr "ncfgBE result=$result"
  1640.         return [list $result]
  1641. # jaw - never get here
  1642.         set result [ SendNDRequest "IDINSTALL $bi $topo $FailOver $lw $idargs" ]
  1643.     }
  1644.  
  1645.     return $result
  1646. }
  1647.  
  1648. proc IdInstall { args } {
  1649.  
  1650.     set arg2 [ lindex $args 0 ]
  1651. #puts stderr "IdInstall args=$args\n arg2=$arg2"
  1652.  
  1653.     set result [ SendNDRequest "$arg2" ]
  1654.  
  1655.     return $result
  1656.  
  1657. }
  1658.  
  1659.  
  1660. proc AddHWAutoDetect {item searchtype} \
  1661.         {
  1662.     global NDVList
  1663.     
  1664. #puts stderr "AddHWAutoDetect($item)"
  1665.     set list ""
  1666.     
  1667.     set nodeinfo [ keylget item NODEINFO ]
  1668.     set elementname [ keylget nodeinfo CHAIN ]
  1669.     
  1670.     set desc [ keylget item DESCRIPTION ]
  1671.     set found [ keylget item GHOST ]
  1672. #puts stderr "F($found)"
  1673.  
  1674.     set bcfgindex [ keylget found BCFGINDEX ] 
  1675.  
  1676.     case $searchtype {
  1677.     SAFE { 
  1678.         set list [ SendNDRequest "ISAAUTODETECT GET $bcfgindex" ]
  1679.     }
  1680.     DANGEROUS { 
  1681.         set list [ SendNDRequest "DANGEROUSISAAUTODETECT GET $bcfgindex" ]
  1682.     } }
  1683. # puts stderr "L($list)"
  1684.     set tree ""
  1685.  
  1686.     if { $list != "\{ \}" } {
  1687.         foreach i $list {
  1688.             set y [    concat $found $i ] 
  1689. # puts stderr "y($y)"
  1690.             set desc [ keylget y DESCRIPTION ]
  1691.             set ioaddr [ keylget y _IOADDR ]
  1692.             keylset y DESCRIPTION "$desc (IO=$ioaddr)"
  1693.             lappend tree [ GhostTOTree $y $elementname ]
  1694.         }
  1695.     }
  1696.     return $tree
  1697. }
  1698.  
  1699. proc BuildNDHWRoots {} \
  1700. {
  1701.     global ELEMENT
  1702.     global NDHWRoots
  1703.  
  1704.     if { [ info exists NDHWRoots ] } {
  1705.         return
  1706.     }
  1707.     set x [ GetCurrentChains ]
  1708.     set mesh [ lindex $x 0 ]
  1709.  
  1710.     set possible_roots ""
  1711.     foreach i [ array names ELEMENT ] {
  1712.         set down [ keylget ELEMENT($i) DOWN ]
  1713.         if { $down == "NULL" } {
  1714.             lappend possible_roots $i
  1715.         }
  1716.     }
  1717.     set NDHWRoots ""
  1718.     foreach i $possible_roots {
  1719.         set found 0
  1720.         foreach j $mesh {
  1721.             set nodeinfo [ lindex $j 1 ]
  1722.             set element [ keylget nodeinfo CHAIN ]
  1723.             if { $i == $element } {
  1724.                 set found 1
  1725.                 break
  1726.             }
  1727.         }
  1728.         if {!$found} {
  1729.             lappend NDHWRoots $i
  1730.         }
  1731.     }
  1732. }
  1733.  
  1734. proc AddHWSafeDetect { lan_wan } \
  1735. {
  1736.     set result ""
  1737.     set desclist ""
  1738.     set x [ SendNDRequest "RESSHOWUNCLAIMED $lan_wan" ]
  1739.     if { $x != "\{ \}" } {
  1740.         foreach i $x {
  1741.             lappend desclist [ linsert $i 0 "DESCRIPTION \{[ keylget i NAME ]\}" ]
  1742.         }
  1743.         set sortlist [ lsort $desclist ]
  1744.         foreach i $sortlist {
  1745.             lappend result [ GhostTOTree $i "netX" ]
  1746.         }
  1747.     }
  1748.     return $result
  1749. }
  1750.  
  1751. proc AddHWTopologies {lan_wan} \
  1752. {
  1753.     set result ""
  1754.     set Topologies [ SendNDRequest "SHOWALLTOPOLOGIES $lan_wan" ]
  1755.  
  1756.     foreach i $Topologies {
  1757.         keylset i DESCRIPTION [ keylget i FULLNAME ]
  1758.         keylset i ICONLIST " "
  1759.         keylset i SELECTABLE 1
  1760.         keylset i INDENT 1
  1761.         lappend result $i
  1762.     }
  1763.     return $result
  1764. }
  1765.  
  1766. # AddHWVendorList no longer returns existing HardWare devices
  1767. proc AddHWVendorList {lan_wan {topo ""}} \
  1768. {
  1769.     global NDHWRoots NDVList ELEMENT
  1770.  
  1771. #puts stderr "AddHWVendorList(<$lan_wan> <$topo>)"
  1772.  
  1773.     set NDVList ""
  1774.     set result ""
  1775.     set desclist ""
  1776.  
  1777.     if { $lan_wan == "WAN" } {
  1778.         set Topologies [ SendNDRequest "SHOWALLTOPOLOGIES WAN" ]
  1779.         foreach t $Topologies {
  1780.             if [ keylget t TOPOLOGY topo ] {
  1781.                 append NDVList [ SendNDRequest "SHOWTOPO $topo" ]
  1782.             }
  1783.         }
  1784.     } else {
  1785.         set NDVList [ SendNDRequest "SHOWTOPO $topo" ]
  1786.     }
  1787.     foreach i $NDVList {
  1788.         set j [ linsert $i 0 "DESCRIPTION \{[ keylget i NAME ]\}" ]
  1789.         if [ keylget i BUS bustype ] {
  1790.             if { $bustype == "ISA" } {
  1791.                 set hasvrfy [ lindex [ SendNDRequest "BCFGHASVERIFY [ keylget i BCFGINDEX ]" ] 0 ]
  1792.                 if { [ keylget hasvrfy ANSWER ] == "Y" } {
  1793.                     lappend j "DANGEROUS_SEARCH \{1\}"
  1794.                 }
  1795.             }
  1796.         }
  1797.         lappend desclist $j
  1798.     }
  1799.  
  1800. #puts stderr "desclist = $desclist"
  1801.  
  1802.     set sortlist [ lsort $desclist ]
  1803.     foreach i $sortlist {
  1804.         # ODI/DLPI drivers may not have netcfg elements before USER_SELECT
  1805.         # GhostTOTree has a kludge to treat these as netX elements for now
  1806.         lappend result [ GhostTOTree $i netX ]
  1807.     }
  1808.  
  1809. #puts stderr $result
  1810.  
  1811.     return $result
  1812. }
  1813.  
  1814. # Build the TREE structure for the AddSW (and 2nd stage of the AddHW)
  1815. # confirmation box
  1816. proc BuildAddSWTree {nodeinfo} \
  1817. {
  1818.     set x [ GetCurrentChains ]
  1819.     set mesh [ lindex $x 0 ]
  1820.     set configured_chains [ lindex $x 1 ]
  1821.  
  1822.     set chain_list [ GetPossibleChains $configured_chains ]
  1823.  
  1824.     set tree [ list {} $nodeinfo ]
  1825.     foreach i $mesh {
  1826.         set root_ni [ lindex $i 1 ]
  1827.         if { $root_ni == $nodeinfo } {
  1828.             set tree $i
  1829.             break
  1830.         }
  1831.     }
  1832.  
  1833.     set x [ AddOneLayerOfChains [ list $tree ] $chain_list 0 ]
  1834.     set mesh [ lindex $x 0 ]
  1835.  
  1836.     set tree [ MeshToTree $mesh ADD_SW ]
  1837.     return $tree
  1838. }
  1839.  
  1840. proc DeleteFilterTree {tree node node_counts removecount} \
  1841. {
  1842.     global ELEMENT
  1843.  
  1844. #puts stderr "DeleteFilterTree(<$tree> <$node> <$node_counts> <$removecount>)"
  1845.     set nodeinfo [ lindex $tree 1 ]
  1846.  
  1847.     set dep 0
  1848.     foreach nds [ keylget node_counts ] {
  1849.         set count [ keylget node_counts $nds ]
  1850.         if { $nodeinfo == $nds } {
  1851.             if {$nds == $node || $count==$removecount} {
  1852.                 set dep 1
  1853.             }
  1854.         }
  1855.     }
  1856. #puts stderr "DFT nodeinfo <$nodeinfo> dep <$dep>"
  1857.     keylset nodeinfo CONFIGURED [ expr {!$dep} ]
  1858.     set el [ lindex [ keylget nodeinfo CHAIN ]  [ keylget nodeinfo INDEX ] ]
  1859. #puts stderr "DFT el <$el>"
  1860.     keylset nodeinfo HWSW [ keylget ELEMENT($el) HWSW ]
  1861.  
  1862.     set new_tree ""
  1863.     set newdep $dep
  1864.     foreach i [ lindex $tree 0 ] {
  1865.         set x [ DeleteFilterTree $i $node $node_counts $removecount]
  1866.         if { $x != "" } {
  1867.             lappend new_tree $x
  1868.             set newdep 1
  1869.         }
  1870.     }
  1871.     if { $newdep } {
  1872. #puts stderr "NT($new_tree)"
  1873.         set result [ list $new_tree $nodeinfo ]
  1874.     } else {
  1875.         set result ""
  1876.     }
  1877. #puts stderr "R($result)"
  1878.     return $result
  1879. }
  1880.  
  1881. proc I {indent str} \
  1882. {
  1883.     for {set i 0} {$i<$indent} {incr i} {
  1884.         puts stderr "    " nonewline
  1885.     }
  1886.     puts stderr $str
  1887. }
  1888.  
  1889. proc MergeCounts {current new ignore indent} \
  1890. {
  1891.     foreach x [ keylget new ] {
  1892.         set x_c [ keylget new $x ]
  1893. #I $indent "X($x)"
  1894.         set found 0
  1895.         foreach y [ keylget current ] {
  1896.             set y_c [ keylget current $y ]
  1897. #I $indent "Y($y)"
  1898.             if { $x != $ignore && $x == $y } {
  1899.                 set found 1
  1900.                 set total [expr {$y_c+$x_c}]
  1901.                 keylset current $x $total
  1902. #I $indent ">>$x==$total"
  1903.                 break
  1904.             }
  1905.         }
  1906.         if { !$found } {
  1907.             keylset current $x $x_c
  1908. #I $indent "++$x==$x_c"
  1909.         }
  1910.     }
  1911.     return $current
  1912. }
  1913.  
  1914. proc ScanDepNodes {tree dep {indent 0}} \
  1915. {
  1916.     global DepNodes
  1917.  
  1918.     set nodeinfo [ lindex $tree 1 ]
  1919.     set chain [ keylget nodeinfo CHAIN ]
  1920.     set component [ lindex $chain [ keylget nodeinfo INDEX ] ]
  1921. #I $indent "SDN($DepNodes,$chain||$component||,$dep)"
  1922.     set result ""
  1923.     foreach n $DepNodes {
  1924. #I $indent "  N($n) nodeinfo($nodeinfo)"
  1925.  
  1926.         if { $nodeinfo == $n } {
  1927.             set dep 1
  1928.             break
  1929.         }
  1930.     }
  1931.     if { $dep } {
  1932.         keylset result $nodeinfo 1
  1933.     }
  1934. #I $indent " ND($DepNodes)"
  1935.  
  1936.     foreach i [ lindex $tree 0 ] {
  1937.         set d [ ScanDepNodes $i $dep [ expr {$indent+1}]]
  1938.         set result [ MergeCounts $result $d $nodeinfo $indent ]
  1939.     }
  1940.  
  1941. #I $indent "R($result)"
  1942.     return $result
  1943. }
  1944.  
  1945. proc FindDepNodes {tree dep {indent 0}} \
  1946. {
  1947.     global DepNodes
  1948.  
  1949.     set nodeinfo [ lindex $tree 1 ]
  1950.     set chain [ keylget nodeinfo CHAIN ]
  1951.     set component [ lindex $chain [ keylget nodeinfo INDEX ] ]
  1952. #I $indent "FDN($DepNodes,$chain||$component||,$dep)"
  1953.     set found 0
  1954.     foreach n $DepNodes {
  1955. #I $indent "  N($n)"
  1956.         if { $nodeinfo == $n } {
  1957. #I $indent " FOUND($nodeinfo)"
  1958.             set dep 1
  1959.             set found 1
  1960.             break
  1961.         }
  1962.     }
  1963.     if { $dep && !$found } {
  1964. #I $indent " F($chain||$component||)"
  1965.         lappend DepNodes $nodeinfo
  1966.     }
  1967. #I $indent " ND($DepNodes)"
  1968.  
  1969.     foreach i [ lindex $tree 0 ] {
  1970.         FindDepNodes $i $dep [ expr {$indent+1} ]
  1971.     }
  1972. }
  1973.  
  1974. # Build the TREE structure for the DeleteSW confirmation box
  1975. proc BuildDeleteSWTree {node_2_delete} \
  1976. {
  1977.     global DepNodes
  1978.  
  1979. #puts stderr "BuildDeleteSWTree(<$node_2_delete>)"
  1980.     set chain_2_delete [ keylget node_2_delete CHAIN ]
  1981.     set DepNodes [ list $node_2_delete ]
  1982.  
  1983.     set x [ GetCurrentChains ]
  1984.     set mesh [ lindex $x 0 ]
  1985.     set configured_chains [ lindex $x 1 ]
  1986.  
  1987.     foreach root $mesh {
  1988.         FindDepNodes $root 0 1
  1989.     }
  1990.  
  1991. #puts stderr "DepNodes <$DepNodes>"
  1992.  
  1993.     set ndc ""
  1994.     foreach root $mesh {
  1995.         set d [ ScanDepNodes $root 0 1 ]
  1996.         set ndc [ MergeCounts $ndc $d NoChainToIgnore 0 ]
  1997.     }
  1998.     set DepNodes $ndc
  1999. #puts stderr "DepNodes_ndc <$DepNodes>"
  2000.  
  2001.     set deps ""
  2002.     foreach root $mesh {
  2003.         set removecount [ keylget DepNodes $node_2_delete ]
  2004.         set x [ DeleteFilterTree $root $node_2_delete $DepNodes $removecount ]
  2005.         if { $x != "" } {
  2006.             lappend deps $x
  2007.         }
  2008.     }
  2009. #puts stderr "H($deps)"
  2010.     set tree [ MeshToTree $deps DEL_SW ]
  2011.     return $tree
  2012. }
  2013.  
  2014. proc ChainDescription {chain} \
  2015. {
  2016.     global ELEMENT
  2017.  
  2018.     set products ""
  2019.     foreach i $chain {
  2020.         if { [ scan $i "%\[^(\](%\[^)\])" element personality ] != 1 } {
  2021.             SetElement $element $personality
  2022.         } else {
  2023.             SetElement $element
  2024.         }
  2025.         set el $ELEMENT($i)
  2026.         lappend products [ keylget el DESCRIPTION ]
  2027.     }
  2028.     return $products
  2029. }
  2030.  
  2031.  
  2032. # Cleanup: cleans up the mess left after a parital install of a 
  2033. # netdriver.  Run at startup of ncfgBE.
  2034. proc Cleanup { } \
  2035. {
  2036.     global NCFG_INFODIR NCFG_RECONFDIR NCFG_LISTDIR
  2037.     global NCFG_CHAINSFILE
  2038.     set elements ""
  2039.  
  2040.     set chains [ ReadChainsFile ] 
  2041.     foreach chain $chains {
  2042.         while { $chain != "" } {
  2043.             lappend elements [ lvarpop chain ] 
  2044.         }
  2045.     }
  2046.     set elements [ lrmdups $elements ]
  2047.     set infofiles [ readdir $NCFG_INFODIR ]
  2048.     set notinchains [ lindex [ intersect3 $infofiles $elements ] 0 ] 
  2049.     set noinfofile [ lindex [ intersect3 $infofiles $elements ] 2 ] 
  2050.  
  2051. #First cleanup extra NIC files in the info dir
  2052.     foreach element $notinchains {
  2053.         set infoPath $NCFG_INFODIR/$element
  2054.  
  2055.         set drivertype ""
  2056.         set sd [ scancontext create ]
  2057.         set fd [ open $infoPath ]
  2058.         scanmatch $sd "^DRIVER_TYPE=" {
  2059.             set drivertype [ string trim [ csubstr $matchInfo(line) 12 end ] \" ]
  2060.         }
  2061.         scanfile $sd $fd
  2062.         scancontext delete $sd
  2063.         close $fd
  2064.  
  2065.         if { [ lsearch -exact { MDI ODI DLPI } $drivertype ] != -1 } {
  2066.             RemoveHW $element
  2067.         }
  2068.     }
  2069.  
  2070.     if { [ llength $noinfofile ] == 0 } {
  2071.         return
  2072.     }  
  2073.  
  2074. # Now cleanup the chains file
  2075.     set list ""
  2076.     if [ file exists $NCFG_CHAINSFILE ] {
  2077.         set fd [ open $NCFG_CHAINSFILE ]
  2078.     } else {
  2079.         set fd [ open $NCFG_CHAINSFILE w+ ]
  2080.     }
  2081.     set badchains ""
  2082.     while { [ gets $fd line ] != -1 } {
  2083.         set c [ translit "#" " " $line ]
  2084.         if { [ llength $c ] > 0 } {
  2085.             while { $c != "" } {
  2086.                 set element [ lvarpop c ] 
  2087.                 if { [ lsearch -exact $infofiles $element ] == -1 } {
  2088.                     lappend badchains $line 
  2089.                 }
  2090.             }
  2091.         }
  2092.     }
  2093.     close $fd
  2094.  
  2095.     foreach badchain [ lrmdups $badchains ] {
  2096.         RemoveChainEntry $NCFG_CHAINSFILE $badchain
  2097.     }
  2098.  
  2099. }
  2100.  
  2101. proc RemoveChainEntry {file chain {newchain ""}} \
  2102. {
  2103.     global NCFG_TMP_CHAINS_FILE
  2104. #puts stderr "RemoveChainEntry $file $chain $newchain"
  2105.     set ifd [ open $file r ]
  2106.     lassign [ tmpfile $NCFG_TMP_CHAINS_FILE ]  ofd tmpfilename
  2107.     while { [ gets $ifd line ] != -1 } {
  2108.         if { $line != $chain } {
  2109.             puts $ofd $line
  2110.         } else {
  2111.             if { $newchain != "" } {
  2112.                 puts $ofd $newchain
  2113.             }
  2114.         }
  2115.     }
  2116.     close $ofd
  2117.     close $ifd
  2118.  
  2119.     TfadminMv $tmpfilename $file
  2120. }
  2121.  
  2122.  
  2123.  
  2124. # main Main MAIN
  2125. #
  2126. # This portion of the script analyses the requests from the UI and calls
  2127. # the appropriate handler function.  Then it returns the result.  This is
  2128. # done to minimize the complexity of the code in the UI.  Since the interface
  2129. # to this script is well defined, and programatic it can be tested
  2130. # automatically.
  2131.  
  2132. ErrorTopLevelCatch {
  2133. StartNDSCRIPT
  2134. Cleanup
  2135. while { [ gets stdin line ] != -1 } {
  2136.     set ErrorCode "NOERROR"
  2137.     set Output ""
  2138.     case [ lindex $line 0 ] {
  2139.     LAN_WAN_COUNT {
  2140.         set Output [ BuildMainTree [ lindex $line 1 ] COUNT ]
  2141.     }
  2142.     MAIN_TREE {
  2143.         set Output [ BuildMainTree [ lindex $line 1 ] TREE ]
  2144.     }
  2145.     ADD_HW_SAFE_DETECT {
  2146.         set Output [ AddHWSafeDetect [ lindex $line 1 ] ]
  2147.     }
  2148.     ADD_HW_TOPOLOGIES {
  2149.         set Output [ AddHWTopologies [ lindex $line 1 ] ]
  2150.     }
  2151.     ADD_HW_VENDOR_LIST {
  2152.         set Output [ AddHWVendorList LAN [ lindex $line 1 ] ]
  2153.     }
  2154.     ADD_HW_WAN_LIST {
  2155.         set Output [ AddHWVendorList WAN ]
  2156.     }
  2157.     ADD_HW_AUTODETECT {
  2158.         set Output [ AddHWAutoDetect [ lindex $line 1 ] [ lindex $line 2 ] ]
  2159.     }
  2160.     ADD_HW_SELECT {
  2161.         set Output [ AddHWSelect [ lindex $line 1 ] [ lindex $line 2 ] [ lindex $line 3 ] [ lindex $line 4 ] ]
  2162.     }
  2163.     IDINSTALL {
  2164.         set Output [ IdInstall [ lindex $line 1 ] ]
  2165.     }
  2166.     LIST_HW {
  2167.         set Output [ ListORReconfHW LIST [ lindex $line 1 ] ]
  2168.     }
  2169.     RECONF_HW {
  2170.         set Output [ ListORReconfHW RECONF [ lindex $line 1 ] ]
  2171.     }
  2172.     REMOVE_HW {
  2173.         set Output [ RemoveHW [ lindex $line 1 ] ]
  2174.     }
  2175.     TEST_HW {
  2176.         set Output [ TestHW [ lindex $line 1 ] ]
  2177.     }
  2178.     ADD_HW_END {
  2179.         global NDHWRoots
  2180.         if { [ info exists NDHWRoots ] } {
  2181.             unset NDHWRoots
  2182.         }
  2183.     }
  2184.     ADD_SW_TREE {
  2185.         set Output [ BuildAddSWTree [ lindex $line 1 ] ]
  2186.     }
  2187.     DELETE_TREE {
  2188.         set Output [ BuildDeleteSWTree [ lindex $line 1 ] ]
  2189.     }
  2190.     LOOKUP {
  2191.         case [ lindex $line 1 ] {
  2192.         ELEMENT {
  2193.             set Output [ GetElement [ lindex $line 2 ] ]
  2194.         }
  2195.         CHAIN {
  2196.             set Output [ ChainDescription [ lindex $line 2 ] ]
  2197.         }
  2198.         }
  2199.     }
  2200.     default {
  2201.         set ErrorCode "SCO_NETCONFIG_UI_ERR_BE_UNKNOWN_REQ"
  2202.     }
  2203.     }
  2204.     if { "$ErrorCode" != "" } {
  2205.         puts stdout "$ErrorCode $Output"
  2206.     }
  2207.     flush stdout
  2208. }
  2209. set Output [ StopNDSCRIPT ]
  2210. } ncfgBE
  2211.