~aleteoryx/tclfeed-bsky

ref: 791e2e2163bed854cfe84a47dfbe280d2710d808 tclfeed-bsky/src/ws.tcl -rw-r--r-- 7.9 KiB
791e2e21Aleteoryx gotta complain somewhere! 30 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
namespace eval ::ws {
  proc read_frame {sock} {
    fconfigure $sock -blocking 1

    if ![binary scan [read $sock 2] cc byte1 byte2] {
      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} {
      binary scan [read $sock 2] S p_len
      set p_len [expr {$p_len & 0xFFFF}]
    } elseif {$p_len == 127} {
      binary scan [read $sock 8] W p_len
    }

    if {$p_mask} {
      binary scan [read $sock 4] c4 p_mask_key
      set p_mask_bytes
      foreach byte $p_mask_key {
        lappend p_mask_bytes [expr {$byte & 0xFF}]
      }
    }

    set data [read $sock $p_len]
    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} {
    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]
    }

    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
        }
        append frags($sock) [dict get $frame data]
        if {[dict get $frame fin]} {
          [set callback($sock)] $sock [set mode($sock)] [set frag($sock)]
          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]
      }
    }
  }
}