# web::logfilter add inspect.-debug
web::logfilter add *.-debug
web::logdest add *.-debug file /tmp/webinspect.log
# work with cookies
web::cookiecontext context -idtag sessionid -expires "today"
# work also with a file-based context
web::filecontext f_context -path "%d"
# id-generator file
set idgenfn /tmp/idgen.dat
web::filecounter idgen -filename $idgenfn
# =============================================================================
# commands
# =============================================================================
web::command default {
# ------------------------------------------------------------------------
# setup
# ------------------------------------------------------------------------
if {[catch {web::context::init} msg ] == 1 } {
web::context::new [idgen nextval]
web::context::set numberVisits 0
}
set res [catch { web::context::init } msg]
# calculate the visit number
set tmp [web::context::get numberVisits "0"]
web::context::set numberVisits [incr tmp]
# set the output to a variable named 'text'. this way we can commit
# the cookie at the end (Note that we set 'sendheader' to 0!)
web::output \#text
web::output sendheader 0
set url3 [web::cmdurl whatWeKnow]
set url4 [web::cmdurl ascii]
# ------------------------------------------------------------------------
# write the content
# ------------------------------------------------------------------------
web::put [header]
web::put "
Hello, this is your visit \#[web::context::get numberVisits]
"
showAll
web::put "
"
web::put " View this page as ascii file
"
web::put " What we know about you ... "
web::put [footer]
#web::log inspect.info $text
# the new state is committed (i.e. written as a cookie into 'text')
web::output stdout
if {[catch {web::context::commit} msg] == 0} {
web::put $text
} else {
web::put "HALLO"
#fixme: do something smart!
}
}
web::command ascii {
showAll "" -ascii
}
web::command testWebshCommand {
# ------------------------------------------------------------------------
# setup
# ------------------------------------------------------------------------
set webcmd [web::param webcmd]
set url1 [web::cmdurl result webcmd $webcmd]
set url2 [web::cmdurl ""]
# ------------------------------------------------------------------------
# write the content
# ------------------------------------------------------------------------
web::put [header]
web::put "Test the command:
\n"
web::put ""
web::put "
"
web::put " back to main "
web::put [footer]
}
web::command result {
# ------------------------------------------------------------------------
# setup
# ------------------------------------------------------------------------
if {[catch {web::context::init} msg ] == 1 } {
web::context::new [idgen nextval]
web::context::set numberVisits 0
}
set webcmd [web::param webcmd]
set argument [web::formvar arguments]
set request "$webcmd $argument"
set url1 [web::cmdurl testWebshCommand webcmd $webcmd]
set url2 [web::cmdurl ""]
# ------------------------------------------------------------------------
# do the action
# ------------------------------------------------------------------------
# we redirect the output in case a command writes or modifies our channel
set tmp ""
set outchannel [web::output \#tmp]
# avoid commands that affect us
if {[string match "*dispatch" $webcmd] == 1} {
set res 1
set msg "Not allowed"
} else {
set res [catch {eval $request } msg]
}
# we reset the output
web::output $outchannel
# we test whether the command succeded
if {$res } {
set color ""
} else {
set color ""
}
# ------------------------------------------------------------------------
# do some state stuff
# ------------------------------------------------------------------------
if {$res} {
set failures [web::context::get failures 0]
incr failures
web::context::set failures $failures -crypt
set id [web::context::id]
set resload [catch {web::f_context::init -id $id} loadmsg]
if {$resload} {
web::f_context::new $id
}
set arguments "[web::formvar arguments] [web::f_context::get wrongargs \"\"]"
web::f_context::set wrongargs $arguments -crypt
} else {
set success [web::context::get success 0]
incr success
web::context::set success $success -crypt
}
catch {web::f_context::commit} commitmsg
web::context::commit
# ------------------------------------------------------------------------
# write the content
# ------------------------------------------------------------------------
web::put [header]
web::put "Your request produced the following result
"
web::put ""
web::put ""
web::put "Request"
web::put " | "
web::put "Response"
web::put " | "
web::put "Written to a channel"
web::put " | "
web::put "$request | "
# we print the result of the command
# this is either in msg and/or in tmp
web::put " $color $msg | "
web::put " $color $tmp | "
web::put "
"
web::put "
"
web::put " back to $webcmd
"
web::put " back to main "
web::put [footer]
}
web::command whatWeKnow {
# ------------------------------------------------------------------------
# setup
# ------------------------------------------------------------------------
set res [catch { web::context::load } msg]
if {$res == 0} {
# yes, got a cookie, try to load the file-based info
web::f_context::init -id [web::context::id]
} else {
# no, have to create a new one
web::context::new [idgen nextval]
web::context::set numberVisits 0
web::f_context::new [idgen currval]
}
set fails [web::context::get failures 0]
set succ [web::context::get success 0]
set fail_text [web::f_context::get wrongargs ""]
set url2 [web::cmdurl ""]
# ------------------------------------------------------------------------
# write the content
# ------------------------------------------------------------------------
web::put [header]
web::put "So you want to know what we know about you ...
"
web::put ""
web::put "Well .... "
if {$fails > $succ} {
web::put "you produced a lot of failures, but what do you want when you write humbug like $fail_text"
} else {
web::put "You seem to be a smart person who knows how to handle an incredible piece of software! Congratulations!"
}
web::put "
"
web::put " back to main "
web::put [footer]
}
proc webcmd {namespace} {
set a "::*"
info commands $namespace$a
}
proc childrennamespaces {{parent ""}} {
return [namespace children $parent]
}
proc showAll {{parent ""} {type -html}} {
set kids [childrennamespaces $parent]
if {[llength $kids]} {
foreach namesp $kids {
printCommands $namesp $type
showAll $namesp $type
}
} else {
}
}
proc printCommands {namespace {type -html}} {
if {[string match "*context*" $namespace] == 1} {
#nothing!
return
}
if {$type == "-html"} {
web::put "$namespace
\n"
web::put "
\n"
web::put "WEBSH-COMMAND | \n"
web::put "RESPONSE | \n"
} else {
#web::put "$namespace\n"
}
foreach cmd [lsort [webcmd $namespace]] {
if {$type == "-html"} {
web::put "\n"
web::put "\n"
set url [web::cmdurl testWebshCommand webcmd $cmd]
web::put " $cmd "
web::put " | "
if {[string compare $cmd "::web::getcommand"] == 0} {
#nothing
} elseif {[string compare $cmd "::web::dispatch"] == 0} {
#nothing!
} else {
catch {set response [eval $cmd]} msg
if {[info exists msg]} {
web::put "\n"
web::put $msg
web::put " | "
}
}
} else {
web::put "$cmd\n"
}
if {[string compare $cmd "::web::file_context"] == 0} {
eval [$cmd your_context]
eval [web::your_context::new 1]
if {$type == "-html"} {
web::put "
- | \n"
web::put "\n"
foreach subcmd [lsort [info commands web::your_context::*]] {
web::put "\n"
web::put "\n"
web::put "$subcmd"
web::put " | "
web::put " \n"
}
web::put " \n"
web::put " | \n"
web::put "
";
namespace delete web::your_context
}
}
if {$type == "-html"} {
web::put "\n"
}
}
if {$type == "-html" } {
web::put "
"
}
}
proc header {} {
return "\n"
}
proc footer {} {
return "\n"
}
# =============================================================================
#
# =============================================================================
web::dispatch