/*
Teste do tSktSslSrv
Uso: U_SktHttps
Obs. Configure a sessao [SSLConfigure]
autor: Ricardo Castro Tavares de Lima
[email protected]
*/
#define CRLF (Chr(13) + Chr(10))
// Imprime mensagens de Debug
Static lIsDebug := .T.
// Imprime os Headers recebidos
Static lImpHeader := .T.
// Imprime o Status da conexao
Static lImpStatus := .T.
Function u_SktHttps()
Local nSeq := 0
Local cTCPIdx := ""
Local oSockSrv := Nil
Local nPort := 8008
Local oObjConn := Nil
Local nErrCode := 0
Local cErrMsg := ''
Local SSL2 := 1
Local SSL3 := 1
Local TLS1 := 1
Local PassPhrase := ""
Local cert1 := ""
Local key1 := ""
Local cert2 := ""
Local key2 := ""
Local HSM := 0
Local Bugs := 0
Local State := 0
Local CacheSize := 0
Local Verbose := 0
Local Module := ""
Local nTest := 32
Local cName := "_name_"
Local aResult := {}
/*Local bErrBlk := */ErrorBlock({|e| TT11_ERR2(e, nTest, cName, @aResult) })
// Configure a sessao [SSLConfigure]
PassPhrase := ""
cert1 := "C:\Users\ricardo\compartilhado\ssl_keys_teste\certificate_localhost.crt"
key1 := "C:\Users\ricardo\compartilhado\ssl_keys_teste\certificate_localhost.key"
Begin Sequence
PassPhrase := ""
oSockSrv := tSktSslSrv():New(SSL2, SSL3, TLS1, PassPhrase, cert1, key1, cert2, key2, HSM, Bugs, State, CacheSize, Verbose, Module)
If !oSockSrv:StartTcp(nPort)
nErrCode := oSockSrv:GetError(@cErrMsg)
MyErrMsg("STARTTCP FAILED ("+AllTrim(str(nErrCode))+":"+cErrMsg+")")
Return
EndIf
MyLogMsg("")
MyLogMsg("################################################################################")
MyLogMsg("[SRV] StartTCP OK - Wait for new connection... on port: " + AllTrim(Str(nPort)))
MyLogMsg("################################################################################")
MyLogMsg("")
oObjConn = NIL
While !killapp()
MyDbgMsg("[SRV] new accept")
// Accept sem time-out
oObjConn := oSockSrv:Accept( 0 )
If oObjConn == NIL
nErrCode := oSockSrv:GetError(@cErrMsg)
MyErrMsg("ACCEPT FAILED ("+AllTrim(str(nErrCode))+":"+cErrMsg+")")
loop
EndIf
// Cria identificador unico para esta conexão
// e salva objeto da conexao na memoria
cTCPIdx := "TCP_" + strzero(++nSeq, 6)
MyDbgMsg("### SetSslObj: " + cTCPIdx)
SetSslObj(cTCPIdx, oObjConn)
oObjConn := NIL
// Inicia um job dedicado, passando para ele o nome do
// identificador unico da conexão recebida
StartJob("U_HTTP_PARSER", getenvserver(), .f., cTCPIdx)
Enddo
Recover
End Sequence
If(ValType(oSockSrv) == 'O')
MyLogMsg("Fechando")
// Fecha o Socket Server
oSockSrv:Close()
EndIf
MyLogMsg("Saindo")
Return
Function U_HTTP_PARSER(cTCPId)
Local nMAX_BUFFER:= 10240
Local cOutBuffer := ''
Local nRet := 0
Local cInBuffer
Local nRetAll := 0
Local cInBufferAll := ''
Local oHttpParser
Local bRet := .F.
Local aHeaders := {}
Local aHeader := {}
Local nRetHttpParser := 0
Local nReadBytes := 0
Local nI := 0
Local nJ := 0
Local cStr := ''
Local cURL := ""
Local cMsgResp := ""
Local nCount := 0
Local oObjConn := Nil
// Recupera objeto da conexão
MyDbgMsg("["+cTCPId+"] " + "### GetSslObj")
oObjConn := GetSslObj(cTCPId)
If(ValType(oObjConn) != 'O')
MyErrMsg("["+cTCPId+"] " + "### GetSslObj: ERRO")
Return .F.
EndIf
oHttpParser := tHttpParser():New()
While !killapp()
cInBuffer := space(nMAX_BUFFER)
MyDbgMsg("["+cTCPId+"] " + "### oObjConn:Receive: " + cTCPId + "")
nRet := oObjConn:Receive(@cInBuffer, nMAX_BUFFER, 10)
If nRet < 0
MyErrMsg("["+cTCPId+"] " + "[ERR] Erro ao receber: " + AllTrim(Str(nRet)))
Exit
EndIf
If nRet == 0
MyLogMsg("["+cTCPId+"] " + "Nao chegou nada: " + AllTrim(Str(nRet)) + " (saindo)")
Exit
EndIf
MyDbgMsg("["+cTCPId+"] " + AllTrim(str(nRet))+" Byte(s) recebido(s).")
cInBufferAll := cInBufferAll + cInBuffer
nRetAll := nRetAll + nRet
MyDbgMsg("["+cTCPId+"] " + "Tratando: " + AllTrim(Str(nRetAll)) + " nRet: " + AllTrim(Str(nRet)))
aHeaders := {}
bRet = oHttpParser:Http_Parser(cInBufferAll, nRetAll, @aHeaders, @nRetHttpParser, @nReadBytes)
If ! bRet
If nRetHttpParser == 0 // Parser ok mas incompleto, tenta continuar lendo
MyDbgMsg("["+cTCPId+"] " + "@@@@@ "+" Parser: mensagem incompleta. Retorno: " + AllTrim(Str(nRetHttpParser)) + " lido(s): " + AllTrim(Str(nReadBytes)) + " total: " + AllTrim(Str(nRetAll)) + " Byte(s) recebido(s): " + AllTrim(str(nRet)))
loop
Else // Parser com erro, para de ler a mensagem
MyErrMsg("["+cTCPId+"] " + "##### [ERR] " + "Parser com erro: " + AllTrim(Str(nRetHttpParser)) + " lido(s): " + AllTrim(Str(nReadBytes)) + " total: " + AllTrim(Str(nRetAll)) + " Byte(s) recebido(s): " + AllTrim(str(nRet)))
Exit
EndIf
Else
nCount++
For nI := 1 to Len(aHeaders)
aHeader = aHeaders[nI]
// Imprime os Headers
If(lImpHeader)
cStr := "Header: " + AllTrim(Str(nI)) + " itens: " + AllTrim(Str(Len(aHeader))) + " Campo: "
For nJ := 1 to Len(aHeader)
cStr := cStr + (aHeader[nJ]) + " | "
Next
MyLogMsg("["+cTCPId+"] " + "[REC] " + cStr)
EndIf
If(Len(aHeader) == 2 .And. aHeader[1] == "_URL_")
cURL := aHeader[2]
EndIf
Next
MyLogMsg("["+cTCPId+"] " + "PARSER OK num Headers: " + AllTrim(Str(Len(aHeaders))) + " MSG len: " + AllTrim(Str(nRetAll)) + " lidos: " + AllTrim(Str(nReadBytes)) + " URL: " + cURL + " Count: " + cValToChar(nCount))
EndIf
aHeaders := {}
// Montando a resposta
cMsgResp := "data/hora: [" + cValToChar(date()) + " - " + time() + "]"
cMsgResp += " bytes recebidos: [" + cValToChar(nRetAll) + "]"
cMsgResp += " id: [" + cTCPId + "]"
cMsgResp += " thr: [" + cValToChar(ThreadId()) + "]"
cMsgResp += " URL: [" + cURL + "]"
cMsgResp += " Count: [" + cValToChar(nCount) + "]"
cOutBuffer := "HTTP/1.1 200 OK" + CRLF
cOutBuffer += "Content-Type: text/html" + CRLF
cOutBuffer += "Content-Length: "
cOutBuffer += cValToChar(Len(cMsgResp))
cOutBuffer += CRLF + CRLF
cOutBuffer += cMsgResp
nRetAll := len(cOutBuffer)
MyLogMsg("["+cTCPId+"] " + "TAM ENVIO: " + AllTrim(Str(nRetAll)) + " Byte(s) enviado(s)." + " Count: [" + cValToChar(nCount) + "]")
MyDbgMsg("[" + cOutBuffer + "]")
nRet := oObjConn:Send(cOutBuffer, nRetAll)
If nRet <= 0
MyErrMsg("["+cTCPId+"] " + "[SND][ERR] Erro ao enviar: " + AllTrim(Str(nRetAll)))
Exit
EndIf
cInBufferAll := ''
nRetAll := 0
If(lImpStatus)
MyLogMsg("["+cTCPId+"] " + " +++++++++++++++++++++++++++++++++++++++")
MyLogMsg("["+cTCPId+"] " + " ios: "+cValToChar(oObjConn:nIOSent)+" ior: "+cValToChar(oObjConn:nIORecv)+" bs: "+cValToChar(oObjConn:nBytesSent)+" br: "+cValToChar(oObjConn:nBytesRecv)+" mbs: "+cValToChar(oObjConn:nMaxBytesSent)+" mbr: "+cValToChar(oObjConn:nMaxBytesRecv))
MyLogMsg("["+cTCPId+"] " + " ip: "+cValToChar(oObjConn:GetIPStr()))
MyLogMsg("["+cTCPId+"] " + " DataWaiting: "+cValToChar(oObjConn:DataWaiting()))
MyLogMsg("["+cTCPId+"] " + " IsConnected: "+cValToChar(oObjConn:IsConnected()))
MyLogMsg("["+cTCPId+"] " + " GetStatistics: "+cValToChar(oObjConn:GetStatistics()))
MyLogMsg("["+cTCPId+"] " + " +++++++++++++++++++++++++++++++++++++++")
EndIf
Enddo
MyLogMsg("["+cTCPId+"] " + "conn close ")
If (oObjConn != NIL)
// Fecha o socket desta conexao ..
oObjConn:Close()
oObjConn := NIL
EndIf
oHttpParser := NIL
cTCPId := Nil
nMAX_BUFFER:= Nil
cOutBuffer := Nil
nRet := Nil
cInBuffer := Nil
nRetAll := Nil
cInBufferAll := Nil
bRet := Nil
aHeaders := Nil
aHeader := Nil
nRetHttpParser := Nil
nReadBytes := Nil
nI := Nil
nJ := Nil
cStr := Nil
cURL := Nil
cMsgResp := Nil
nCount := Nil
Return
Static Function TT11_ERR2(e, nTest, cName, aResult)
Local cMsg := ""
cMsg += "(nro: " + AllTrim(Str(nTest)) + ") " + cName + " | "
cMsg += "[[[" + e:Description + "]]]"
cMsg += "{{{" + e:ERRORSTACK + "}}}"
MyErrMsg("Erro: " + cMsg)
Break
Return
Static Function MyLogMsg(cMsg)
Local cThr := " [" + Str(ThreadId(), 5) + "] "
ConOut(time() + cThr + "[HTTP PARSER] " + cValToChar(cMsg))
Return .T.
Static Function MyDbgMsg(cMsg)
If(lIsDebug)
MyLogMsg("[DEBUG] " + cValToChar(cMsg))
EndIf
Return .T.
Static Function MyErrMsg(cMsg)
MyLogMsg("[ERROR] " + cValToChar(cMsg))
Return .T.
|