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

Text File | 2000-11-02 | 8.4 KB | 289 lines

namespace eval ::apache:: {}

proc ::apache::parseBindAddress \
    {elements parser dirDef xmlConf currentContainer} {
    set value [lindex $elements 1]
    set xuiObj [apacheparserutils::getOrCreateIfNotExists bindAddress \
        $dirDef $xmlConf $currentContainer]
    switch $value {
    * {
        $xuiObj  selectComponentByName allAddresses
    } default {
        $xuiObj  selectComponentByName specific
        [$xuiObj getComponentByName specific] setValue $value
    }
    }
}

proc ::apache::dumpBindAddress { xuiObj } {
    switch [$xuiObj getSelectedComponentName] {
    allAddresses {
        return "bindaddress *\n"
    } default {
        return "bindaddress [$xuiObj getText]\n"
    }
    }
}


proc ::apache::parseErrorLog \
    {elements parser dirDef xmlConf currentContainer} {
    set value [lindex $elements 1]
    set xuiObj [apacheparserutils::getOrCreateIfNotExists errorLog \
        $dirDef $xmlConf $currentContainer]
    if [regexp syslog $value] {
    $xuiObj selectComponentByName syslog
    [$xuiObj getComponentByName syslog] setValue \
        [lindex [split $value :] 1]
    } else {
    $xuiObj selectComponentByName file
    [$xuiObj getComponentByName file] setValue $value
    }

}

proc ::apache::dumpErrorLog { xuiObj } {
    switch [$xuiObj getSelectedComponentName] {
    syslog {
        set result "errorlog syslog"
            if [string length [set value \
            [[$xuiObj getComponentByName syslog] getValue]]] {
        append result ":[[$xuiObj getComponentByName syslog] getValue]"
        }
        append result "\n"
        return $result
    } default {
        return "errorlog [[$xuiObj getComponentByName file] getValue]\n"
    }
    }
}

proc ::apache::parseAlias {elements parser dirDef xmlConf currentContainer} {

    set name [string tolower [lindex $elements 0]]
    set origin [lindex $elements 1]
    set destination [lindex $elements 2]

    switch $name {
    alias {
        set directiveName alias
        set specific normal
    }
    aliasmatch {
        set directiveName alias
        set specific regexp
    } scriptalias {
        set directiveName scriptAlias
        set specific normal
    } scriptaliasmatch {
        set directiveName scriptAlias
        set specific regexp
    } default {
        error "unrecognized name $name"
    }
    }
    set xuiObj [apacheparserutils::getOrCreateIfNotExists $directiveName \
    $dirDef $xmlConf $currentContainer]
    set newElement [ $xuiObj newChild ]
    $xuiObj insertChild $newElement
    $newElement selectComponentByName $specific
    set object [$newElement getComponentByName $specific]
    [$object getComponentByName origin] setValue $origin
    [$object getComponentByName destination] setValue $destination
}

proc ::apache::dumpAlias { xuiObj } {
    set result {}
    foreach child [ $xuiObj getChildren ] {
    switch [$xuiObj getName] {
        alias {
        switch [[ set dir [$child getSelectedComponent]] getName] {
            normal {
            set directiveName alias
            } regexp {
            set directiveName aliasmatch
            } default {
            error "Error: alias"
            }
        }
        }
        scriptAlias {
        switch [[ set dir [$child getSelectedComponent]] getName] {
            normal {
            set directiveName scriptalias
            } regexp {
            set directiveName scriptaliasmatch
            } default {
            error "Error: scriptalias"
            }
        }
        } default {
        error "Error: this is not supposed. \
            Alias only alias and scriptalias"
        }
    }
    set origin [[$dir getComponentByName origin] getValue]
    set destination [[$dir getComponentByName destination] getValue]
    append result "$directiveName $origin $destination\n"
    }
    return $result
}


