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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
|
#
# init.tcl --
#
#
# Copyright 2002-2017 The Apache Rivet Team
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
package require @RIVETLIB_PACKAGE@ @RIVETLIB_PACKAGE_VERSION@
# the ::rivet namespace is created in mod_rivet_commoc.c:Rivet_PerInterpInit
# namespace eval ::rivet {} ; ## create namespace
namespace eval ::Rivet {} ; ## create namespace
## ::Rivet::init
##
## Initialize the interpreter with all that Rivet goodness. This is called
## once when this file is loaded (down at the bottom) and sets up the interp
## for all things Rivet.
proc ::Rivet::init {} {
set ::Rivet::init [info script]
set ::Rivet::root [file dirname $::Rivet::init]
set ::Rivet::packages [file join $::Rivet::root packages]
set ::Rivet::rivet_tcl [file join $::Rivet::root rivet-tcl]
## Setup auto_path within the interp to include all the places
## we've stored Rivet's scripts: rivet-tcl, packages, packages-local,
## packages$tcl_version, init_script_dir, and .
## Put these at the head of the list.
set ::auto_path [linsert $::auto_path 0 $::Rivet::root \
$::Rivet::rivet_tcl $::Rivet::packages $::Rivet::packages-local]
## This will allow users to create proc libraries and tclIndex files
## in the local directory that can be autoloaded.
## Perhaps this must go to the front of the list to allow the user
## to override even Rivet's procs.
lappend ::auto_path ${::Rivet::packages}${::tcl_version} .
## As we moved the command set to the ::rivet namespace we
## still want to guarantee the commands to be accessible
## at the global level by putting them on the export list.
## Importing the ::rivet namespace is deprecated and we should
## make it clear in the manual.
if {[string is true -strict [::rivet::inspect ExportRivetNS]]
|| [string is true -strict [::rivet::inspect ImportRivetNS]]} {
set ::rivet::cmd_export_list \
[tcl_commands_export_list $::Rivet::rivet_tcl]
## init.tcl is run by mod_rivet (which creates the ::rivet
## namespace) but it gets run standalone by mkPkgindex during
## the installation phase. We have to make sure the procedure
## won't fail in this case, so we check for the existence of
## the variable.
namespace eval ::rivet {
## Commands in cmd_export_list are prefixed with ::rivet,
## so we have to remove it to build an export list.
set export_list [list]
foreach c $cmd_export_list {
lappend export_list [namespace tail $c]
}
namespace export {*}$export_list
}
}
## If we are running from within mod_rivet we have already
## defined ::rivet::exit (mod_rivet_common.c: Rivet_PerInterpInit)
## and we move Tcl's exit command out of the way and replace it with
## our own that handles bailing from a page request properly.
if {[info commands ::rivet::exit] != ""} {
rename ::exit ::Rivet::tclcore_exit
proc ::exit {code} {
if {![string is integer -strict $code]} { set code 0 }
::rivet::exit $code
}
}
## If Rivet was configured for backward compatibility, import commands
## from the ::rivet namespace into the global namespace.
if {[string is true -strict [::rivet::inspect ImportRivetNS]]} {
uplevel #0 { namespace import ::rivet::* }
}
#unset -nocomplain ::module_conf
}
###
## This routine gets called each time a new request comes in.
## It sets up the request namespace and creates a global command
## to replace the default global. This ensures that when a user
## uses global variables, they're actually contained within the
## namespace. So, everything gets deleted when the request is finished.
###
proc ::Rivet::initialize_request {} {
catch { namespace delete ::request }
namespace eval ::request {}
proc ::request::global {args} {
foreach arg $args {
uplevel "::global ::request::$arg"
}
}
}
## ::Rivet::handle_error
##
## If an ErrorScript has been specified, this routine will not be called.
proc ::Rivet::handle_error {} {
puts "<pre>$::errorInfo<hr/><p>OUTPUT BUFFER:</p>$::Rivet::script</pre>"
}
## ::Rivet::request_handling
##
## Process the actual request. This is the main handler for each request.
## This collects all of the necessary BeforeScripts, AfterScripts, and
## other bits and calls them in order.
proc ::Rivet::request_handling {} {
::try {
uplevel #0 ::Rivet::initialize_request
} on error {err} {
::rivet::apache_log_error crit \
"Rivet request initialization failed: $::errorInfo"
}
::try {
set script [::rivet::inspect BeforeScript]
if {$script ne ""} {
set ::Rivet::script $script
uplevel #0 $script
}
set script [::rivet::url_script]
if {$script ne ""} {
set ::Rivet::script $script
namespace eval ::request $script
}
set script [::rivet::inspect AfterScript]
if {$script ne ""} {
set ::Rivet::script $script
uplevel #0 $script
}
} trap {RIVET ABORTPAGE} {err opts} {
::Rivet::finish_request $script $err $opts AbortScript
} trap {RIVET THREAD_EXIT} {err opts} {
::Rivet::finish_request $script $err $opts AbortScript
} on error {err opts} {
::Rivet::finish_request $script $err $opts
} finally {
::Rivet::finish_request $script "" "" AfterEveryScript
}
}
## ::Rivet::finish_request
##
## Finish processing the request by checking our error state and executing
## whichever script we need to close things up. If this script results in
## an error, we'll try to call ErrorScript before bailing.
proc ::Rivet::finish_request {script errorCode errorOpts {scriptName ""}} {
set ::Rivet::errorCode $errorCode
set ::Rivet::errorOpts $errorOpts
if {$scriptName ne ""} {
set scriptBody [::rivet::inspect $scriptName]
::try {
uplevel #0 $scriptBody
} on ok {} {
return
} on error {} {
::rivet::apache_log_error err \
"Rivet $scriptName failed: $::errorInfo"
print_error_message "Rivet $scriptName failed"
}
}
set error_script [::rivet::inspect ErrorScript]
if {$error_script eq ""} {
set ::errorOutbuf $script ; ## legacy variable
set error_script ::Rivet::handle_error
}
::try {
set ::Rivet::script $script
uplevel #0 $error_script
} on error {err} {
::rivet::apache_log_error err "Rivet ErrorScript failed: $::errorInfo"
print_error_message "Rivet ErrorScript failed"
}
}
## ::Rivet::print_error_message
##
## This message should be transparently equivalent to the
## Rivet_PrintErrorMessage function in mod_rivet_generator.c
proc ::Rivet::print_error_message {error_header} {
puts "<strong>$error_header</strong><br/><pre>$::errorInfo</pre>"
}
## ::Rivet::tcl_commands_export_list
##
## this is temporary hack to export names of Tcl commands in rivet-tcl/.
## This function will be removed in future versions of Rivet and it's
## meant to provide a basic way to guarantee compatibility with older
## versions of Rivet (see code in ::Rivet::init)
proc ::Rivet::tcl_commands_export_list {tclpath} {
# we collect the commands in rivet-tcl by reading the tclIndex
# file and then we extract the command list from auto_index
namespace eval ::Rivet::temp {}
set ::Rivet::temp::tclpath $tclpath
namespace eval ::Rivet::temp {
variable auto_index
array set auto_index {}
# the auto_index in ${tclpath}/tclIndex is loaded
# this array is used to fetch a list of Rivet commands
# implemented in Rivet
set dir $tclpath
source [file join $tclpath tclIndex]
# Rivet Tcl commands not meant to go onto the export list must
# be unset from auto_index here
unset auto_index(::rivet::catch)
unset auto_index(::rivet::try)
}
set commands [namespace eval ::Rivet::temp {array names auto_index}]
# we won't leave anything behind
namespace delete ::Rivet::temp
return $commands
}
::Rivet::init
package provide Rivet @INIT_VERSION@
|