Posted to tcl by mookie at Thu Jul 30 15:27:05 GMT 2026view pretty
Because the wiki is being absolutely useless right now. Either rewrite it or get rid of Cloudflare.
Websockets are too heavy for my liking, and I like the concept of SSE so I got bored and created a small SSE Server which renders an HTML+JS example with enabling messaging between clients.
This is only to demonstrate messaging between sessions and further extended it to include garbage collection so when a client disconnects they are cleaned from the server dictionary. This is using iframes to post data.
Instructions:
- run server
- In one browser tab, open the URL https://localhost:8000
- In another window, open the same URL ~ works best in a new browser window / incognito window
You should be presented with a box and two buttons.
All actions are performed server side.
Messaging is sent from the active token.
You should see a message of in the text box
[uI2F...]: System uI2FeqgN9pEK has forced an Overload Boost! Gravitational shifts detected.
on the other browser
On the server:
Thu Jul 30 15:41:48 BST 2026 - User entered. Initialized token tZmPAiYf7hwk
Thu Jul 30 15:41:50 BST 2026 - User entered. Initialized token uI2FeqgN9pEK
Thu Jul 30 15:54:12 BST 2026 - SWEEPER: Session token uI2FeqgN9pEK expired. Purging cache blocks from memory.
======
#!/usr/bin/env tclsh
set PORT 8080
;# outside variables
set sessions [dict create] ;# Session data vault
set active_channels [dict create] ;# Maps Session ID -> Open SSE Sockets
;# helper to generate session id
proc generate_session_id {} {
set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
set len [string length $chars]
set token ""
for {set i 0} {$i < 12} {incr i} {
append token [string index $chars [expr {int(rand() * $len)}]]
}
return $token
}
;# global multiplayer Event Broadcaster
proc broadcast_system_alert {sender_sid message} {
global active_channels
;# Package an official system announcement payload
set json_payload "{\"alert\":\"$message\",\"from\":\"$sender_sid\"}"
;# Loop over every single active SSE stream open across the entire server
dict for {sid chan} $active_channels {
;# Skip sending it to the player who triggered it
if {$sid eq $sender_sid} { continue }
;# Fire the message directly into their pipe asynchronously
catch {
puts $chan "data: $json_payload"
puts $chan ""
flush $chan
}
}
}
;# Janky HTTP routing, i dislike regex but it works
proc handle_http_request {chan addr port} {
global sessions
fconfigure $chan -translation crlf -blocking 1
if {[gets $chan request_line] < 0} { close $chan; return }
set method "GET"
set full_url "/"
regexp {^([A-Z]+)\s+([^\s]+)} $request_line whole_match method full_url
set content_length 0
while {[gets $chan header_line] >= 0} {
set header_line [string trim $header_line]
if {$header_line eq ""} { break }
if {[regexp -nocase {^Content-Length:\s*(\d+)} $header_line whole_match len]} {
set content_length $len
}
}
set url "/"
set query ""
regexp {^([^?]+)\??(.*)} $full_url whole_match url query
set sid ""
regexp {sid=([^&]+)} $query whole_match sid
if {$method eq "GET" && $url eq "/"} {
if {$sid eq "" || ![dict exists $sessions $sid]} {
set new_sid [generate_session_id]
;# Track 'last_seen' using raw system epoch time stamps
dict set sessions $new_sid [dict create \
"system_name" "Player ($new_sid)" \
"iteration" "1" \
"status" "System Nominal" \
"core_load" "5" \
"last_seen" [clock seconds] \
]
puts "[clock format [clock seconds]] - User entered. Initialized token $new_sid"
puts $chan "HTTP/1.1 303 See Other"
puts $chan "Location: /?sid=$new_sid"
puts $chan "Connection: close"
puts $chan ""
close $chan
return
}
;# Touch session activity timer on page loads
dict set sessions $sid "last_seen" [clock seconds]
render_initial_craftsheet $chan $sid
} elseif {$method eq "GET" && $url eq "/stream"} {
if {$sid eq "" || ![dict exists $sessions $sid]} {
puts $chan "HTTP/1.1 403 Forbidden\r\nContent-Length: 0\r\n\r\n"
close $chan
return
}
establish_sse_stream $chan $sid
} elseif {$method eq "POST" && $url eq "/action"} {
fconfigure $chan -translation binary
set post_body [read $chan $content_length]
set action_type ""
regexp {action_type=([^&]+)} $post_body whole_match action_type
;# Touch activity timestamp on active form posts
if {[dict exists $sessions $sid]} {
dict set sessions $sid "last_seen" [clock seconds]
}
process_universe_action $chan $sid $action_type
} else {
puts $chan "HTTP/1.1 404 Not Found\r\nContent-Length: 0\r\n\r\n"
close $chan
}
}
;# Mutational procedure for actions & triggering of global events
proc process_universe_action {chan sid action_type} {
global sessions
if {![dict exists $sessions $sid]} { close $chan; return }
set user_data [dict get $sessions $sid]
if {$action_type eq "boost"} {
dict set user_data "status" "OVERLOAD_BOOST"
dict set user_data "core_load" "99"
dict set sessions $sid $user_data
# BROADCAST: Notify all other players in the digital cluster
broadcast_system_alert $sid "System $sid has forced an Overload Boost! Gravitational shifts detected."
} elseif {$action_type eq "stabilize"} {
dict set user_data "status" "Stabilized"
dict set user_data "core_load" "10"
dict set sessions $sid $user_data
broadcast_system_alert $sid "System $sid has re-stabilized their energy signature."
}
fconfigure $chan -translation crlf -buffering none
puts $chan "HTTP/1.1 204 No Content"
puts $chan "Connection: close"
puts $chan ""
close $chan
}
proc render_initial_craftsheet {chan sid} {
global sessions
set user_data [dict get $sessions $sid]
set name [dict get $user_data "system_name"]
set stat [dict get $user_data "status"]
# HTML layout Template
set html_template {
<!DOCTYPE html>
<html>
<head>
<title>$name</title>
<style>
body { font-family: monospace; padding: 30px; background: #0f0f14; color: #d1d1d6; }
.sheet { border: 1px solid #2c2c35; padding: 25px; max-width: 450px; background: #1c1c1e; border-radius: 8px; box-shadow: 0 4px 15px rgba(0,0,0,0.5); }
.field { margin: 12px 0; font-size: 16px; display: flex; justify-content: space-between; }
.val { color: #30d158; font-weight: bold; }
form { margin-top: 15px; display: inline-block; }
button { background: #2c2c2e; color: #fff; border: 1px solid #3a3a3c; padding: 10px 14px; cursor: pointer; font-family: monospace; border-radius: 4px; }
button:hover { background: #3a3a3c; }
iframe { display: none; }
#feed { margin-top: 20px; background: #000; height: 100px; padding: 10px; overflow-y: auto; font-size: 12px; color: #ff9f0a; border-radius: 4px; border: 1px solid #2c2c35; }
</style>
</head>
<body>
<div class='sheet'>
<h3>🌌 Universe Anchor: $sid</h3>
<div class='field'>Status Descriptor: <span id='status_field' class='val'>$stat</span></div>
<div class='field'>Dimensional Strain: <span id='load_field' class='val'>0%</span></div>
<form action='/action?sid=$sid' method='POST' target='action_box'>
<input type='hidden' name='action_type' value='boost'>
<button type='submit'>🔥 Overload Boost</button>
</form>
<form action='/action?sid=$sid' method='POST' target='action_box'>
<input type='hidden' name='action_type' value='stabilize'>
<button type='submit'>🛡 Shield Stabilizer</button>
</form>
<div id='feed'>[System Alerts Feed Logging Engaged]<br></div>
</div>
<iframe name='action_box'></iframe>
}
# Evaluate the HTML layout part first
set html [subst -nobackslashes -nocommands $html_template]
# Slightly hacky, but hey, we use a localized subst to safely replace for the $sid variable.
set js_template {
<script>
const sse = new EventSource('/stream?sid=$sid');
sse.onmessage = (event) => {
const data = JSON.parse(event.data);
if(data.status) document.getElementById('status_field').innerText = data.status;
if(data.load) document.getElementById('load_field').innerText = data.load + '%';
if(data.alert) {
const feed = document.getElementById('feed');
feed.innerHTML += '🚨 [' + data.from.substring(0,4) + '...]: ' + data.alert + '<br>';
feed.scrollTop = feed.scrollHeight;
}
};
</script>
</body>
</html>}
# Appends the safely evaluated script block
append html [subst -nobackslashes -nocommands $js_template]
# Transmit the completely formed payload
fconfigure $chan -translation crlf -encoding utf-8 -buffering none
puts $chan "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\n$html"
close $chan
}
;# Open and Register Stream Sockets on Javascript requests
proc establish_sse_stream {chan sid} {
global active_channels
fconfigure $chan -translation lf -blocking 0
puts $chan "HTTP/1.1 200 OK\r\nContent-Type: text/event-stream\r\nCache-Control: no-cache\r\nConnection: keep-alive\r\n"
flush $chan
# Register the socket descriptor into our broadcasting layout map
dict set active_channels $sid $chan
# Stream our updates to the client
stream_periodic_updates $chan $sid 1
}
proc stream_periodic_updates {chan sid count} {
global sessions active_channels
;# catch and unset our invactive clients
if {[eof $chan] || ![dict exists $sessions $sid]} {
catch {close $chan}
dict unset active_channels $sid
return
}
;# update activity heartbeats while stream remains active
dict set sessions $sid "last_seen" [clock seconds]
set user_data [dict get $sessions $sid]
set current_status [dict get $user_data "status"]
set current_load [dict get $user_data "core_load"]
set json_payload "{\"status\":\"$current_status\",\"load\":$current_load}"
if {[catch {
puts $chan "data: $json_payload"
puts $chan ""
flush $chan
}]} {
catch {close $chan}
dict unset active_channels $sid
return
}
;# internal cooldown of simulation loops
if {$current_load > 5 && $current_status eq "OVERLOAD_BOOST"} {
set new_load [expr {$current_load - 10}]
dict set user_data "core_load" $new_load
if {$new_load <= 15} {
dict set user_data "status" "Core Normalized"
}
dict set sessions $sid $user_data
}
after 1000 [list stream_periodic_updates $chan $sid [incr count]]
}
proc run_garbage_collection {} {
global sessions active_channels
set now [clock seconds]
set expiry_threshold_seconds 30 ;# Expire clients inactive for 30s
set expired_tokens {}
;# Check timestamps across our entire universe and append expire
dict for {sid user_data} $sessions {
set last_seen [dict get $user_data "last_seen"]
if {[expr {$now - $last_seen}] > $expiry_threshold_seconds} {
lappend expired_tokens $sid
}
}
;# safely clear expired items outside the iterator loop
foreach sid $expired_tokens {
puts "[clock format $now] - SWEEPER: Session token $sid expired. Purging cache blocks from memory."
dict unset sessions $sid
# If they had an open socket sitting around, disconnect it cleanly
if {[dict exists $active_channels $sid]} {
catch {close [dict get $active_channels $sid]}
dict unset active_channels $sid
}
}
;# schedule the sweeper clock loop to scan again in 10 seconds
after 10000 run_garbage_collection
}
socket -server handle_http_request $PORT
puts "Cluster Overlord running on http://localhost:$PORT"
run_garbage_collection
vwait forever
======