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