File: apacheu.tcl

package info (click to toggle)
moodss 19.7-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 6,136 kB
  • ctags: 3,149
  • sloc: tcl: 49,048; ansic: 187; perl: 178; makefile: 166; sh: 109; python: 65
file content (46 lines) | stat: -rw-r--r-- 2,068 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: apacheu.tcl,v 1.20 2005/01/02 00:45:07 jfontain Exp $

package provide apacheutilities [lindex {$Revision: 1.20 $} 1]
package require http 2


namespace eval apache {

    # works for both apache and apachex modules, flag can be ?auto, ?notable, ...
    proc url {optionsName hostName moduleName {flag {}}} {
        upvar 1 $optionsName options
        upvar 1 $hostName host

        if {![catch {set url $options(--remote)}] || ![catch {set url $options(-r)}]} {
            if {[string first ? $url] >= 0} {                                                       ;# we specify the flag ourselves
                error "usage: moodss ... $moduleName \[-r|--remote\] \[http://\]host\[statusLocator\] ..."
            }
            regsub {/$} $url {} url                                                              ;# eventually remove trailing slash
            if {![regexp {[^/]/[^/]} $url]} {                                                    ;# if status locator is not present
                append url /server-status                                                                             ;# use default
            }
            append url $flag
            regsub {^http://} $url {} url                                               ;# eventually remove useless protocol header
            scan $url {%[^/]} host
        } else {
            set url 127.0.0.1/server-status${flag}                                                ;# default for server on localhost
            set host 127.0.0.1
        }
        return $url
    }

    proc configure {optionsName} {
        upvar 1 $optionsName options

        if {[info exists options(--proxyhost)]} {
            ::http::config -proxyhost $options(--proxyhost)
        }
        if {[info exists options(--proxyport)]} {
            ::http::config -proxyport $options(--proxyport)
        }
    }

}