TCP Socket programming in tcl

Question

I am writing a web server where web server will get Hello-Request from client, for that I have to send Hello response. Once after sending hello response it enters into command execution mode, here whatever the commands given will be sent to the client.

Here after receiving hello-request server is sending acknowledgement. So that the socket is getting closed. When I am sending the hello-response the connection got closed (client is replying with [RST,ACK]). How to stop auto-acknowledging the hello-request packet and keep the socket open until server closed.

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

Answer 1

There's nothing particularly obviously wrong, but you should write your reader code to be more asynchronous by using non-blocking sockets.

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”

    ...
}

There's also a second server socket being opened by your code, but you're not showing the rest of the code for that, and you probably ought to set up a bgerror handler so any problems in event handling get reported fully:

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"
}