1#!../../src/xotclsh 2# $Id: webserver.xotcl,v 1.9 2007/08/14 16:38:26 neumann Exp $ 3array set opts {-root ../../doc -port 8086 -protected-port 9096 -pkgdir .} 4array set opts $argv 5lappend auto_path $opts(-pkgdir) 6#if {$::tcl_platform(platform) eq "windows"} {lappend auto_path .} 7package require XOTcl 1; namespace import -force xotcl::* 8 9proc ! string { 10 set f [open [::xotcl::tmpdir]/log w+]; 11 puts $f "[clock format [clock seconds]] $string" 12 close $f 13} 14 15@ @File { 16 description { 17 This small demo program starts two different webservers: 18 <ul> 19 <li>Firstly, it provides a sample web server that povides the documents in 20 ../../src/doc (or the files specified with -root) at port 8086 21 (or at the port specified via the -port option) as unprotected resources. 22 <p> 23 <li>Secondly, it starts a second webserver with basic access control 24 (it accepts test/test as user/password) on port 9096 (or on the 25 port specified via -protected-port). If it receives an request 26 for an resource named "exit", it terminates. For all other requests 27 it returns actual information about the user and the issued request. 28 </ul> 29 To see, how it works, contact it e.g. from netscape. 30 } 31} 32 33! "#### webserver starting" 34# We load the following packages: 35# 36#::xotcl::package import ::xotcl::comm::httpd 37package require xotcl::comm::httpd 38 39! "#### httpd required" 40 41# now we can start the web-server instance with these settings 42# 43Httpd h1 -port $opts(-port) -root $opts(-root) 44@ Httpd h1 {description "unprotected web server"} 45 46! "#### h1 started" 47 48# specialized worker, which executes tcl commands in web pages 49@ Class SpecializedWorker { description { 50 Specialized worker that can be passed to any webserver 51}} 52Class SpecializedWorker -superclass Httpd::Wrk 53@ SpecializedWorker instproc respond {} { description { 54 This method handles all responses from the webserver to the client. 55 We implent here "exit", and we return the information about the actual 56 request and user in HTML format for all other requests. 57 <p>This method is an example, how to access on the server side 58 request specific infomation. 59}} 60SpecializedWorker instproc respond {} { 61 if {[my set resourceName] eq "exit"} { 62 set ::forever 1 63 #my showVars 64 #my set version 1.0;### ???? 65 #puts stderr HERE 66 } 67 # return for all other requests the same response 68 foreach {a v} [my array get meta] { 69 append m <tr><td><em>$a</em></td><td>$v</td></tr>\n 70 } 71 set content { 72 <HTML><BODY> 73 <h3>Request Info</h3> 74 <table> 75 <tr><td><em>method:</em></td><td>[my set method]</td></tr> 76 <tr><td><em>resource:</em></td><td>[my set resourceName]</td></tr> 77 <tr><td><em>user:</em></td><td>[my set user]</td></tr> 78 <tr><td><em>version:</em></td><td>HTTP/[my set version]</td></tr> 79 <tr><td><em>response port:</em></td><td>[my set port]</td></tr> 80 <tr><td><em>request comes from:</em></td><td>[my set ipaddr]</td></tr> 81 </table> 82 <h3>Request Header Fields</h3> 83 <table>$m</table> 84 </BODY></HTML> 85 } 86 set c [subst $content] 87 my replyCode 200 88 my connection puts "Content-Type: text/html" 89 my connection puts "Content-Length: [string length $c]\n" 90 my connection puts-nonewline $c 91 my close 92} 93 94@ Httpd h2 { 95 description "Web server with basic authentication using the specialied worker"} 96 97if {[info exists env(USER)]} { 98 set USER "$env(USER)" 99} elseif {[info exists env(USERNAME)]} { 100 set USER "$env(USERNAME)" 101} else { 102 set USER unknown 103} 104if {$::tcl_platform(platform) eq "windows"} { 105 set USER unknown 106} 107 108Httpd h2 -port $opts(-protected-port) -root $opts(-root) \ 109 -httpdWrk SpecializedWorker \ 110 -mixin Httpd::BasicAccessControl \ 111 -addRealmEntry test "u1 test $USER test" -protectDir test "" {} 112 113! "#### h2 started" 114 115# 116# and finally call the event loop... 117# 118vwait forever 119