Advertisement
anticrisis

single-threaded 9.5ms latency

Jan 24th, 2021 (edited)
1,492
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 2.06 KB | None | 0 0
  1. namespace eval ::userdb::http {
  2.  
  3.     proc Send {res chan} {
  4.         # translation mode is crlf, no need to insert \r
  5.         fileevent $chan writable {}
  6.         fileevent $chan readable {}
  7.         set len [string length $res]
  8.         puts -nonewline $chan \
  9.             "HTTP/1.0 200 OK\nContent-Type: text/plain; charset=UTF-8\nContent-Length: $len\n\n"
  10.         puts -nonewline $chan $res
  11.         catch {chan close $chan}
  12.     }
  13.  
  14.     proc BadRequest {chan} {
  15.         puts $chan "HTTP/1.0 400 Bad Request\n\n"
  16.         catch {chan close $chan}
  17.     }
  18.  
  19.     proc Read {ctx lines chan} {
  20.         if {[gets $chan line] >= 0} {
  21.             if {$line eq ""} {
  22.                 # End of Full-Request. Ignore everything after Request-Line
  23.                 foreach {method path rest} [split [lindex $lines 0]] {
  24.                     switch $method {
  25.                         GET {
  26.                             set res [[dict get $ctx GET] $ctx $path]
  27.                             fileevent $chan writable [list [namespace current]::Send $res $chan]
  28.                         }
  29.                         default {
  30.                             fileevent $chan writable [list [namespace current]::BadRequest $chan]
  31.                         }
  32.                     }
  33.                 }
  34.             }
  35.  
  36.             # Replace handler with new state
  37.             fileevent $chan readable [list [namespace current]::Read $ctx [lappend lines $line] $chan]
  38.         }
  39.  
  40.         if {[eof $chan]} {
  41.             close $chan
  42.         }
  43.     }
  44.  
  45.     proc Server {ctx chan clientaddr clientport} {
  46.         chan configure $chan -blocking 0 -buffering line -translation crlf -encoding utf-8
  47.         fileevent $chan readable [list [namespace current]::Read $ctx {} $chan]
  48.     }
  49.  
  50.     proc HandleGet {ctx path} {
  51.         return "hello, world."
  52.     }
  53.  
  54.     proc serve {} {
  55.         set ctx [dict create GET [namespace current]::HandleGet]
  56.  
  57.         puts "Listening on http://127.0.0.1:8112"
  58.         socket -server [list [namespace current]::Server $ctx] -myaddr 127.0.0.1 8112
  59.         vwait forever
  60.     }
  61. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement