PC World 2000 December/PCWorld_2000-12_cd.bin/Komunikace/Comanche/plugins/apache/apache.tcl

Text File | 2000-11-02 | 24.4 KB | 789 lines

# apache.tcl

# apachePlugIn --
#    Provides functionality for configuring the Apache webserver
#
# TO-DO: Convert public variables to parameters passed at construction time

class apachePlugIn {
    inherit basePlugIn

    # Object used to convert property pages -> httpd.conf format

    public variable dumper

    # Object used to store/load values from property pages

    public variable ppManager

    # Object carrying definition of  property pages. We can ask it a
    # property page by its name and it will answer.

    public variable ppDef

    # This is not used as of now. It will be used to access configuration files

    public variable configurationFilesManager

    # Namespace we are hooking to

    public variable namespace

    # Used to keep track of which nodes

    public variable nodeManagement

    # Configuration document

    public variable confDoc

    # Assigns ppages to nodes

    public variable moduleManager

    # Comments describing the server

    public variable serverDescription

    # Location of the httpd binary (to get version)

    public variable httpd

    # Location of the configuration files

    public variable configurationFiles

    # Location of the server root

    public variable serverRoot

    # Property pages for enabling/disabling modules

    variable modulePP

    public variable rootNode
    variable mainServer
    variable apacheconf

