Árvore de páginas

Versões comparadas

Chave

  • Esta linha foi adicionada.
  • Esta linha foi removida.
  • A formatação mudou.
Composition Setup
import.css=/download/attachments/327912/newLayout.css
Portuguese

...

Classe: tSktSslSrv

...

Permite o gerenciamento de conexões TCP seguras (SSL).


Hierarquia


 

A classe não possui hierarquia.



Construtores

...



New

...

Cria

...

uma instância da classe tSktSslSrv.


Sintaxe



tSktSslSrv():New( < nSSL2 >, < nSSL3 >, < nTLS1 >, < cPassPhase >, < cCertificate >, < cKey >,

    < cCertificate2 >, < cKey2 >, < nHSM >, < nBugs >, < nState >, < nCacheSize >, < nVerbose >, < cModule >) --> oRet

Parâmetros





Nome

Tipo

Descrição

Obrigatório

Referência

nSSL2

Numérico

0 (zero) indica desabilitado, senão habilitado

X


nSSL3

Numérico

0 (zero) indica desabilitado, senão habilitado

...

X


nTLS1

Numérico

0 (zero)

...

, 1, 2, ou 3. Ver quadro TLS1 

X


cPassPhase

Caracter

Senha

X


cCertificate

Caracter

arquivo de certificado

X


cKey

Caracter

arquivo de chave

X


cCertificate2

Caracter

arquivo de certificado secundário



cKey2

Caracter

arquivo de chave secundário



nHSM

Numérico

0 (zero) indica desabilitado, senão habilitado

...



nBugs

Numérico

0 (zero) indica desabilitado, senão habilitado



nState

Numérico

0 (zero) indica desabilitado, senão habilitado



nCacheSize

Numérico

Define o tamanho do cache interno



nVerbose

Numérico

0 (zero) indica desabilitado, senão habilitado



cModule

Caracter

Indica o módulo Criptoki



Retorno


 

Nome

Tipo

Descrição

oRet

Objeto

Cria um objeto da Classe Server Socket SSL (Servidor SSL)

Quadro TLS1

Valores válidos para TLS1

Valor

Descrição

0 (default)Desabilita
1TLS 1.0
2TLS 1.0 e TLS 1.1
3TLS 1.0, TLS 1.1, e TLS 1.2

Observações

Ver Seção [SSLConfigure] para as definições.

Exemplo


 

  Local SSL2 := 1

  Local SSL3 := 1

  Local TLS1 := 3

  Local PassPhrase := "senha"

  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 := ""


  cert1 := "..\..\Users\ricardo.clima\compartilhado\ssl_keys_teste\rsa_privkey_self_cert.crt"

  key1 := "..\..\Users\ricardo.clima\compartilhado\ssl_keys_teste\rsa_privkey.pem"


  oSockSrv := tSktSslSrv():New(SSL2, SSL3, TLS1, PassPhrase, cert1, key1,

    cert2, key2, HSM, Bugs, State, CacheSize, Verbose, Module)



Métodos



StartTcp

Faz o bind e o listen em uma porta específica do servidor e verifica os certificados e configurações da conexão SSL.


Sintaxe



TSktSslSrv():StartTcp ( < nPort >, < cServerName > ) --> lRet

Parâmetros



Nome

Tipo

Descrição

Obrigatório

Referência

nPort

Numérico

Porta de conexão

X


cServerName

Caracter

Identificação do servidor de conexão



Retorno


 

Nome

Tipo

Descrição

lRet

Lógico

Retorna verdadeiro (.T) se conseguiu fazer o bind, o listen na porta e verificar as configurações da

conexão SSL, e falso (.F.) se não conseguir estabelecer uma conexão na porta

Observações


 


Exemplo


 

lRet = oSockSrv:StartTcp(nPort)




Accept

Faz a aceitação de uma conexão SSL.


Sintaxe



TSktSslSrv():Accept ( < nTimeOut > ) --> oObjConn

Parâmetros



Nome

Tipo

Descrição

Obrigatório

Referência

nTimeOut

Numérico

Timeout de aguarde de aceitação em segundos

X


Retorno


 

Nome

Tipo

Descrição

oObjConn

Objeto

Se conseguiu aceiar uma conexão retorna um objeto do tipo “tSktSslConn” e em caso de falha

retorna nulo (NIL)

Observações


 

Se nTimeOut  for 0 (zero) fica aguardando indefinidamente até aceitar uma conexão.

Se houver algum erro, ou se houver timeout de aceitação de uma conexão, será retornado nulo (NIL).

Exemplo


 

    …

    oObjConn := oSockSrv:Accept( 0 )


    If oObjConn = NIL

      nErrCode := oSockSrv:GetError(@cErrMsg)

      conout(time() + " " + "[ERR] ACCEPT FAILED ("+AllTrim(str(nErrCode))+":"+cErrMsg+")")

      loop

    Endif




