#!../../src/xotclsh
# $Id: webserver.xotcl,v 1.6 2006/09/27 08:12:39 neumann Exp $
array set opts {-root ../../doc -port 8086 -protected-port 9096 -pkgdir .}
array set opts $argv
lappend auto_path $opts(-pkgdir)
#if {$::tcl_platform(platform) eq "windows"} {lappend auto_path .}
package require XOTcl; namespace import -force ::xotcl::*
proc ! string {
set f [open [::xotcl::tmpdir]/log w+];
puts $f "[clock format [clock seconds]] $string"
close $f
}
@ @File {
description {
This small demo program starts two different webservers:
- Firstly, it provides a sample web server that povides the documents in
../../src/doc (or the files specified with -root) at port 8086
(or at the port specified via the -port option) as unprotected resources.
- Secondly, it starts a second webserver with basic access control
(it accepts test/test as user/password) on port 9096 (or on the
port specified via -protected-port). If it receives an request
for an resource named "exit", it terminates. For all other requests
it returns actual information about the user and the issued request.
To see, how it works, contact it e.g. from netscape.
}
}
! "#### webserver starting"
# We load the following packages:
#
#::xotcl::package import ::xotcl::comm::httpd
package require xotcl::comm::httpd
! "#### httpd required"
# now we can start the web-server instance with these settings
#
Httpd h1 -port $opts(-port) -root $opts(-root)
@ Httpd h1 {description "unprotected web server"}
! "#### h1 started"
# specialized worker, which executes tcl commands in web pages
@ Class SpecializedWorker { description {
Specialized worker that can be passed to any webserver
}}
Class SpecializedWorker -superclass Httpd::Wrk
@ SpecializedWorker instproc respond {} { description {
This method handles all responses from the webserver to the client.
We implent here "exit", and we return the information about the actual
request and user in HTML format for all other requests.
This method is an example, how to access on the server side
request specific infomation.
}}
SpecializedWorker instproc respond {} {
if {[my set resourceName] eq "exit"} {
set ::forever 1
#my showVars
#my set version 1.0;### ????
#puts stderr HERE
}
# return for all other requests the same response
foreach {a v} [my array get meta] {
append m
| $a | $v |
\n
}
set content {
Request Info
| method: | [my set method] |
| resource: | [my set resourceName] |
| user: | [my set user] |
| version: | HTTP/[my set version] |
| response port: | [my set port] |
| request comes from: | [my set ipaddr] |
Request Header Fields
}
set c [subst $content]
my replyCode 200
[self]::connection puts "Content-Type: text/html"
[self]::connection puts "Content-Length: [string length $c]\n"
[self]::connection puts-nonewline $c
my close
}
@ Httpd h2 {
description "Web server with basic authentication using the specialied worker"}
if {[info exists env(USER)]} {
set USER "$env(USER)"
} elseif {[info exists env(USERNAME)]} {
set USER "$env(USERNAME)"
} else {
set USER unknown
}
if {$::tcl_platform(platform) eq "windows"} {
set USER unknown
}
Httpd h2 -port $opts(-protected-port) -root $opts(-root) \
-httpdWrk SpecializedWorker \
-mixin Httpd::BasicAccessControl \
-addRealmEntry test "u1 test $USER test" -protectDir test "" {}
! "#### h2 started"
#
# and finally call the event loop...
#
vwait forever