home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / plugins / apache / specialCases.tcl < prev   
Text File  |  2000-11-02  |  9KB  |  289 lines
  1. namespace eval ::apache:: {}
  2.  
  3. proc ::apache::parseBindAddress \
  4.     {elements parser dirDef xmlConf currentContainer} {
  5.     set value [lindex $elements 1]
  6.     set xuiObj [apacheparserutils::getOrCreateIfNotExists bindAddress \
  7.         $dirDef $xmlConf $currentContainer]
  8.     switch $value {
  9.     * {
  10.         $xuiObj  selectComponentByName allAddresses
  11.     } default {
  12.         $xuiObj  selectComponentByName specific
  13.         [$xuiObj getComponentByName specific] setValue $value
  14.     }
  15.     }
  16. }
  17.  
  18. proc ::apache::dumpBindAddress { xuiObj } {
  19.     switch [$xuiObj getSelectedComponentName] {
  20.     allAddresses {
  21.         return "bindaddress *\n"
  22.     } default {
  23.         return "bindaddress [$xuiObj getText]\n"
  24.     }
  25.     }
  26. }
  27.  
  28.  
  29. proc ::apache::parseErrorLog \
  30.     {elements parser dirDef xmlConf currentContainer} {
  31.     set value [lindex $elements 1]
  32.     set xuiObj [apacheparserutils::getOrCreateIfNotExists errorLog \
  33.         $dirDef $xmlConf $currentContainer]
  34.     if [regexp syslog $value] {
  35.     $xuiObj selectComponentByName syslog
  36.     [$xuiObj getComponentByName syslog] setValue \
  37.         [lindex [split $value :] 1]
  38.     } else {
  39.     $xuiObj selectComponentByName file
  40.     [$xuiObj getComponentByName file] setValue $value
  41.     }
  42.     
  43. }
  44.  
  45. proc ::apache::dumpErrorLog { xuiObj } {
  46.     switch [$xuiObj getSelectedComponentName] {
  47.     syslog {
  48.         set result "errorlog syslog"
  49.             if [string length [set value \
  50.             [[$xuiObj getComponentByName syslog] getValue]]] {
  51.         append result ":[[$xuiObj getComponentByName syslog] getValue]"
  52.         }
  53.         append result "\n"
  54.         return $result
  55.     } default {
  56.         return "errorlog [[$xuiObj getComponentByName file] getValue]\n"
  57.     }
  58.     }
  59. }
  60.  
  61. proc ::apache::parseAlias {elements parser dirDef xmlConf currentContainer} {
  62.     
  63.     set name [string tolower [lindex $elements 0]]
  64.     set origin [lindex $elements 1]
  65.     set destination [lindex $elements 2]
  66.     
  67.     switch $name {
  68.     alias { 
  69.         set directiveName alias
  70.         set specific normal
  71.     }
  72.     aliasmatch {
  73.         set directiveName alias
  74.         set specific regexp
  75.     } scriptalias {
  76.         set directiveName scriptAlias
  77.         set specific normal
  78.     } scriptaliasmatch {
  79.         set directiveName scriptAlias
  80.         set specific regexp
  81.     } default {
  82.         error "unrecognized name $name"
  83.     }
  84.     }
  85.     set xuiObj [apacheparserutils::getOrCreateIfNotExists $directiveName \
  86.     $dirDef $xmlConf $currentContainer]    
  87.     set newElement [ $xuiObj newChild ]
  88.     $xuiObj insertChild $newElement
  89.     $newElement selectComponentByName $specific
  90.     set object [$newElement getComponentByName $specific]
  91.     [$object getComponentByName origin] setValue $origin
  92.     [$object getComponentByName destination] setValue $destination
  93. }
  94.  
  95. proc ::apache::dumpAlias { xuiObj } {
  96.     set result {}
  97.     foreach child [ $xuiObj getChildren ] {
  98.     switch [$xuiObj getName] {
  99.         alias {
  100.         switch [[ set dir [$child getSelectedComponent]] getName] {
  101.             normal {
  102.             set directiveName alias
  103.             } regexp {
  104.             set directiveName aliasmatch
  105.             } default {
  106.             error "Error: alias"
  107.             }
  108.         }
  109.         }
  110.         scriptAlias {
  111.         switch [[ set dir [$child getSelectedComponent]] getName] {
  112.             normal {
  113.             set directiveName scriptalias
  114.             } regexp {
  115.             set directiveName scriptaliasmatch
  116.             } default {
  117.             error "Error: scriptalias"
  118.             }
  119.         }
  120.         } default {
  121.         error "Error: this is not supposed. \
  122.             Alias only alias and scriptalias"
  123.         }
  124.     }
  125.     set origin [[$dir getComponentByName origin] getValue]
  126.     set destination [[$dir getComponentByName destination] getValue]
  127.     append result "$directiveName $origin $destination\n"
  128.     }
  129.     return $result
  130. }
  131.  
  132.  
  133. proc ::apache::parseAccess {elements parser dirDef xmlConf currentContainer} {
  134.     set xuiObj [apacheparserutils::getOrCreateIfNotExists access \
  135.             $dirDef $xmlConf $currentContainer]
  136.     set name [string tolower [lindex $elements 0]]
  137.     if [regexp env [lindex $elements 2] ] {
  138.     set environment 1
  139.     set variable [lindex [split [lindex $elements 2] =] 1]
  140.     set newElement [ $xuiObj newChild ]
  141.     $xuiObj insertChild $newElement
  142.     $subject selectComponentByName env
  143.     [$subject getComponentByName env] setValue $variable
  144.     } else {
  145.     foreach host [lrange $elements 2 end ] {
  146.         set newElement [ $xuiObj newChild ]
  147.         $xuiObj insertChild $newElement
  148.         [$newElement getComponentByName action] selectItem $name
  149.         set subject [$newElement getComponentByName subject]
  150.         $subject selectComponentByName host
  151.         set hostAlternate [$subject getComponentByName host]
  152.         switch $host {
  153.         all {
  154.             $hostAlternate selectComponentByName all
  155.         } default {
  156.             $hostAlternate selectComponentByName ipDom
  157.             [$hostAlternate getComponentByName ipDom] setValue $host
  158.         }
  159.         }
  160.     }
  161.     }
  162. }
  163.  
  164. proc ::apache::dumpAccess { xuiObj } {
  165.     set result {}
  166.     foreach child [ $xuiObj getChildren ] {
  167.     append result "[[$child getComponentByName action] getSelected] from "
  168.     set subject [$child getComponentByName subject]
  169.     switch  [$subject getSelectedComponentName] {
  170.         env {
  171.         append result \
  172.             "env=[[$subject getSelectedComponent] getValue]\n"
  173.         } host {
  174.         switch [[$subject getSelectedComponent] \
  175.             getSelectedComponentName] {
  176.             all {
  177.             append result "all\n"
  178.             } default {
  179.             append result "[[[$subject getSelectedComponent] \
  180.                 getSelectedComponent] getValue]\n"
  181.             }
  182.         }
  183.         } default {
  184.         error " [$subject getSelectedComponentName] "
  185.         }
  186.         
  187.     }
  188.     }
  189.     return $result
  190. }
  191.  
  192.  
  193. proc ::apache::parseRedirect \
  194.     {elements parser dirDef xmlConf currentContainer} {
  195.     set xuiObj [apacheparserutils::getOrCreateIfNotExists redirect \
  196.             $dirDef $xmlConf $currentContainer]
  197.     set name [string tolower [lindex $elements 0]]
  198.     if {[string length $elements] = 4} {
  199.     parseutils::loadInComponent $xuiObj statusCode [lindex $elements 1]
  200.     set elements [lrange $elements 2 end]
  201.     } else {
  202.     parseutils::loadInComponent $xuiObj statusCode temp
  203.     }
  204.     set origin [lindex $elements 0]
  205.     set destination [lindex $elements 1]
  206.     switch $name {
  207.     redirect { 
  208.         set directiveName alias
  209.         set specific normal
  210.     }
  211.     redirectmatch {
  212.         set directiveName alias
  213.         set specific regexp
  214.     }
  215.     }
  216.     set newElement [ $xuiObj newChild ]
  217.     $xuiObj insertChild $newElement
  218.     $newElement selectComponentByName $specific
  219.     set object [[$newElement getComponentByName redirect]\
  220.         getComponentByName $specific]
  221.     [$object getComponentByName origin] setValue $origin
  222.     [$object getComponentByName destination] setValue $destination
  223. }
  224.  
  225. proc ::apache::dumpRedirect { xuiObj } {
  226.     set result {}
  227.     foreach child [ $xuiObj getChildren ] {
  228.     switch [[ set dir [[$child getComponentByName redirect] \
  229.         getSelectedComponent]] getName] {
  230.         normal {
  231.         set directiveName redirect
  232.         } regexp {
  233.         set directiveName redirectmatch
  234.         } default {
  235.         error "Error: redirect"
  236.         }
  237.     }
  238.     set origin [[$dir getComponentByName origin] getValue]
  239.     set destination [[$dir getComponentByName destination] getValue]
  240.     set code [[$child getComponentByName statusCode] getValue]
  241.     append result "$directiveName $code $origin $destination\n"
  242.     }
  243.     return $result
  244. }
  245.  
  246. proc ::apache::parseRequire {elements parser dirDef xmlConf currentContainer} {
  247.     set xuiObj [apacheparserutils::getOrCreateIfNotExists require \
  248.             $dirDef $xmlConf $currentContainer]
  249.     set type [lindex $elements 1] 
  250.     switch $type {
  251.        valid-user {
  252.        [$xuiObj getComponentByName validUser] setValue
  253.        } user - group {
  254.        set list [$xuiObj getComponentByName ${type}s]
  255.        foreach item [lrange $elements 2 end] {
  256.            set newElement [$list newChild]
  257.            $list insertChild $newElement
  258.            $newElement setValue $item
  259.        }
  260.        } default {
  261.        error
  262.        }
  263.    }
  264. }
  265.  
  266. proc ::apache::dumpRequire {xuiObj} {
  267.     set result {}
  268.     if [ [$xuiObj getComponentByName validUser] getValue] {
  269.         append result "require valid-user\n"
  270.     }
  271.     set list [[$xuiObj getComponentByName users] getChildren]
  272.     if [llength $list] {
  273.     append result "require user "
  274.     foreach element $list {
  275.         append result [$element getValue]
  276.     }
  277.        append result "\n"
  278.     }
  279.     set list [[$xuiObj getComponentByName groups] getChildren]
  280.     if [llength $list] {
  281.     append result "require group "
  282.     foreach element $list {
  283.         append result [$element getValue]
  284.     }
  285.     append result "\n"       
  286.     }    
  287.     return $result
  288. }
  289.