GetError

Obtém o erro gerado no Servidor.


Sintaxe



TSktSslSrv():GetError ( < cMsgErr > ) --> nRet

Parâmetros



Nome

Tipo

Descrição

Obrigatório

Referência

cMsgErr

Caracter

Contém a mensagem de erro

X

Retorno


 

Nome

Tipo

Descrição

nRet

Lógico

Contém o código do erro

Observações


 

Se não houver erro será retornado 0 (zero).

Exemplo


 

nErrCode := oSockSrv:GetError(@cErrMsg)




Close

Fecha o servidor SSL.


Sintaxe



TSktSslSrv():Close() --> lRet

Parâmetros




Retorno


 

Nome

Tipo

Descrição

lRet

Lógico

Verdadeiro (.T.) se fechou corretamente ou falso (.F.) se houve algum erro no fechamento

Observações


 


Exemplo


 

lRet := oSockSrv:Close()



Propriedades



nAccepted

Indica o número de clientes que foram aceitos (conectados).


Sintaxe



TSktSslSrv():nAccepted

Retorno


 

Nome

Tipo

Descrição

nAccepted

Numérico

Indica o número de clientes que foram aceitos (conectados)

Observações


 


Exemplo


 

nAccepted := oSockSrv:nAccepted


 


lBinded

Indica se o servidor está conectado e escutando a porta.


Sintaxe



TSktSslSrv():lBinded

Retorno


 

Nome

Tipo

Descrição

lBinded

Lógico

Indica se o servidor está conectado e escutando a porta

Observações


 


Exemplo


 

lBinded := oSockSrv:lBinded



