home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / samba / lib / sambaDumper.tcl next >
Encoding:
Text File  |  2000-11-02  |  8.1 KB  |  327 lines
  1.  
  2. # Things we need. 
  3. # - A list with all the synonyms.
  4. # - Location of the smb.conf file
  5. # - Special case mapping both smb.conf -> XML and the inverse (just like apache dumper)
  6. #
  7. # We allow for external files to be included and configured. We just do not allow %
  8. # escaped names
  9.  
  10. class sambaPrettyDumper {
  11.  
  12.     inherit apachePrettyDumper
  13.     
  14.     method getSection
  15.     method dumpRest
  16.     method dumpContainer
  17.     method dumpDirective
  18.     method processSection
  19.     method getLine
  20.     method getTypeOfLine
  21.     method processDirective
  22.  
  23. }
  24.  
  25. body sambaPrettyDumper::getSection {sectionInfo lineList} {
  26.     
  27.     set data [getLine lineList]
  28.     set info [getTypeOfLine $data]
  29.     set section {}
  30.     
  31.     # Only interested in endOfSection of same type, so we can anidate requests
  32.     
  33.     while {![expr [string match [lindex $info  0] beginSection]]} {    
  34.     lappend sectionLines $data
  35.     set data [getLine lineList]
  36.     set info [getTypeOfLine $data]
  37.  
  38.     # Reached end of file
  39.  
  40.     if ![llength $lineList] break
  41.     }
  42.     set lineList [concat $data $lineList]
  43.     return [list $sectionLines $lineList]
  44. }
  45.  
  46.       
  47. body sambaPrettyDumper::dumpRest {} {
  48.     set result \n
  49.     
  50.     # Now we have left the ones that were not found in the template
  51.  
  52.     foreach directive $currentXmlDirectives {
  53.     set dirName [string tolower [$directive getName]]
  54.  
  55. #    # Skip disabled directives
  56. #
  57. #     if ![$moduleManager isDirectiveEnabled $dirName] {
  58. #        continue
  59. #     }  
  60.     if [$directive doYouBelongTo unknownDirective] {
  61.         debug "dumping unknown in dumpRest $directive - [$directive getValue]"
  62.         append result [$directive getValue]\n
  63.     } elseif [info exists specialCaseMapping($dirName)] {
  64.         append result [dumpSpecialCase $dirName $directive]
  65.     } else {
  66.         append result [dumpDirective $directive]
  67.     }
  68.     }
  69.  
  70.  
  71.  
  72.     # Same goes with containers
  73.  
  74.     foreach one $containerList {
  75.     append result [dumpContainer $one]
  76.     set idx [lsearch -exact $containerList $one]
  77.     set containerList [lreplace $containerList $idx $idx]                 
  78.     }
  79.     return $result
  80. }
  81.  
  82. body sambaPrettyDumper::dumpContainer {container} {
  83.     set result {}
  84.     append result "\[[$container getName]\]\n"
  85.     foreach directive [$xmlConfDoc getDirectives $container] {
  86.     set dirName [string tolower [$directive getName]]
  87.     if [info exists specialCaseMapping($dirName)] {
  88.         append result [dumpSpecialCase $dirName $directive]  
  89.     } else {
  90.         append result [dumpDirective $directive]
  91.     }     
  92.     }
  93.  
  94. # No anidated containers in Samba
  95.  
  96. #    foreach childContainer [$xmlConfDoc getContainers $container] {
  97. #    append result [ dumpContainer $childContainer]
  98. #    }
  99.     return $result
  100. }
  101.  
  102. # sectionInfo is a list containing {value class}
  103.  
  104. body sambaPrettyDumper::processSection {sectionInfo data} {
  105.     set result {}
  106.     set value [lindex $sectionInfo 0]
  107.  
  108.     # Save previous state
  109.  
  110.     $xmlDirectivesStack push $currentXmlDirectives
  111.     $currentContainerStack push $currentContainer
  112.  
  113.     # All classes should be the same (sambaContainer). So just look for a match in the name
  114.  
  115.     set matchingContainers {}
  116.     foreach one $containerList {
  117.     if  [string match [$one getName] $value] {
  118.         lappend matchingContainers $one
  119.     }
  120.     }
  121.  
  122.     switch [llength $matchingContainers] {
  123.     0 {
  124.  
  125.         # Do nothing
  126.  
  127.     } 1 {
  128.  
  129.         set matchingContainer $matchingContainers
  130.  
  131.         # Remove container from list
  132.  
  133.         set idx [lsearch -exact $containerList $matchingContainer]
  134.         set containerList [lreplace $containerList $idx $idx]                 
  135.         $containerListStack push $containerList
  136.  
  137.         set currentXmlDirectives [$xmlConfDoc getDirectives $matchingContainer]
  138.         set currentContainer $matchingContainer
  139.         set containerList [$xmlConfDoc getContainers $matchingContainer]
  140.  
  141.         append result "\[[$matchingContainer getName]\]\n"
  142.  
  143.         append result [parseText $data]
  144.         append result [dumpRest]
  145.  
  146.         set containerList [$containerListStack pop]        
  147.     } default {
  148.         
  149.         # Should not more than one container in Samba
  150.     
  151. #        set commented {
  152. #
  153. #        # By now, just ignore 
  154. #        # To-do finish this
  155. #        # Address name based virtualhost
  156. #        
  157. #        if [string match $class virtualhost] {
  158. #            # Check for servernames
  159. #        }
  160. #        }
  161.     }
  162.     }
  163.  
  164.     set currentXmlDirectives [$xmlDirectivesStack pop]
  165.     set currentContainer [$currentContainerStack pop]
  166.  
  167.  
  168.     return $result
  169. }
  170.  
  171. body sambaPrettyDumper::getLine { lineList } {
  172.     upvar $lineList list
  173.     set result [lindex $list 0]
  174.     set list [lrange $list 1 end]
  175.     return $result
  176. }
  177.  
  178. body sambaPrettyDumper::getTypeOfLine { line } {
  179.  
  180.     # In Samba, all sections have the same 
  181.  
  182.     set data [string trim $line]
  183.     if {[regexp "^#+" $data] || ![string length $data] || [regexp {^;} $data]} {
  184.     return comment
  185.     } elseif [regexp "^include (.*)" [string tolower $data] dummy fileName] {
  186.  
  187.     # By now, include directives are ignored until we handle them properly
  188.     # (fix includeroot)
  189.  
  190.     return directive
  191.  
  192.     # Only include files that are not % substituted
  193.     # If that is the case, just ignore it and leave it as-is (directive)
  194.     
  195.     if [string match *%* $fileName] {
  196.         return directive
  197.     }
  198.     return [list include $fileName]
  199.     } elseif [regexp {^\[(.*)\]} $data dummy name] {
  200.     # If the regular expresion has [] on it, braces, not quotes
  201.     
  202.  
  203.     # All containers in Samba have same class
  204.  
  205.     return [list beginSection [list $name sambaContainer]]
  206.     } else {
  207.     return directive
  208.     }       
  209.  
  210. }
  211.  
  212. body sambaPrettyDumper::processDirective {data} {
  213.  
  214.     set result {}
  215.  
  216.     # TODO: check if belongs to disabled module and return if so.
  217.     
  218.     set dirName [string tolower \
  219.         [lindex [set elements \
  220.         [ ::sambautils::getElements $data ]] 0]]
  221.  
  222.     # Check here synonyms
  223.  
  224.     if [ isSpecialCase $dirName ] {   
  225.  
  226.     set xuiDirectiveName [string tolower $specialCaseDirectiveMapping($dirName)]
  227.  
  228.     # check if currentXMLDirectives contains xuiDirective associated
  229.     # with this special case
  230.  
  231.     if [llength [set xuiDirective [ getXmlDirectivesWithThatName $xuiDirectiveName ]]] {
  232.  
  233.         # yes -> process it append to result
  234.         #        delete from currentXml
  235.         
  236.         set result [dumpSpecialCase $xuiDirectiveName $xuiDirective] 
  237.         set idx [lsearch -exact $currentXmlDirectives $xuiDirective]
  238.         set currentXmlDirectives [lreplace $currentXmlDirectives $idx $idx]         
  239.         return $result
  240.     } else {
  241.  
  242.         # no -> We already processed it return nothing
  243.  
  244.         return {}
  245.     }
  246.  
  247.     }
  248.  
  249.     if [llength [set list [ getXmlDirectivesWithThatName $dirName ]]] {
  250.     
  251.     # yes --> process it append to result
  252.     #         delete from currentXmlDirectives
  253.  
  254.     # switch depending if unknown or not
  255.  
  256.     foreach one $list {
  257.         if [$one doYouBelongTo unknownDirective] {
  258.         append result [$one getValue]\n
  259.         } else {
  260.         append result [dumpDirective $one]
  261.         }
  262.         set idx [lsearch -exact $currentXmlDirectives $one]
  263.         set currentXmlDirectives [lreplace $currentXmlDirectives $idx $idx]         
  264.     }
  265.     return $result
  266.     }
  267.     
  268.     
  269.     # If we are here it was not found, so we ignore it
  270.  
  271.     return {}
  272.  
  273. }
  274.  
  275. body sambaPrettyDumper::dumpDirective {directive} {
  276.     set result {}
  277.     if [$directive doYouBelongTo unknownDirective] {
  278.     set result "[$directive getValue]\n"
  279.     return $result
  280.     }    
  281.     set dirName [string tolower [$directive getName]]
  282.     switch [$directive getXuiClass] {
  283.     string - number  {
  284.         set value [$directive getValue]
  285.         if [string compare $value [$directive getDefault]] {
  286.         set value [$directive getValue]
  287.         if {[$directive doYouBelongTo file] || \
  288.             [$directive doYouBelongTo directory] } {
  289.             if [regexp {\ } $value] {
  290.             set value "\"$value\""
  291.             }
  292.         }
  293.         append result "[split $dirName _] = $value\n" 
  294.         }
  295.     } boolean {
  296.         set value [$directive getValue]
  297.         if [string compare $value [$directive getDefault]] {
  298.         switch $value {
  299.             0 {
  300.             append result "[split $dirName _] =  no\n"
  301.             } 1 {
  302.             append result "[split $dirName _] = yes\n"
  303.             }
  304.         }
  305.         }
  306.     } choice {
  307.  
  308.         # TO-DO: Check if it is multiple choice
  309.  
  310.         if ![string match [$directive getName] [$directive getDefault]] {
  311.         append result \
  312.             "[split $dirName _] = [$directive getSelected]\n"     
  313.         }
  314.     } default {
  315.         error "No special case and not recognized in dumping\
  316.             [$directive getXuiClass] [$directive getName]"
  317.     }
  318.     }
  319.     if ![string length [string trim $result]] {
  320.     return {}
  321.     } else {
  322.     return $result
  323.     }    
  324. }
  325.                    
  326.  
  327.