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