namespace eval ::ws {
proc read_frame {sock} {
fconfigure $sock -blocking 1
set status [binary scan [read $sock 2] cc byte1 byte2]
if {!$status} { close $sock; return }
set byte1 [expr {$byte1 & 0xFF}]
set byte2 [expr {$byte2 & 0xFF}]
set p_fin [expr {$byte1 >> 7}]
#set p_rsv1 [expr {$byte1 >> 6 & 1}]
#set p_rsv2 [expr {$byte1 >> 5 & 1}]
#set p_rsv3 [expr {$byte1 >> 4 & 1}]
set p_opcode [expr {$byte1 & 0x0F}]
set p_mask [expr {$byte2 >> 7}]
set p_len [expr {$byte2 & 0x7F}]
if {$p_len == 126} {
set status [binary scan [read $sock 2] S p_len]
set p_len [expr {$p_len & 0xFFFF}]
if {!$status} { close $sock; return }
} elseif {$p_len == 127} {
set status [binary scan [read $sock 8] W p_len]
if {!$status} { close $sock; return }
}
if {$p_mask} {
set status [binary scan [read $sock 4] c4 p_mask_key]
if {!$status} { close $sock; return }
set p_mask_bytes
foreach byte $p_mask_key {
lappend p_mask_bytes [expr {$byte & 0xFF}]
}
}
set data [read $sock $p_len]
if {[string length $data] != $p_len} { close $sock; return }
fconfigure $sock -blocking 0
if {$p_mask} {
set octets [binary scan $data c*]
for {set i 0} {$i < [llength $octets]} {incr i} {
set j [expr {$i % 4}]
set octet [lindex $octets $i]
set mask [lindex $p_mask_bytes $j]
lset octets $i [expr {($octet ^ $mask) & 0xFF}]
}
set data [binary format c* $octets]
}
dict create fin $p_fin opcode $p_opcode len $p_len data $data
}
proc send_frame {sock fin opcode data len mask} {
set frame {}
if {$opcode > 16 || $opcode < 0} {
return -code error "Opcode $opcode invalid. Must be in \[0,16\]."
}
append frame [binary format cc \
[expr {($fin ? 128 : 0) + $opcode}] \
[expr {($mask ? 128 : 0) + ($len > 65535 ? 127 : ($len > 125 ? 126 : $len))}]]
if {$len > 65535} {
append frame [binary format W $len]
} elseif {$len > 125} {
append frame [binary format S $len]
}
binary scan $data c* octets
set octets [lrange $octets 0 $len-1]
if {$mask} {
set mask_bytes [list [expr {int(floor(rand() * 256))}] [expr {int(floor(rand() * 256))}] [expr {int(floor(rand() * 256))}] [expr {int(floor(rand() * 256))}]]
append frame [binary format c4 $mask_bytes]
for {set i 0} {$i < [llength $octets]} {incr i} {
set j [expr {$i % 4}]
set octet [lindex $octets $i]
set mask [lindex $mask_bytes $j]
lset octets $i [expr {($octet ^ $mask) & 0xFF}]
}
}
set data [binary format c* $octets]
append frame $data
puts -nonewline $sock $frame
}
proc int-doping {sock} {
if {[chan names $sock] == $sock} return
ping $sock
after 10000 [list ::ws::int-doping $sock]
}
proc ping {sock} {
send_frame $sock 0 9 [sha1::sha1 -hex [expr {rand()}]] 40 1
}
}
namespace eval ::ws::c {
variable callback
variable handshake
variable log [logger::init ::websocket::client]
proc connect {host port path cb {sec {}}} {
variable callback
variable handshake
if {$sec == ""} {
if {$port in {443 8443}} {
set sec 1
} else {
set sec 0
}
} elseif ![string is boolean $sec] {
return -code error "sec must be bool or empty!"
}
if {$sec} {
if {[info procs ::tls::socket] == {}} {package require tls}
set sock [::tls::socket $host $port]
} else {
set sock [socket $host $port]
}
if {[info procs ::sha1::sha1] == {}} {package require sha1}
if {[info procs ::base64::encode] == {}} {package require base64}
set ws_key [::base64::encode -maxlen 0 -wrapchar "" [
string range [::sha1::sha1 [clock microseconds]] 0 15]]
set ws_accept [::base64::encode -maxlen 0 -wrapchar "" [
::sha1::sha1 -- [
string cat $ws_key 258EAFA5-E914-47DA-95CA-C5AB0DC85B11]]]
fconfigure $sock -translation crlf -blocking 0
puts $sock "GET $path HTTP/1.1"
puts $sock "Host: $host"
puts $sock "Upgrade: websocket"
puts $sock "Connection: Upgrade"
puts $sock "Sec-WebSocket-Key: $ws_key"
puts $sock "Sec-WebSocket-Version: 13"
puts $sock ""
flush $sock
fileevent $sock readable [list ::ws::c::int-handshake $sock]
set callback($sock) $cb
set handshake($sock) [dict create headers {} accept $ws_accept status_line {} status_read 0]
return $sock
}
variable frag
variable mode
# no, this isn't technically conformant. but jetstream wouldn't be evil to me so
proc int-handshake {sock} {
variable handshake
variable log
variable frag
variable mode
upvar 0 handshake($sock) state
if ![dict get $state status_read] {
if {[gets $sock status] != -1} {
dict set state status_line $status
dict set state status_read 1
}
}
if [dict get $state status_read] {
while {[gets $sock header] != -1} {
if {$header == {}} {
if {[string first "HTTP/1.1 101 " [dict get $state status_line]] != 0} {
${log}::error "Didn't get \"101 Switching Protocols\" when handshaking $sock."
${log}::error "Status: [dict get $state status_line]"
foreach {k v} [dict get $state headers] {
${log}::error "Header $k: $v"
}
${log}::error "Returned content: [read $sock]"
close $sock
[set callback($sock)] $sock close [dict get $frame data]
return
}
if {[dict get $state headers sec-websocket-accept] != [dict get $state accept]} {
${log}::error "Got incorrect Sec-Websocket-Accept while handshaking $sock."
${log}::error "Expected: [dict get $state accept]"
${log}::error "Got: [dict get $state headers sec-websocket-accept]"
close $sock
[set callback($sock)] $sock close [dict get $frame data]
return
}
# finally, we can connect!
fconfigure $sock -translation binary
set mode($sock) {}
set frag($sock) {}
fileevent $sock readable [list ::ws::c::int-dispatch $sock]
::ws::int-doping $sock
} else {
lassign [split $header :] key value
set key [string tolower [string trim $key]]
set value [string trim $value]
dict set state headers $key $value
}
}
}
}
proc int-dispatch {sock} {
variable log
variable frag
variable mode
variable callback
set frame [::ws::read_frame $sock]
if {$frame == {}} {
${log}::warn "$sock unexpectedly closed!"
[set callback($sock)] $sock close [dict get $frame data]
}
if {[catch {
switch -- [dict get $frame opcode] {
0 {
if {[set mode($sock)] ni {1 2}} {
${log}::error "Got a continuation frame with no starting frame on $sock! Closing!"
close $sock
[set callback($sock)] $sock close [set frag($sock)]
}
append frags($sock) [dict get $frame data]
if {[dict get $frame fin]} {
set frags($sock) {}
}
}
1 {
if {[dict get $frame fin]} {
set mode($sock) {}
set frag($sock) {}
[set callback($sock)] $sock text [dict get $frame data]
} else {
set mode($sock) text
set frag($sock) [dict get $frame data]
}
}
2 {
if {[dict get $frame fin]} {
set mode($sock) {}
set frag($sock) {}
[set callback($sock)] $sock binary [dict get $frame data]
} else {
set mode($sock) binary
set frag($sock) [dict get $frame data]
}
}
8 {
close $sock
[set callback($sock)] $sock close [dict get $frame data]
}
9 {
::ws::send_frame 0 10 [dict get $frame data] [dict get $frame len] 1
}
10 {
# TODO: kill connection on missed ping? but jetstream doesn't send any it looks like
}
default {
${log}::error "Unknown opcode [dict get $frame opcode] on $sock! Closing!"
close $sock
[set callback($sock)] $sock close [dict get $frame data]
}
}
} return]} {
${log}::error "error in websocket callback for ${sock}: $result"
}
}
}