1#!/usr/bin/env tclsh
2# $Id: secure-webserver.xotcl,v 1.2 2006/02/18 22:17:32 neumann Exp $
3package require XOTcl; namespace import -force xotcl::*
4
5@ @File {
6  description {
7    This small secure web server that provides its documents
8    via SSL (https, port 8443) and plain http (port 8086).
9    <br>
10    This file requires TLS. If you experice problems with 
11    versions obtained from the Web, contact gustaf.neumann@wu-wien.ac.at
12    for a patch.
13  }
14}
15
16#
17# We load the following packages:
18#
19package require xotcl::trace
20package require xotcl::comm::httpd
21#
22# we set the default for document root to ../../src/doc and port to 8443
23#
24set root ../../doc
25set port 8443
26set class Httpsd
27set cb callback  ;# use this for triggering the callbacks  
28#set cb ""
29
30foreach {att value} $argv {
31  switch -- $att {
32    -root {set root $value}
33    -port {set port $value}
34    -class {set class $value}
35    -cb {set cb $value}
36  }
37}
38#
39# now we can start the web-server instance with these settings
40#
41Httpd h0 -port 8086 -root $root 
42$class h1 -port $port  -root $root -infoCb $cb  \
43  -requestCert 1 -requireValidCert 0
44
45
46# Start des HTTP-Servers mit port 8086 und dem angegebenen Verzeichnis
47#Httpd h2 -port 9086 -root $root \
48    -mixin {Responder BasicAccessControl} \
49    -addRealmEntry test {test test} -protectDir test "" {} 
50
51Object callback
52callback proc error {chan msg} {
53  puts stderr "+++TLS/$chan: error: $msg"
54}
55callback proc verify {chan depth cert rc err} {
56  array set c $cert
57  if {$rc != "1"} {
58    puts stderr "+++TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
59  } else {
60    puts stderr "+++TLS/$chan: verify/$depth: $c(subject)"
61  }
62  return $rc
63}
64callback proc info {chan state minor msg} {
65  # For tracing
66  #upvar #0 tls::$chan cb
67  #set cb($major) $minor
68  #puts stderr "+++TLS/$chan: $major/$minor: $state"
69  puts stderr "+++TLS/$chan $state $minor: $msg"
70
71}
72callback proc unknown {option args} {
73  return -code error "bad option \"$option\": must be one of error, info, or verify"
74}
75#
76# and finally call the event loop... 
77#
78vwait forever
79
80