}
}
"/programs" {
set programs [Statements::findMatches [list /someone/ claims /programName/ has program /program/]]
subst {
Running programs
[join [lmap p $programs { dict with p {subst {
$programName
[htmlEscape [lindex $program 1]]
}} }] "\n"]
}
}
"/timings" {
set totalTimes [list]
dict for {body totalTime} $Evaluator::totalTimesMap {
dict with totalTime {
lappend totalTimes $body [expr {$loadTime + $runTime + $unloadTime}]
}
}
set totalTimes [lsort -integer -stride 2 -index 1 $totalTimes]
set totalFrameTime 0
set l [list]
foreach {body totalTime} $totalTimes {
set runs [dict get $Evaluator::runsMap $body]
set totalFrameTime [expr {$totalFrameTime + $totalTime/$::stepCount}]
lappend l [subst {
[htmlEscape $body]
($runs runs): [dict get $Evaluator::totalTimesMap $body]: $totalTime microseconds total ([expr {$totalTime/$::stepCount}] us per frame), $runs runs ([expr {$totalTime/$runs}] us per run; [expr {$runs/$::stepCount}] runs per frame)
}]
}
subst {
Timings
Timings (sum per-frame time $totalFrameTime us)
[join $l "\n"]
}
}
"/favicon.ico" {
set contentType "image/x-icon"
readFile "assets/favicon.ico" contentType
}
"/style.css" {
set contentType "text/css"
readFile "assets/style.css" contentType
}
"/statementClauseToId.pdf" {
getDotAsPdf [trie dot [Statements::statementClauseToIdTrie]] contentType
}
"/statements.pdf" {
getDotAsPdf [Statements::dot] contentType
}
default {
upvar $httpStatusVar httpStatus
set httpStatus "HTTP/1.1 404 Not Found"
subst {
$path Not found.
}
}
}
}
proc handleRead {chan addr port} {
chan configure $chan -translation crlf
gets $chan line; set firstline $line
# puts "Http: $chan $addr $port: $line"
set headers [list]
while {[gets $chan line] >= 0 && $line ne ""} {
if {[regexp -expanded {^( [^\s:]+ ) \s* : \s* (.+)} $line -> k v]} {
lappend headers $k $v
} else { break }
}
if {[regexp {GET ([^ ]*) HTTP/1.1} $firstline -> path] && $path ne "/ws"} {
set response {}
set matches [Statements::findMatches {/someone/ wishes the web server handles route /route/ with handler /handler/}]
try {
foreach match $matches {
set route [dict get $match route]
set handler [dict get $match handler]
if {[regexp -all $route $path whole_match]} {
fn html {body} {dict create statusAndHeaders "HTTP/1.1 200 OK\nConnection: close\nContent-Type: text/html; charset=utf-8\n\n" body $body}
fn json {body} {dict create statusAndHeaders "HTTP/1.1 200 OK\nConnection: close\nContent-Type: application/json; charset=utf-8\n\n" body $body}
set response [apply [list {path ^html ^json} $handler] $path ${^html} ${^json}]
}
}
if {$response eq ""} {
set httpStatus "HTTP/1.1 200 OK"
set contentType "text/html; charset=utf-8"
set body [handlePage $path httpStatus contentType]
set response [dict create statusAndHeaders "$httpStatus\nConnection: close\nContent-Type: $contentType\n\n" body $body]
}
if {![dict exists $response statusAndHeaders]} {
error "Response not generated"
}
} on error e {
set contentType "text-html; charset=utf-8"
set body [subst {
folk: 500 Internal Server Error
[htmlEscape $e]:
[htmlEscape $::errorInfo]
}]
set response [dict create statusAndHeaders "HTTP/1.1 500 Internal Server Error\nConnection: close\nContent-Type: $contentType\n\n" body $body]
}
puts -nonewline $chan [dict get $response statusAndHeaders]
if {[dict exists $response body]} {
chan configure $chan -encoding binary -translation binary
puts -nonewline $chan [dict get $response body]
}
close $chan
} elseif {[::websocket::test $::serverSock $chan "/ws" $headers]} {
# puts "WS: $chan $addr $port"
::websocket::upgrade $chan
# from now the handleWS will be called (not anymore handleRead).
} else { puts "Closing: $chan $addr $port $headers"; close $chan }
}
proc handleWS {chan type msg} {
if {$type eq "connect" || $type eq "ping" || $type eq "pong"} {
# puts "Event $type from chan $chan"
} elseif {$type eq "text"} {
eval $msg
} elseif {$type eq "disconnect"} {
Commit $chan statements {}
foreach peerNs [namespace children ::Peers] {
apply [list {disconnectedChan} {
variable chan
if {$chan eq $disconnectedChan} {
namespace delete [namespace current]
}
} $peerNs] $chan
}
} else {
puts "$::thisProcess: Unhandled WS event $type on $chan ($msg)"
}
}
if {[catch {set ::serverSock [socket -server handleConnect 4273]}] == 1} {
error "There's already a Web-capable Folk node running on this machine."
}
::websocket::server $::serverSock
::websocket::live $::serverSock /ws handleWS