package require uri package require base64 package require tls ::tls::init \
-certfile server-public.pem \ -keyfile server-private.pem \ -ssl2 1 \ -ssl3 1 \ -tls1 0 \ -require 0 \ -request 0
namespace eval httpd {
proc respond {sock code body {head ""}} {
puts -nonewline $sock "HTTP/1.0 $code ???\nContent-Type: text/html; charset=ISO-8859-1\nConnection: close\nContent-length: [string length $body]\n$head\n$body"
}
proc checkauth {sock ip auth} {
if {$auth ne [base64::encode "mike:pwd"]} {
respond $sock 401 Unauthorized "WWW-Authenticate: Basic realm=\"Authenticate\"\n"
error "Unauthorized from $ip"
}
}
proc handler {sock ip reqstring auth} {
checkauth $sock $ip $auth
array set req $reqstring
switch -glob $req(path) {
"" {
respond $sock 200 "Happy times"
}
default { respond $sock 404 "Error" }
}
}
proc accept {sock ip port} {
if {[catch {
gets $sock line
set auth ""
for {set c 0} {[gets $sock temp]>=0 && $temp ne "\r" && $temp ne ""} {incr c} {
regexp {Authorization: Basic ([^\r\n]+)} $temp -- auth
if {$c == 30} { error "Too many lines from $ip" }
}
if {[eof $sock]} { error "Connection closed from $ip" }
foreach {method url version} $line { break }
switch -exact $method {
GET { handler $sock ip [uri::split $url] $auth }
default { error "Unsupported method '$method' from $ip" }
}
} msg]} {
puts "Error: $msg"
}
close $sock
}} ::tls::socket -server httpd::accept 9005