Bloco de código
languagecpp
titleExemplo HTTP Parser
linenumberstrue
collapsetrue
/*
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.




Abrangência

Protheus 11 com release superior a 7.00.121227P


Veja Também

tSktSslConn , SetSslObj , GetSslObj , Seção [SSLConfigure]


Âncora
_GoBack
_GoBack
.
Module – (String - opcional) .
Saída:
Nada.
Retorno:
(tSktSslSrv) Objeto da Classe Server Socket SSL.
Método: StartTcp ("NRCO")
Faz o bind e o listen em uma porta específica do servidor e verifica os certificados e configurações da conexão SSL.
Entrada:
porta - (Número) Porta de conexão.
servername - (String - opcional) Identificação do servidor de conexão.
Saída:
Nada.
Retorno:
(Lógico )True – se conseguiu fazer o bind, o listen na porta e verificar as configurações da conexão SSL, False – se não conseguir estabelecer uma conexão na porta.
Método: Accept ("NR")
Faz a aceitação de uma conexão SSL.
Entrada:
timeout - (Número) Timeout de aguarde de aceitação em segundos.
Obs. Se 0 (zero) fica aguardando indefinidamente até aceitar uma conexão .
Saída:
Nada.
Retorno:
(tSktSslConn) Se conseguiu conectar retorna um objeto do tipo "tSktSslConn" e em caso de falha retorna nulo (NIL).
Método: GetError ("CR")
Otbem o erro gerado no Servidor.
Saída:
Mensagem erro - (String) Contém a mensagem de erro.
Entrada:
Nada.
Retorno:
(Número) Código do erro.
Obs. Se não houver erro será retornado 0 (zero).
Método: Close ("")
Fecha o servidor SSL.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(Lógico) True Se fechou corretamente, False se houve algum erro no fechamento.
Propriedade: nAccepted
(Número) Indica o número de clientes que foram aceitos (conectados).
Propriedade: lBinded
(Lógico) Indica se o servidor está conectado e escutando a porta.
Classe: tSktSslConn ()
Método: New("")
Cria um objeto da Classe de Conexão de Socket SSL (Conexão SSL).
Entrada:
Nada.
Saída:
Nada.
Retorno:
(tSktSslConn) Objeto da Classe de Conexão de Socket SSL.
Método: Send ("CRNR")
Envia um buffer de dados.
Entrada:
buffer - (String) Buffer a ser enviado.
len - (Número) Número de bytes a serem enviados.
Saída:
Nada.
Retorno:
(Número) – Número de bytes enviados.
Método: Receive ("CRNRNO")
Recebe um buffer com os dados.
Saída:
buffer - (String) Buffer com os dados recebidos.
Entrada:
len - (Número) Número de bytes a serem enviados.
timeout - (Número-opcional) Timeout de recepção de dados.
Retorno:
(Número) – Número de bytes recebidos.
Método: GetError ("CR")
Otbem o erro gerado na Conexão.
Saída:
Mensagem erro - (String) Contém a mensagem de erro.
Entrada:
Nada.
Retorno:
(Número) Código do erro.
Obs. Se não houver erro será retornado 0 (zero).
Método: Close ("")
Fecha a Conexão SSL.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(Lócigo) True Se fechou corretamente, False se houve algum erro no fechamento.
Método: DataWaiting("")
Verifica a quantidade de bytes disponíveis para leitura.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(Número) – quantidade de bytes disponíveis para leitura.
Método: GetIPStr ("")
Retorna o IP do Cliente conectado nesta conexão.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(String) – IP do cliente conectado a esta conexão.
Método: SetVerbose ("LR")
Indica se deve ou não gerar mensagens de Debug.
Entrada:
(Lógico) - Se True indica que deve gerar mensagens de Debug, caso contrário não imprime.
Saída:
Nada.
Retorno:
(Lógico) - True Setou corretamente, False se houve algum erro.
Método: IsConnected ("")
Verifica se a conexão está conectada e válida.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(Lógico) True Se está conectada, e False se caso contrário.
Método: GetStatistics ("")
Atualiza as propriedades como as estatísticas do canal.
Entrada:
Nada.
Saída:
Nada.
Retorno:
(Lógico )True Se atualizou corretamente, e False se caso contrário.
Propriedade: nIOSent
(Número) número de envios.
Propriedade: nIORecv
(Número) número de envios.
Propriedade: nBytesSent
(Número) total de bytes enviados.
Propriedade: nBytesRecv
(Número) total de bytes recebidos.
Propriedade: MaxBytesSent
(Número) total de bytes enviados em uma mensagem.
Propriedade: MaxBytesRecv
(Número) total de bytes recebidos em uma mensagem.
Função: SetSslObj ("CR*R")
Armazena um objeto da classe de conexão SSL para poder ser usada em outra thread.
Entrada:
Id - (String) Identificador único para o objeto da classe de conexão SSL.
Sslconn – (tSktSslConn) Classe de conexão SSL.
Saída:
Nada.
Retorno:
Nada.
Função: GetSslObj ("CR")
Obtem o objeto da classe de conexão SSL previamente armazenada.
Entrada:
Id - (String) Identificador único para o objeto da classe de conexão SSL.
Saída:
Nada.
Retorno:
(tSktSslConn) Classe de conexão SSL armazenada no Id, e nulo (NIL) caso não seja encontrada.
Nota: Foram feitas alterações na inicialização das funções de SSL, obrigando que os certificados e as chaves seja válidos, com isto ao se tentar ativar o Protheus tendo uma sessão "HTTPS", porém com certificado ou chaves inválidas na sessão "SSLConfigure", o sistema acusará um erro de ativação.
Exemplo de uso em ADVPL:
Obs. o Exemplo combina o uso de conexão segura SSL com Jobs IPC e fazendo o parser HTML da mensagem recebida do browser.
#include 'protheus.ch'
#define MYIPCJOB_ "MYJOBIPC"
User Function RPoolStart()
conout(time() + " RPoolStart -> " + MYIPCJOB_ + " [Thread " + AllTrim(Str(ThreadId())) + "]")
return .T.
User Function RPoolExit()
conout(time() + " RPoolExit -> " + MYIPCJOB_ + " [Thread " + AllTrim(Str(ThreadId())) + "]")
return .T.
User Function RPoolConn(par1)
Local cTCPId := par1
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 str := ''
conout(time() + " " + "RPoolConn" + " ["cTCPId"] " + "[SRV] ""Thread on GoTCP ["+cTCPId"]" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
// Recupera objeto da conexão
oObjConn := GetSslObj(cTCPId)
oHttpParser := tHttpParser():New()
While !killapp()
cInBuffer := space(nMAX_BUFFER)
nRet := oObjConn:Receive(cInBuffer, nMAX_BUFFER, 10)
if nRet < 0
conout(time() + " " + "["cTCPId"] " + "[SRV][ERR] Erro ao receber: " + AllTrim(Str(nRet)) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
exit
Endif
IF nRet == 0
conout(time() + " " + "["cTCPId"] " + "[SRV][ERR] Nao chegou nada: " + AllTrim(Str(nRet)) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
exit
Endif
cInBufferAll := cInBufferAll + cInBuffer
nRetAll := nRetAll + nRet
aHeaders := {}
bRet = oHttpParser:Http_Parser(cInBufferAll, nRetAll, @aHeaders, @nRetHttpParser, @nReadBytes)
If ! bRet
conout(time() + " " + "["cTCPId"] " + "@@@@@ [SRV] "+"Erro no parser da mensagem. Erro: " + AllTrim(Str(nRetHttpParser)) + " lidos: " + AllTrim(Str(nReadBytes)) + " total: " + AllTrim(Str(nRetAll)) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
If nRetHttpParser == 0 // Parser ok mas incompleto, tenta continuar lendo
loop
Else // Parser com erro, para de ler a mensagem
conout(time() + " " + "["cTCPId"] " + "##### [SRV][ERR] " + "Parser com erro: " + AllTrim(Str(nRetHttpParser)) + " lidos: " + AllTrim(Str(nReadBytes)) + " total: " + AllTrim(Str(nRetAll)) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
Endif
Else
// PARSER OK
For nI := 1 to Len(aHeaders)
aHeader = aHeaders[nI]
str := "Header: " + AllTrim(Str(nI)) + " itens: " + AllTrim(Str(Len(aHeader))) + " Campo: "
For nJ := 1 to Len(aHeader)
str := str + (aHeader[nJ]) + " | "
Next
conout(time() + " " + "["cTCPId"] " + "[SRV] " + str + " [Thread " + AllTrim(Str(ThreadId())) + "]")
Next
Endif
cOutBuffer := "HTTP/1.1 200 OK"+CRLF
cOutBuffer += "Content-Type: text/html"+CRLF
cOutBuffer += "Content-Length: 53"+CRLF+CRLF
cOutBuffer = "["time()+"]"
cOutBuffer = " size: "strzero(nRetAll, 20) + " bytes recebidos"
nRetAll := len(cOutBuffer)
nRet := oObjConn:Send(cOutBuffer, nRetAll)
if nRet <= 0
conout(time() + " " + "["cTCPId"] " + "[SRV][ERR] Erro ao enviar: " + AllTrim(Str(nRetAll)) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
exit
Endif
cInBufferAll := ''
nRetAll := 0
Enddo
conout(time() + " " + "["cTCPId"] " + "[SRV] conn close " + " [Thread " + AllTrim(Str(ThreadId())) + "]" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
If (oObjConn != NIL)
// Fecha o socket desta conexao ..
oObjConn:Close()
oObjConn := NIL
Endif
oHttpParser := NIL
return .T.
User Function RTestSSL()
Local nSeq := 0
Local cTCPIdx := time()
Local oSockSrv
Local nPort := 8008
Local oObjConn
Local nErrCode,cErrMsg := ''
Local ret := .F.
Local SSL2 := 1
Local SSL3 := 1
Local TLS1 := 1
Local PassPhrase := "siga"
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 := ""
cert1 := "..\..\Users\ricardo.clima\compartilhado\ssl_keys_teste\rsa_privkey_self_cert.crt"
key1 := "..\..\Users\ricardo.clima\compartilhado\ssl_keys_teste\rsa_privkey.pem"
conout(time() + " RTestSSL" + " [Thread " + AllTrim(Str(ThreadId())) + "] (Criando SSL)")
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)
conout(time() + " " + "[SRV][ERR] RTestSSL FAILED ("AllTrim(str(nErrCode))":"cErrMsg")" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
return
Endif
conout(time() + " " + "[SRV] RTestSSL OK - Wait for new connection... on port: " + Str(nPort) + " [Thread " + AllTrim(Str(ThreadId())) + "]")
oObjConn = NIL
While !killapp()
If oObjConn = NIL
conout(time() + " " + "[SRV] new accept" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
// Accept sem time-out
oObjConn := oSockSrv:Accept( 0 )
Endif
If oObjConn = NIL
nErrCode := oSockSrv:GetError(@cErrMsg)
conout(time() + " " + "[SRV][ERR] ACCEPT FAILED ("AllTrim(str(nErrCode))":"cErrMsg")" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
loop
Endif
// Cria identificador unico para esta conexão
// e salva objeto da conexao na memoria
cTCPIdx := "TCP_" + strzero(++nSeq, 6)
SetSslObj(cTCPIdx, oObjConn)
// Ativa um ipc job dedicado, passando para ele o nome do
// identificador unico da conexão recebida
conout(time() + " " + "[SRV] " + MYIPCJOB_ + ": " + cTCPIdx + " [Thread " + AllTrim(Str(ThreadId())) + "]")
ret = IpcGo(MYIPCJOB_, cTCPIdx)
If ret
Else
conout(time() + " " + "[SRV][ERR] " + MYIPCJOB_ + ": " + cTCPIdx + " [Thread " + AllTrim(Str(ThreadId())) + "]")
// Recupera objeto da conexão
oObjConn := GetSslObj(cTCPIdx)
If (oObjConn != NIL)
// Fecha o socket desta conexao ..
conout(time() + " " + "["cTCPIdx"] " + "[SRV] conn close " + " [Thread " + AllTrim(Str(ThreadId())) + "]")
oObjConn:Close()
oObjConn := NIL
Endif
Endif
oObjConn := NIL
cTCPIdx := NIL
Enddo
conout(time() + " " + "[SRV] Saindo" + " [Thread " + AllTrim(Str(ThreadId())) + "]")
// Fecha o Socket Server
oSockSrv:Close()
return .T.
Uso: u_RTestSSL()