tcl中的TCP套接字编程

时间:2014-07-22 06:58:43

标签: tcl

我正在编写一个Web服务器,其中Web服务器将从客户端获取Hello-Request,因为我必须发送Hello响应。一旦发送了hello响应,它就会进入命令执行模式,这里无论给出的命令是什么,都会被发送到客户端。

这里收到hello-request服务器后发送确认。这样套接字就会关闭。当我发送hello-response时,连接已关闭(客户端正在回复[RST,ACK])。如何停止自动确认hello-request数据包并保持套接字打开直到服务器关闭。

proc dmePrompt {} {
    puts -nonewline "DME#>"
    flush stdout
}

proc sendResponseFor {sock msg} {
    global uuid timeStamp
    puts "Hello "
    if {[dict get $msg Action] == "HELLOREQUEST"} {                 
        set uuid [dict get $msg ID]    
        set timestamp "[clock format [clock seconds] -format "%D %H:%M:%S"] UTC"    
        #Construct hello response structure
        set helloResp "
                Action      {HELLORESPONSE member}
                Body        {{\
                                isAuthorized        {true member}\
                                hostname            {DME1 member}\
                                ipAddress           {$::ipAddr member}\
                                timestamp           {$timestamp member}\
                                token               {aabbccddeeff member}\
                                newKey              {abcdqwertyuiops member}\
                                redirect            {false member}\
                                flags               {null member}\
                                keepAliveInterval   {1000 member}\
                                forceInsecure       {false member}} object}\
                ID          {$uuid member}\
                TimeStamp   {$timestamp member}\
                isError     {false member}"

        set jsonResp [encodeJson $helloResp]
        set dataLen [format %08X [expr [string length [getHexForAsciiChars $jsonResp]] / 2]]
        if {[info exists headerLen] && $headerLen == 8} {
            append dataLen "00000000"
        }         

        puts $sock "$dataLen$jsonResp"
        flush $sock
        enterCmdExecMode $sock
    }

}
proc enterCmdExecMode {sock} {
    set readData 1
    while {1} {
        dmePrompt
        gets stdin cmd
    }    
}
proc readsock {sock} {
    global buffer      
    if {[gets $sock request] < 0} {
        close $sock
    } else {
        binary scan $request H* data
        append buffer $data

        #set dataLen [string range $buffer 0 7]
        #set dataLen [expr (0x$dataLen + 8) * 2 -1]
        set dataLen 703
        if {[string length $buffer] < $dataLen} {
            set readData 1
        } else {
            set hexData [string range $buffer 8 $dataLen]
            set buffer [string range $buffer [expr $dataLen +1] end]
            if {$::encryptionEnabled} {
                set hexData [decryptAES 121301080D010518130E082007136412 $hexData]                
            }
            set data [hexToString $hexData]
            set msg [json::json2dict $data]  
            sendResponseFor $sock $msg                                        
        }
    }
}
set server [socket -server serverOpen 33000]
proc server_accept {sock addr port} {
    puts "Connection request received from $addr $port"
    fconfigure $sock -buffering none -translation binary
    fileevent $sock readable [list readsock $sock]    
}
socket -myaddr $ipAddr -server server_accept 33444
dmePrompt
set readData 0
vwait readData

1 个答案:

答案 0 :(得分:1)

没有什么特别明显的错误,但你应该通过使用非阻塞套接字来编写你的阅读器代码以使其更加异步。

proc server_accept {sock addr port} {
    puts "Connection request received from $addr $port"
    fconfigure $sock -buffering none -translation binary -blocking 0
    fileevent $sock readable [list readsock $sock]    
}
proc readsock {sock} {
    global buffer      
    if {[gets $sock request] < 0} {
        if {[eof $sock]} {
            close $sock
        }
        return
    }
    # No need to put the rest inside an “else” arm because of the “return”

    ...
}

您的代码还打开了第二个服务器套接字,但您没有显示其余的代码,您可能应该设置a bgerror handler,以便完全报告事件处理中的任何问题:

proc bgerror msg {
    # Copy this immediately, as “clock format” is implemented in Tcl internally
    set stackTrace $::errorInfo
    puts stderr "[clock format [clock seconds]]: $msg\n$stackTrace"
}