# 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 "$webcmd\n" web::put "
\n" web::put "" 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 "" # we print the result of the command # this is either in msg and/or in tmp web::put "" web::put "" web::put "
" web::put "Request" web::put "" web::put "Response" web::put "" web::put "Written to a channel" web::put "
$request $color $msg $color $tmp
" 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 "\n" web::put "\n" } else { #web::put "$namespace\n" } foreach cmd [lsort [webcmd $namespace]] { if {$type == "-html"} { web::put "\n" 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 "" } } } 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 ""; namespace delete web::your_context } } if {$type == "-html"} { web::put "\n" } } if {$type == "-html" } { web::put "
WEBSH-COMMANDRESPONSE
\n" set url [web::cmdurl testWebshCommand webcmd $cmd] web::put " $cmd " web::put "\n" web::put $msg web::put "
-\n" web::put "\n" foreach subcmd [lsort [info commands web::your_context::*]] { web::put "\n" web::put "" web::put "\n" } web::put "
\n" web::put "$subcmd" web::put "
\n" web::put "
" } } proc header {} { return "\n" } proc footer {} { return "\n" } # ============================================================================= # # ============================================================================= web::dispatch