proc ::apache::parseAccess {elements parser dirDef xmlConf currentContainer} {
    set xuiObj [apacheparserutils::getOrCreateIfNotExists access \
            $dirDef $xmlConf $currentContainer]
    set name [string tolower [lindex $elements 0]]
    if [regexp env [lindex $elements 2] ] {
    set environment 1
    set variable [lindex [split [lindex $elements 2] =] 1]
    set newElement [ $xuiObj newChild ]
    $xuiObj insertChild $newElement
    $subject selectComponentByName env
    [$subject getComponentByName env] setValue $variable
    } else {
    foreach host [lrange $elements 2 end ] {
        set newElement [ $xuiObj newChild ]
        $xuiObj insertChild $newElement
        [$newElement getComponentByName action] selectItem $name
        set subject [$newElement getComponentByName subject]
        $subject selectComponentByName host
        set hostAlternate [$subject getComponentByName host]
        switch $host {
        all {
            $hostAlternate selectComponentByName all
        } default {
            $hostAlternate selectComponentByName ipDom
            [$hostAlternate getComponentByName ipDom] setValue $host
        }
        }
    }
    }
}

proc ::apache::dumpAccess { xuiObj } {
    set result {}
    foreach child [ $xuiObj getChildren ] {
    append result "[[$child getComponentByName action] getSelected] from "
    set subject [$child getComponentByName subject]
    switch  [$subject getSelectedComponentName] {
        env {
        append result \
            "env=[[$subject getSelectedComponent] getValue]\n"
        } host {
        switch [[$subject getSelectedComponent] \
            getSelectedComponentName] {
            all {
            append result "all\n"
            } default {
            append result "[[[$subject getSelectedComponent] \
                getSelectedComponent] getValue]\n"
            }
        }
        } default {
        error " [$subject getSelectedComponentName] "
        }

    }
    }
    return $result
}


proc ::apache::parseRedirect \
    {elements parser dirDef xmlConf currentContainer} {
    set xuiObj [apacheparserutils::getOrCreateIfNotExists redirect \
            $dirDef $xmlConf $currentContainer]
    set name [string tolower [lindex $elements 0]]
    if {[string length $elements] = 4} {
    parseutils::loadInComponent $xuiObj statusCode [lindex $elements 1]
    set elements [lrange $elements 2 end]
    } else {
    parseutils::loadInComponent $xuiObj statusCode temp
    }
    set origin [lindex $elements 0]
    set destination [lindex $elements 1]
    switch $name {
    redirect {
        set directiveName alias
        set specific normal
    }
    redirectmatch {
        set directiveName alias
        set specific regexp
    }
    }
    set newElement [ $xuiObj newChild ]
    $xuiObj insertChild $newElement
    $newElement selectComponentByName $specific
    set object [[$newElement getComponentByName redirect]\
        getComponentByName $specific]
    [$object getComponentByName origin] setValue $origin
    [$object getComponentByName destination] setValue $destination
}

proc ::apache::dumpRedirect { xuiObj } {
    set result {}
    foreach child [ $xuiObj getChildren ] {
    switch [[ set dir [[$child getComponentByName redirect] \
        getSelectedComponent]] getName] {
        normal {
        set directiveName redirect
        } regexp {
        set directiveName redirectmatch
        } default {
        error "Error: redirect"
        }
    }
    set origin [[$dir getComponentByName origin] getValue]
    set destination [[$dir getComponentByName destination] getValue]
    set code [[$child getComponentByName statusCode] getValue]
    append result "$directiveName $code $origin $destination\n"
    }
    return $result
}

proc ::apache::parseRequire {elements parser dirDef xmlConf currentContainer} {
    set xuiObj [apacheparserutils::getOrCreateIfNotExists require \
            $dirDef $xmlConf $currentContainer]
    set type [lindex $elements 1]
    switch $type {
       valid-user {
       [$xuiObj getComponentByName validUser] setValue
       } user - group {
       set list [$xuiObj getComponentByName ${type}s]
       foreach item [lrange $elements 2 end] {
           set newElement [$list newChild]
           $list insertChild $newElement
           $newElement setValue $item
       }
       } default {
       error
       }
   }
}

proc ::apache::dumpRequire {xuiObj} {
    set result {}
    if [ [$xuiObj getComponentByName validUser] getValue] {
        append result "require valid-user\n"
    }
    set list [[$xuiObj getComponentByName users] getChildren]
    if [llength $list] {
    append result "require user "
    foreach element $list {
        append result [$element getValue]
    }
       append result "\n"
    }
    set list [[$xuiObj getComponentByName groups] getChildren]
    if [llength $list] {
    append result "require group "
    foreach element $list {
        append result [$element getValue]
    }
    append result "\n"
    }
    return $result
}