namespace eval ::userdb::http {
proc Send {res chan} {
# translation mode is crlf, no need to insert \r
fileevent $chan writable {}
fileevent $chan readable {}
set len [string length $res]
puts -nonewline $chan \
"HTTP/1.0 200 OK\nContent-Type: text/plain; charset=UTF-8\nContent-Length: $len\n\n"
puts -nonewline $chan $res
catch {chan close $chan}
}
proc BadRequest {chan} {
puts $chan "HTTP/1.0 400 Bad Request\n\n"
catch {chan close $chan}
}
proc Read {ctx lines chan} {
if {[gets $chan line] >= 0} {
if {$line eq ""} {
# End of Full-Request. Ignore everything after Request-Line
foreach {method path rest} [split [lindex $lines 0]] {
switch $method {
GET {
set res [[dict get $ctx GET] $ctx $path]
fileevent $chan writable [list [namespace current]::Send $res $chan]
}
default {
fileevent $chan writable [list [namespace current]::BadRequest $chan]
}
}
}
}
# Replace handler with new state
fileevent $chan readable [list [namespace current]::Read $ctx [lappend lines $line] $chan]
}
if {[eof $chan]} {
close $chan
}
}
proc Server {ctx chan clientaddr clientport} {
chan configure $chan -blocking 0 -buffering line -translation crlf -encoding utf-8
fileevent $chan readable [list [namespace current]::Read $ctx {} $chan]
}
proc HandleGet {ctx path} {
return "hello, world."
}
proc serve {} {
set ctx [dict create GET [namespace current]::HandleGet]
puts "Listening on http://127.0.0.1:8112"
socket -server [list [namespace current]::Server $ctx] -myaddr 127.0.0.1 8112
vwait forever
}
}