TSktSslSrv

Conexão segura (SSL) para Protheus 11
Classe: tSktSslSrv ()
Permite o gerenciamento de conexões TCP seguras (SSL).
Método: New("NRNRNRCRCRCRCOCONONONONONOCO")
Cria um objeto da Classe Server Socket SSL (Servidor SSL).
Entrada:
SSL2 – (Número) 0 (zero) indica desabilitado, senão habilitado.
SSL3 – (Número) 0 (zero) indica desabilitado, senão habilitado.
TLS1 – (Número) 0 (zero) indica desabilitado, senão habilitado.
PassPhrase – (String) Senha.
Certificate – (String) arquivo de certificado.
Key – (String) arquivo de chave.
Certificate2 – (String - opcional) arquivo de certificado secundário.
Key2 – (String - opcional) arquivo de chave secundário.
HSM – (Número - opcional) 0 (zero) indica desabilitado, senão habilitado.
Bugs – (Número - opcional) 0 (zero) indica desabilitado, senão habilitado.
State – (Número - opcional) 0 (zero) indica desabilitado, senão habilitado.
CacheSize – (Número - opcional).
Verbose – (Número - opcional) 0 (zero) indica desabilitado, senão habilitado.
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()