Posted to tcl by mookie at Thu Jul 30 15:27:05 GMT 2026view raw

  1. Because the wiki is being absolutely useless right now. Either rewrite it or get rid of Cloudflare.
  2.  
  3. 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.
  4.  
  5. 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.
  6.  
  7. Instructions:
  8.  
  9. - run server
  10. - In one browser tab, open the URL https://localhost:8000
  11. - In another window, open the same URL ~ works best in a new browser window / incognito window
  12.  
  13. You should be presented with a box and two buttons.
  14.  
  15. All actions are performed server side.
  16. Messaging is sent from the active token.
  17.  
  18. You should see a message of in the text box
  19. [uI2F...]: System uI2FeqgN9pEK has forced an Overload Boost! Gravitational shifts detected.
  20. on the other browser
  21.  
  22. On the server:
  23. Thu Jul 30 15:41:48 BST 2026 - User entered. Initialized token tZmPAiYf7hwk
  24. Thu Jul 30 15:41:50 BST 2026 - User entered. Initialized token uI2FeqgN9pEK
  25. Thu Jul 30 15:54:12 BST 2026 - SWEEPER: Session token uI2FeqgN9pEK expired. Purging cache blocks from memory.
  26.  
  27. ======
  28. #!/usr/bin/env tclsh
  29. set PORT 8080
  30.  
  31. ;# outside variables
  32. set sessions [dict create] ;# Session data vault
  33. set active_channels [dict create] ;# Maps Session ID -> Open SSE Sockets
  34.  
  35. ;# helper to generate session id
  36. proc generate_session_id {} {
  37. set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
  38. set len [string length $chars]
  39. set token ""
  40. for {set i 0} {$i < 12} {incr i} {
  41. append token [string index $chars [expr {int(rand() * $len)}]]
  42. }
  43. return $token
  44. }
  45.  
  46. ;# global multiplayer Event Broadcaster
  47. proc broadcast_system_alert {sender_sid message} {
  48. global active_channels
  49.  
  50. ;# Package an official system announcement payload
  51. set json_payload "{\"alert\":\"$message\",\"from\":\"$sender_sid\"}"
  52.  
  53. ;# Loop over every single active SSE stream open across the entire server
  54. dict for {sid chan} $active_channels {
  55. ;# Skip sending it to the player who triggered it
  56. if {$sid eq $sender_sid} { continue }
  57.  
  58. ;# Fire the message directly into their pipe asynchronously
  59. catch {
  60. puts $chan "data: $json_payload"
  61. puts $chan ""
  62. flush $chan
  63. }
  64. }
  65. }
  66.  
  67. ;# Janky HTTP routing, i dislike regex but it works
  68. proc handle_http_request {chan addr port} {
  69. global sessions
  70. fconfigure $chan -translation crlf -blocking 1
  71.  
  72. if {[gets $chan request_line] < 0} { close $chan; return }
  73.  
  74. set method "GET"
  75. set full_url "/"
  76. regexp {^([A-Z]+)\s+([^\s]+)} $request_line whole_match method full_url
  77.  
  78. set content_length 0
  79. while {[gets $chan header_line] >= 0} {
  80. set header_line [string trim $header_line]
  81. if {$header_line eq ""} { break }
  82. if {[regexp -nocase {^Content-Length:\s*(\d+)} $header_line whole_match len]} {
  83. set content_length $len
  84. }
  85. }
  86.  
  87. set url "/"
  88. set query ""
  89. regexp {^([^?]+)\??(.*)} $full_url whole_match url query
  90.  
  91. set sid ""
  92. regexp {sid=([^&]+)} $query whole_match sid
  93.  
  94. if {$method eq "GET" && $url eq "/"} {
  95. if {$sid eq "" || ![dict exists $sessions $sid]} {
  96. set new_sid [generate_session_id]
  97. ;# Track 'last_seen' using raw system epoch time stamps
  98. dict set sessions $new_sid [dict create \
  99. "system_name" "Player ($new_sid)" \
  100. "iteration" "1" \
  101. "status" "System Nominal" \
  102. "core_load" "5" \
  103. "last_seen" [clock seconds] \
  104. ]
  105. puts "[clock format [clock seconds]] - User entered. Initialized token $new_sid"
  106.  
  107. puts $chan "HTTP/1.1 303 See Other"
  108. puts $chan "Location: /?sid=$new_sid"
  109. puts $chan "Connection: close"
  110. puts $chan ""
  111. close $chan
  112. return
  113. }
  114.  
  115. ;# Touch session activity timer on page loads
  116. dict set sessions $sid "last_seen" [clock seconds]
  117. render_initial_craftsheet $chan $sid
  118.  
  119. } elseif {$method eq "GET" && $url eq "/stream"} {
  120. if {$sid eq "" || ![dict exists $sessions $sid]} {
  121. puts $chan "HTTP/1.1 403 Forbidden\r\nContent-Length: 0\r\n\r\n"
  122. close $chan
  123. return
  124. }
  125. establish_sse_stream $chan $sid
  126.  
  127. } elseif {$method eq "POST" && $url eq "/action"} {
  128. fconfigure $chan -translation binary
  129. set post_body [read $chan $content_length]
  130.  
  131. set action_type ""
  132. regexp {action_type=([^&]+)} $post_body whole_match action_type
  133.  
  134. ;# Touch activity timestamp on active form posts
  135. if {[dict exists $sessions $sid]} {
  136. dict set sessions $sid "last_seen" [clock seconds]
  137. }
  138. process_universe_action $chan $sid $action_type
  139. } else {
  140. puts $chan "HTTP/1.1 404 Not Found\r\nContent-Length: 0\r\n\r\n"
  141. close $chan
  142. }
  143. }
  144.  
  145. ;# Mutational procedure for actions & triggering of global events
  146. proc process_universe_action {chan sid action_type} {
  147. global sessions
  148. if {![dict exists $sessions $sid]} { close $chan; return }
  149.  
  150. set user_data [dict get $sessions $sid]
  151.  
  152. if {$action_type eq "boost"} {
  153. dict set user_data "status" "OVERLOAD_BOOST"
  154. dict set user_data "core_load" "99"
  155. dict set sessions $sid $user_data
  156.  
  157. # BROADCAST: Notify all other players in the digital cluster
  158. broadcast_system_alert $sid "System $sid has forced an Overload Boost! Gravitational shifts detected."
  159.  
  160. } elseif {$action_type eq "stabilize"} {
  161. dict set user_data "status" "Stabilized"
  162. dict set user_data "core_load" "10"
  163. dict set sessions $sid $user_data
  164.  
  165. broadcast_system_alert $sid "System $sid has re-stabilized their energy signature."
  166. }
  167.  
  168. fconfigure $chan -translation crlf -buffering none
  169. puts $chan "HTTP/1.1 204 No Content"
  170. puts $chan "Connection: close"
  171. puts $chan ""
  172. close $chan
  173. }
  174.  
  175. proc render_initial_craftsheet {chan sid} {
  176. global sessions
  177.  
  178. set user_data [dict get $sessions $sid]
  179. set name [dict get $user_data "system_name"]
  180. set stat [dict get $user_data "status"]
  181.  
  182. # HTML layout Template
  183. set html_template {
  184. <!DOCTYPE html>
  185. <html>
  186. <head>
  187. <title>$name</title>
  188. <style>
  189. body { font-family: monospace; padding: 30px; background: #0f0f14; color: #d1d1d6; }
  190. .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); }
  191. .field { margin: 12px 0; font-size: 16px; display: flex; justify-content: space-between; }
  192. .val { color: #30d158; font-weight: bold; }
  193. form { margin-top: 15px; display: inline-block; }
  194. button { background: #2c2c2e; color: #fff; border: 1px solid #3a3a3c; padding: 10px 14px; cursor: pointer; font-family: monospace; border-radius: 4px; }
  195. button:hover { background: #3a3a3c; }
  196. iframe { display: none; }
  197. #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; }
  198. </style>
  199. </head>
  200. <body>
  201. <div class='sheet'>
  202. <h3>🌌 Universe Anchor: $sid</h3>
  203. <div class='field'>Status Descriptor: <span id='status_field' class='val'>$stat</span></div>
  204. <div class='field'>Dimensional Strain: <span id='load_field' class='val'>0%</span></div>
  205.  
  206. <form action='/action?sid=$sid' method='POST' target='action_box'>
  207. <input type='hidden' name='action_type' value='boost'>
  208. <button type='submit'>🔥 Overload Boost</button>
  209. </form>
  210.  
  211. <form action='/action?sid=$sid' method='POST' target='action_box'>
  212. <input type='hidden' name='action_type' value='stabilize'>
  213. <button type='submit'>🛡 Shield Stabilizer</button>
  214. </form>
  215.  
  216. <div id='feed'>[System Alerts Feed Logging Engaged]<br></div>
  217. </div>
  218.  
  219. <iframe name='action_box'></iframe>
  220. }
  221.  
  222. # Evaluate the HTML layout part first
  223. set html [subst -nobackslashes -nocommands $html_template]
  224.  
  225. # Slightly hacky, but hey, we use a localized subst to safely replace for the $sid variable.
  226. set js_template {
  227. <script>
  228. const sse = new EventSource('/stream?sid=$sid');
  229. sse.onmessage = (event) => {
  230. const data = JSON.parse(event.data);
  231.  
  232. if(data.status) document.getElementById('status_field').innerText = data.status;
  233. if(data.load) document.getElementById('load_field').innerText = data.load + '%';
  234.  
  235. if(data.alert) {
  236. const feed = document.getElementById('feed');
  237. feed.innerHTML += '🚨 [' + data.from.substring(0,4) + '...]: ' + data.alert + '<br>';
  238. feed.scrollTop = feed.scrollHeight;
  239. }
  240. };
  241. </script>
  242. </body>
  243. </html>}
  244.  
  245. # Appends the safely evaluated script block
  246. append html [subst -nobackslashes -nocommands $js_template]
  247.  
  248. # Transmit the completely formed payload
  249. fconfigure $chan -translation crlf -encoding utf-8 -buffering none
  250. puts $chan "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\n$html"
  251. close $chan
  252. }
  253.  
  254. ;# Open and Register Stream Sockets on Javascript requests
  255. proc establish_sse_stream {chan sid} {
  256. global active_channels
  257. fconfigure $chan -translation lf -blocking 0
  258. puts $chan "HTTP/1.1 200 OK\r\nContent-Type: text/event-stream\r\nCache-Control: no-cache\r\nConnection: keep-alive\r\n"
  259. flush $chan
  260.  
  261. # Register the socket descriptor into our broadcasting layout map
  262. dict set active_channels $sid $chan
  263. # Stream our updates to the client
  264. stream_periodic_updates $chan $sid 1
  265. }
  266.  
  267. proc stream_periodic_updates {chan sid count} {
  268. global sessions active_channels
  269.  
  270. ;# catch and unset our invactive clients
  271. if {[eof $chan] || ![dict exists $sessions $sid]} {
  272. catch {close $chan}
  273. dict unset active_channels $sid
  274. return
  275. }
  276.  
  277. ;# update activity heartbeats while stream remains active
  278. dict set sessions $sid "last_seen" [clock seconds]
  279.  
  280. set user_data [dict get $sessions $sid]
  281. set current_status [dict get $user_data "status"]
  282. set current_load [dict get $user_data "core_load"]
  283. set json_payload "{\"status\":\"$current_status\",\"load\":$current_load}"
  284.  
  285. if {[catch {
  286. puts $chan "data: $json_payload"
  287. puts $chan ""
  288. flush $chan
  289. }]} {
  290. catch {close $chan}
  291. dict unset active_channels $sid
  292. return
  293. }
  294.  
  295. ;# internal cooldown of simulation loops
  296. if {$current_load > 5 && $current_status eq "OVERLOAD_BOOST"} {
  297. set new_load [expr {$current_load - 10}]
  298. dict set user_data "core_load" $new_load
  299. if {$new_load <= 15} {
  300. dict set user_data "status" "Core Normalized"
  301. }
  302. dict set sessions $sid $user_data
  303. }
  304. after 1000 [list stream_periodic_updates $chan $sid [incr count]]
  305. }
  306.  
  307. proc run_garbage_collection {} {
  308. global sessions active_channels
  309. set now [clock seconds]
  310. set expiry_threshold_seconds 30 ;# Expire clients inactive for 30s
  311.  
  312. set expired_tokens {}
  313.  
  314. ;# Check timestamps across our entire universe and append expire
  315. dict for {sid user_data} $sessions {
  316. set last_seen [dict get $user_data "last_seen"]
  317. if {[expr {$now - $last_seen}] > $expiry_threshold_seconds} {
  318. lappend expired_tokens $sid
  319. }
  320. }
  321.  
  322. ;# safely clear expired items outside the iterator loop
  323. foreach sid $expired_tokens {
  324. puts "[clock format $now] - SWEEPER: Session token $sid expired. Purging cache blocks from memory."
  325. dict unset sessions $sid
  326. # If they had an open socket sitting around, disconnect it cleanly
  327. if {[dict exists $active_channels $sid]} {
  328. catch {close [dict get $active_channels $sid]}
  329. dict unset active_channels $sid
  330. }
  331. }
  332.  
  333. ;# schedule the sweeper clock loop to scan again in 10 seconds
  334. after 10000 run_garbage_collection
  335. }
  336.  
  337. socket -server handle_http_request $PORT
  338. puts "Cluster Overlord running on http://localhost:$PORT"
  339. run_garbage_collection
  340. vwait forever
  341.  
  342. ======
  343.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week