SR Technology WTK Repo
Check-in [dc0569b9cb]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:enhanced WebSockets send proc to handle frames larger than 126 bytes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: dc0569b9cbcb5c23ef217c16dcc548bd939828c0
User & Date: stever 2013-01-18 20:27:22
Context
2013-01-18
20:28
add file upload example to demo, modify server to save file as upload-the_filename check-in: 9b911eb983 user: stever tags: trunk
20:27
enhanced WebSockets send proc to handle frames larger than 126 bytes check-in: dc0569b9cb user: stever tags: trunk
19:25
Added stubs for most commands. check-in: e2ff912839 user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to server.tcl.

25
26
27
28
29
30
31


32
33





























34
35
36
37
38
39
40
41
42
package require sha1
source lib/httpd.tcl

proc bgerror {message} {puts stderr "bgerror: $message\n$::errorInfo"}
set ::log log
proc log {args} {puts $args}




proc ws_send { sock message } {





























	puts -nonewline $sock [binary format cc 0x81 [string length $message]]$message
	flush $sock
}

# WebSocket handler proc to receive short (up to 126 chars) text format frames
#
proc ws_receive { handler sock } {
	
	if { [chan eof $sock] } {






>
>

<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|







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
package require sha1
source lib/httpd.tcl

proc bgerror {message} {puts stderr "bgerror: $message\n$::errorInfo"}
set ::log log
proc log {args} {puts $args}

proc ws_send {sock {msg ""} {type text} {final 1}} {
    puts "ws_send $type $msg"


    # Compute the opcode.  The opcode is zero for continuation frames.
    upvar #1 fragment fragment
    if {[info exists fragment]} {
        set opcode 0
    } else {
        set opcode [dict get {text 1 binary 2 ping 9} $type]
    }
    if {!$final} {
        set fragment ""
    } else {
        unset -nocomplain fragment
    }

    # Encode text.
    if {$type eq "text"} {
        set msg [encoding convertto utf-8 $msg]
    }

    # Assemble the header.
    set header [binary format c [expr {!!$final << 7 | $opcode}]]
    if {[string length $msg] < 126} {
        append header [binary format c [string length $msg]]
    } elseif {[string length $msg] < 65536} {
        append header \x7e[binary format Su [string length $msg]]
    } else {
        append header \x7f[binary format Wu [string length $msg]]
    }

    # Send the frame.
    chan puts -nonewline $sock $header$msg
    chan flush $sock
}

# WebSocket handler proc to receive short (up to 126 chars) text format frames
#
proc ws_receive { handler sock } {
	
	if { [chan eof $sock] } {