    variable commands
    variable commandResult
    variable commandPP
    constructor {} {
        array set commands {}
    set commandPP [xuiPropertyPage ::#auto]
    set commandResult [xuiLabel ::#auto]
    $commandPP addComponent $commandResult
    set modulePP [ ::libgui::createXuiFromText {
        <propertyPage name="modulePP" label="module_management">
            <choice name="moduleConf" label="module_conf_PP"
                        classes="multipleChoice">
            <syntax><option name="bla" value="bla" /></syntax>
            <default>bla</default>
            </choice>
        </propertyPage>
    } ]
    #puts "modulePP $modulePP"
    }

    method _registerWithNamespace {}
    method _inquiryForPropertyPages  { node }
    method _inquiryForMenu { node }
    method _inquiryForWizard { type node }
    method _inquiryForRightPaneContent { node }
    method _receivedPropertyPages { node xuiPropertyPages }
    method _receivedWizard { node xuiPropertyPages }
    method _executeCommand { node command }

    method init
    method _createNodes { node }
    method _addNode { node container }
    method _saveConfig { }

    method addNewManagementCommand {command action icon}

    method _deleteNodeRequest
}

# apachePlugIn::addNewManagementCommand --
#   Used to add new management commands that will get displayed in the right
# pane when the server management node is selected

body apachePlugIn::addNewManagementCommand {command action icon} {
    set commands($command) [list $action $icon]
}

body  apachePlugIn::_receivedPropertyPages { node xuiPropertyPages } {
    set container [ $nodeManagement getContainer $node ]
    set name [ $nodeManagement getNodeName $node ]
    switch $name {
    moduleconf {
        set a [$xuiPropertyPages getComponents]

        foreach one [$moduleManager getEnabledModuleList] {
        $moduleManager disableModule $one

        }
        $moduleManager enableModule coredirs
        foreach one [$a.moduleConf getSelected] {
        $moduleManager enableModule $one
        }

        set f [open $::apacheplugin::disabledModulesFile w]
        foreach one [$moduleManager getDisabledModuleList] {
        puts $f $one
        }
        close $f


    } default {
        if [string length $container] {
        foreach pp [$xuiPropertyPages getComponents] {
            $ppManager savePropertyPage $pp $confDoc $container
        }
        }
    }
    }
    _saveConfig
}

body apachePlugIn::_saveConfig {} {

    # TO-DO: Add the capability to have templates. We need a configuration
    # files manager to get rid of this.

    $dumper configure -includeroot [file dirname $configurationFiles]
    $dumper dump $confDoc $configurationFiles

}

body  apachePlugIn::_receivedWizard { node xuiPropertyPages } {
    set container [ $nodeManagement getContainer $node ]
    set name [ $nodeManagement getNodeName $node ]
    switch $name {
        rootNode {
        set name [[[$xuiPropertyPages getComponents] \
            getComponentByName virtualHostName] getValue]
        _addNode $rootNode   [$confDoc addContainer \
            [$confDoc getRootContainer] $name virtualhost]
    }  mainServer - virtualhost {
        set type [[[$xuiPropertyPages getComponents] \
            getComponentByName sectionType] getSelected]
        set name [[[$xuiPropertyPages getComponents] \
            getComponentByName sectionName] getValue]
        _addNode $node \
            [$confDoc addContainer $container $name $type]
    } directory - location  {
        set type [[[$xuiPropertyPages getComponents] \
            getComponentByName sectionType] getSelected]
        set name [[[$xuiPropertyPages getComponents] \
            getComponentByName sectionName] getValue]
        _addNode $node \
            [$confDoc addContainer $container $name $type]
        } default {
       error "Container named $name not recognized"
    }
    }
    _saveConfig
}

body apachePlugIn::init {} {
    _createNodes $rootNode
}

body apachePlugIn::_inquiryForPropertyPages { node } {
    set result {}
    set name [$nodeManagement getNodeName $node]
    set container [$nodeManagement getContainer $node]
    switch $name {
    moduleconf {
        set result ""
        set moduleConf [$modulePP getComponentByName moduleConf]
        $moduleConf clear
        foreach mod [$moduleManager getEnabledModuleList] {
        set text [string toupper \
            [string range $mod 0 0]][string range $mod 1 end]

        if ![string match coredirs $mod] {
            $moduleConf addChoice     $mod $text
            append result " $mod"
        }
        }
        foreach mod [$moduleManager getDisabledModuleList] {
        set text [string toupper \
            [string range $mod 0 0]][string range $mod 1 end]
        if ![string match coredirs $mod] {
            $moduleConf addChoice $mod $text
        }
        }
        $moduleConf selectItem $result
        return $modulePP
    } default {
        # Check which property pages are associated with this type of node

        foreach pp [$moduleManager getPropertyPagesByNodetypeList $name] {
        # PP is a list that contains: pp page name, skill, hookUnder
        set mypp [$ppDef getPPByName [lindex $pp 0]]
        $mypp configure -hookUnder [lindex $pp 2]
        lappend result $mypp

        # We fill the property page with the values that
        # we may already have

        $ppManager loadPropertyPage $mypp $confDoc $container
        }
    }
    }
    return $result
}

body apachePlugIn::_inquiryForWizard { type node } {
    set result {}
    set name [$nodeManagement getNodeName $node]
    set container [$nodeManagement getContainer $node]
    switch $name {
    mainServer - virtualhost {
        set mypp [$ppDef getPPByName directoryAndLocationAddWizard]
        return $mypp
    } directory - location {
        set mypp [$ppDef getPPByName filesAndLimitAddWizard]
        return $mypp
    } rootNode {
        set mypp [$ppDef getPPByName virtualHostAddWizard]
        return $mypp
    }
    }
    return $result
}

body apachePlugIn::_executeCommand { node commandName} {
    global tcl_platform
    set result {}
    set name [$nodeManagement getNodeName $node]
    set container [$nodeManagement getContainer $node]
    switch $tcl_platform(platform) {
    unix {
        catch {eval exec [lindex $commands($commandName) 0]} result
    } windows {
        set result {Commands for starting/stopping, etc do not work yet \
                on Windows. Use the ones included with Apache}
        #global env
        #catch {exec $env(COMSPEC) /c \
            [lindex $commands($commandName) 0]} result
    }
    }
    $commandResult setLabel $result
    return $commandPP
}

# This has to be taken to an external file to be easy to translate.

body apachePlugIn::_inquiryForRightPaneContent { node } {
    set result ""
    set container [$nodeManagement getContainer $node]
    set name [$nodeManagement getNodeName $node]
    switch $name {
       serverinfo {
       append result {<img src="apache_logo">}
       append result "<h1>[mesg::get apache_server_info]</h1>"
       global tcl_platform
       switch $tcl_platform(platform) {
    unix {
       if ![catch {eval exec $httpd -v} info] {
              append result "<pre>$info</pre>"
           } else {
        append result [mesg::get apache_server_info_version_error]
            append result "<pre>$info</pre>"
           }
              if ![catch {eval exec $httpd -l} info] {
              append result "<pre>$info</pre>"
           } else {
        append result [mesg::get apache_server_info_modules_error]
            append result "<pre>$info</pre>"
           }
    } windows {
        set result {Commands for starting/stopping, etc do not work yet \
                on Windows. Use the ones included with Apache}
        #global env
        #catch {exec $env(COMSPEC) /c \
            [lindex $commands($commandName) 0]} result
    }
       }
       }
       moduleconf {
       append result {<img src="apache_logo">}
       append result "<h1>[mesg::get module_management]</h1>"
       append result [mesg::get apache_available_modules]<br>
       append result "<a href=\"command propertyPages\">[mesg::get apache_edit_available_modules]</a>"
       append result "<h2>[mesg::get apache_available_modules_bundled]</h2>"
       foreach mod [$moduleManager getEnabledModuleList] {
      if [expr [lsearch -exact  {access actions alias asis auth auth_anon auth_db auth_dbm
      auth_digest autoindex browser cern_meata cgi cookies digest dir dld dll env
          expires headers imap include info isapi log_agent log_common log_config log_referer
          mime mime_magic mmap_static negotiation proxy rewrite setenvif so speling status userdir
          unique_id usertrack vhost_alias } $mod] != -1] {
          set name [string toupper [string range $mod 0 0]][string range $mod 1 end]
          append result "<br> <img src=\"[$moduleManager getModuleIcon $mod]\"> <b>$name</b>: [$moduleManager getModuleDescription $mod]  "
       }
       }
       append result "<h2>[mesg::get apache_available_modules_thirdparty]</h2>"
       foreach mod [$moduleManager getEnabledModuleList] {
      if [expr [lsearch -exact {coredirs access actions alias asis auth auth_anon auth_db auth_dbm
      auth_digest autoindex browser cern_meata cgi cookies digest dir dld dll env
          expires headers imap include info isapi log_agent log_common log_config log_referer
          mime mime_magic mmap_static negotiation proxy rewrite setenvif so speling status userdir
          unique_id usertrack vhost_alias } $mod ] == -1] {
          set name [string toupper [string range $mod 0 0]][string range $mod 1 end]
          append result "<br> <img src=\"[$moduleManager getModuleIcon $mod]\"> <b>$name</b>: [$moduleManager getModuleDescription $mod]  "
       }
       }
       } apacheconf {
        set result [mesg::get apache_server_management_right_pane]
   foreach {name value} [array get commands] {
       append result "<button image=\"[lindex $value 1]\" \
       command=\"command $name\" > $name<br>"
   }

    } rootNode {
        set result {
 <img src="apache_logo">
 <h1>Apache</h1><br>}
 append result [mesg::get apache_server_root_right_pane_1]
 append result { <b>}
 append result [mesg::get apache_web_server]
 append result {</b>. <br><br>}
 append result [mesg::get apache_you_can]
 append result {:<br> <br> <img src="www"> <a href="command selectNode -namespaceNode }
 append result $mainServer
 append result { ">}
 append result [mesg::get configure]
 append result {</a> }
 append result [mesg::get the_main_web_site]
 append result {<br><br> <img src="wheel"> <a href="command addNewNode">}
 append result [mesg::get Create]
 append result {</a> }
 append result [mesg::get a_new_virtual_host]

 if [string length [set list [$nodeManagement \
     getPlugInNodeChildrenByNodeName $node virtualhost]]] {
     append result  {<br><br>}
     append result [mesg::get or_configure_an_existing_one]
     append result {<br>}
 } else {
     append result {<br><br> }
     append result [mesg::get apache_no_virtualhosts]
     append result {<br>}
     }
     foreach host $list {
     append result {<br> <img src="www"> }
     append result { <a href="command selectNode -namespaceNode }
     append result $host
     append result  { " >}
     append result [join [[$nodeManagement getContainer $host] getName]]
     append result {
        </a>
        <br>
    }
    }
} mainServer {
    append result {
        <img src="apache_logo">
        <h1>}
    append result [mesg::get default_web_server]
    append result {</h1>}
    append result {<br>}
    append result [mesg::get apache_here_you_can_configure_the]
    append result { <a href="command propertyPages">}
    append result [mesg::get default_web_site_properties]
    append result {</a>, }
    append result [mesg::get {which are also the default for all other virtual servers.}]
    append result {<br>}
    append result [mesg::get apache_different_sections]
    append result { <a href="command addNewNode">}
    append result [mesg::get create_a_new_section]
    append result {</a>    <br> <img src="folderBig"><b>}
    append result [mesg::get Directories]
    append result {</b>    <br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node directory]]] {
        append result  {<br><br>}
        append result [mesg::get or_configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br>}
        append result [mesg::get apache_no_directories_defined]
        append result {<br>}
        }
    foreach dir $list {
        append result {<br> <img src="closedFolder"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $dir
    append result  { " >}
    append result [join [[$nodeManagement getContainer $dir] getName]]
    append result {
            </a>      }
    append result {    <br>
    }
    }
    append result {
    <br>
    <img src="locationBig"><b>}
    append result [mesg::get Locations]
    append result {</b><br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node location]]] {
        append result  {<br><br>}
        append result [mesg::get configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br> }
        append result [mesg::get apache_no_locations]
        append result {<br>}
        }
    foreach loc $list {
        append result {<br> <img src="location"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $loc
    append result  { " >}
    append result [join [[$nodeManagement getContainer $loc] getName]]
    append result {
        </a> }
append result {        <br>
    }

    }
    append result {
    <br>
    <img src="filesBig"><b>}
    append result [mesg::get Files]
    append result {</b><br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node files]]] {
        append result  {<br><br>}
            append result [mesg::get configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br> }
        append result [mesg::get apache_no_files]
        append result {<br>}
        }
    foreach loc $list {
        append result {<br> <img src="files"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $loc
    append result  { " >}
    append result [join [[$nodeManagement getContainer $loc] getName]]
    append result {
        </a> }
append result {        <br>
    }

    }
}  directory {
        append result {
        <img src="apache_logo"><br>
        <h1>}
        append result [mesg::get Directory]
        append result { }
        append result  [ $container getName ]
        append result {</h1>
        <br><br>
        <img src="folderBig">}
        append result [mesg::get directory_right_pane]
        append result { <a href="command propertyPages" >}
        append result [mesg::get here]
        append result {</a>}
}  files {
        append result {
        <img src="apache_logo"><br>
        <h1>}
        append result { }
        append result [mesg::get Files]
        append result  [ $container getName ]
        append result {</h1>
        <br><br>
        <img src="filesBig">}
        append result [mesg::get files_right_pane]
            append result { <a href="command propertyPages" >}
            append result [mesg::get here]
        append result {</a>}

} location {
        append result {
        <img src="apache_logo"><br>
        <h1>}
        append result [mesg::get Location]
        append result { }
        append result  [ $container getName ]
        append result {</h1>
        <br><br>
        <img src="locationBig">}
        append result [mesg::get location_right_pane]
        append result { <a href="command propertyPages" >}
            append result [mesg::get here]
            append result {</a>}
} virtualhost {
    set result {
        <img src="apache_logo">
        <h1>}
    append result [mesg::get Virtual_host]
    append result { }
    append    result [$container getName]
    append result    {</h1>
        <br>}
        append result [mesg::get apache_here_you_can_configure_the]
    append result { <a href="command propertyPages">}
    append result [mesg::get properties]
    append result {</a>}
    append result [mesg::get for_this_virtual_host]
    append result {.<br>}
    append result [mesg::get apache_different_sections]
        append result { <a href="command addNewNode">}
    append result [mesg::get create_a_new_section]
    append result {</a><br>}
    append result {<img src="folderBig"><b>}
    append result [mesg::get Directories]
    append result {</b> <br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node directory]]] {
        append result  {<br><br>}
        append result [mesg::get configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br>}
        append result [mesg::get apache_no_directories_defined]
        append result {<br>}
        }
    foreach dir $list {
        append result {<br> <img src="closedFolder"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $dir
    append result  { " >}
    append result [join [[$nodeManagement getContainer $dir] getName]]
    append result {
        </a>  }
    }
append result {
        <br>
}
    append result {
    <br>
    <img src="locationBig"><b>}
    append result [mesg::get Locations]
    append result {</b><br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node location]]] {
        append result  {<br><br>}
        append result [mesg::get configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br> }
        append result [mesg::get apache_no_locations]
        append result {<br>}
        }
    foreach loc $list {
        append result {<br> <img src="location"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $loc
    append result  { " >}
    append result [join [[$nodeManagement getContainer $loc] getName]]
    append result { </a> <br> }
    }
    append result {    <br><img src="filesBig"><b>}
    append result [mesg::get Files]
    append result {</b><br>}
    if [string length [set list [$nodeManagement \
        getPlugInNodeChildrenByNodeName $node files]]] {
        append result  {<br><br>}
            append result [mesg::get configure_an_existing_one]
        append result {<br>}
        } else {
        append result {<br><br> }
        append result [mesg::get apache_no_files]
        append result {<br>}
        }
    foreach loc $list {
        append result {<br> <img src="files"> }
    append result { <a href="command selectNode -namespaceNode }
        append result $loc
    append result  { " >}
    append result [join [[$nodeManagement getContainer $loc] getName]]
    append result {</a> <br>}
    }

  } default {
        set result kkk
    }
    }
    return $result
}

# apachePlugIn::_createNodes --
#   Recursive method that explores a configuration document and creates the
# appropriate nodes.

body apachePlugIn::_createNodes { node } {
    switch [ $nodeManagement getNodeName $node] {
    rootNode {
        set moduleconf [ $nodeManagement addNode  $node\
            -label [mesg::get server_management] \
            -openIcon wheelSmall\
            -classes {container apache} \
            -closedIcon wheelSmall\
            -container [$confDoc getRootContainer]\
            -nodeName apacheconf ]
        set apacheconf [ $nodeManagement addNode  $moduleconf\
            -label [mesg::get module_management] \
            -openIcon moduleManager\
            -classes {leaf apache} \
            -closedIcon moduleManager\
            -container [$confDoc getRootContainer]\
            -nodeName moduleconf ]
        set serverinfo [ $nodeManagement addNode  $moduleconf\
            -label [mesg::get server_info] \
            -openIcon information\
            -classes {leaf apache} \
            -closedIcon information\
            -container [$confDoc getRootContainer]\
            -nodeName serverinfo ]

        _createNodes [set mainServer [ $nodeManagement addNode  $node\
            -label [mesg::get default_web_server] \
            -openIcon mainserver\
            -classes {container apache} \
            -closedIcon mainserver\
            -container [$confDoc getRootContainer]\
            -nodeName mainServer ]]
    } mainServer {
        foreach container \
            [$confDoc getContainers [$confDoc getRootContainer]] {
        switch [ $container getClasses ] {
            directory - location - files {
            _addNode $node $container
            } virtualhost {
            _createNodes [_addNode $rootNode $container]
            }
        }
        }
    } virtualhost {
        foreach container  [$confDoc getContainers \
            [$nodeManagement getContainer $node]] {
        _addNode $node $container
        }
    } directory - location {
        foreach container  [$confDoc getContainers \
        [$nodeManagement getContainer $node]] {
        _addNode $node $container
        }
    } limit - apacheconf - files {
        return
    } default {
        error "Attempted createNodes unrecognized $node \
            node name [ $nodeManagement getNodeName $node] "
    }
    }
}


body apachePlugIn::_addNode { node container } {
    switch [$container getClasses] {
    location {
        $nodeManagement addNode $node\
                -label [join [$container getName]] \
            -openIcon location\
            -closedIcon location\
            -classes {container apache} \
            -container $container\
            -nodeName location
    } directory {
        $nodeManagement addNode $node\
                -label [join [$container getName]] \
            -openIcon closedFolder\
            -classes {container apache} \
            -closedIcon closedFolder\
            -container $container\
            -nodeName directory
    } files {
        $nodeManagement addNode $node\
                -label [join [$container getName]] \
            -openIcon files\
            -classes {leaf apache} \
            -closedIcon files\
            -container $container\
            -nodeName files
    } virtualhost {
        $nodeManagement addNode $node\
                -label [join [$container getName]] \
            -openIcon virtualhost\
            -classes {container apache} \
            -closedIcon virtualhost\
            -container $container\
            -nodeName virtualhost
    }
    }
}


body apachePlugIn::_registerWithNamespace {} {
    global tcl_platform
    set node $rootNode
    set version $serverDescription
    switch $tcl_platform(platform) {
    unix {
        if [catch {append version " [lrange  [exec $httpd -v] 2 2]"}] {
        append version " Apache/unknown"
        }
    } windows {
        global env
        if [catch {append version " [lrange  \
            [exec $env(COMSPEC) /c  $httpd -v] 2 2]"}] {
        append version " Apache/unknown"
        }
    }
    }

    # Now rootNode is no longer root but apache root node

    set rootNode [$nodeManagement addNode $node\
        -label $version \
        -openIcon apache\
        -closedIcon apache\
        -container {}\
        -nodeName rootNode]
}


body apachePlugIn::_deleteNodeRequest { node } {
     set container [$nodeManagement getContainer $node]
     if ![llength $container] {
       #either main plugin node or mangement
       return
     }
     switch [$container getClasses] {
       virtualhost {
           $confDoc removeContainer [$confDoc getRootContainer]\
              $container
           $nodeManagement removeNode $node
       _saveConfig
       } directory - location - files {
           $confDoc removeContainer [$nodeManagement getContainer \
              [$nodeManagement getParentNode $node]] $container
           $nodeManagement removeNode $node
       _saveConfig
       }
       default {}
     }
}