;************************
;* Library : ltls.pbi
;* 
;* Server side TLS Implementation to communicate encrypted.
;* 
;* Created and develobed by Linder Hard- und Software
;* 
;* Current only usable for Linux.
;*
;*

CompilerIf #PB_Compiler_OS <> #PB_OS_Linux
  CompilerError "Only for Linux"
CompilerEndIf

XIncludeFile "lsocket.pbi"

DeclareModule ltls
  Structure s_tls_server
    CA.s
    Cert.s
    Key.s
    Password.s
  EndStructure
  
  Declare InitSimpleTLS(CA.s, Cert.s, Key.s, Password.s, TLSID.i = 0)
  Declare InitTLS(*Settings.s_tls_server, TLSID.i = 0)
  Declare WaitTLSSocket(ServerSocket.i, TLSID.i = 0)
  Declare ReadTLSSocket(Connection.i, *Buffer, Length.i)
  Declare WriteTLSSocket(Connection.i, *Buffer, Length.i)
  Declare CloseTLSSocket(Connection.i)
  Declare CloseTLS(TLSID.i = 0)
  Declare.s ErrorTLSSrv(TLSID.i = 0)
  Declare.s ErrorTLSCli(Connection)
  
EndDeclareModule

Module ltls
  PrototypeC.i Pr_tls_init()
  PrototypeC.i Pr_tls_config_new()
  PrototypeC.i Pr_tls_load_file_pw(FileName.p-utf8, Length, Password.p-utf8)
  PrototypeC.i Pr_tls_load_file(FileName.p-utf8, Length, Passord.s = #Null$)
  PrototypeC.i Pr_tls_config_set_ca_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_cert_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_key_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_server()
  PrototypeC.i Pr_tls_configure(*ctx, *cfg)
  PrototypeC.i Pr_tls_error(*ctx)
  PrototypeC.i Pr_tls_accept_socket(*ctx, *cctx, Socket.l)
  PrototypeC.i Pr_tls_accept_cbs(*ctx, *cctx, read_cb.i, write_cb.i, arg_ch.i = #Null)
  PrototypeC.i Pr_tls_read(*cctx, *buffer, Size.i)
  PrototypeC.i Pr_tls_write(*cctx, *buffer, Size.i)
  PrototypeC.i Pr_tls_handshake(*cctx)
  PrototypeC.i Pr_tls_close(*cctx)
  PrototypeC.i Pr_tls_free(*ctx)
  PrototypeC.i Pr_tls_config_free(*cfg)
  
  
  #TLS_WANT_POLLIN = -2
  #TLS_WANT_POLLOUT   = -3
  
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    Define libressl_tls = OpenLibrary(#PB_Any, "/usr/lib64/libtls.so.20")
  CompilerElse
    Define libressl_tls = OpenLibrary(#PB_Any, "/usr/lib/libtls.so.20")
  CompilerEndIf
  
  
  If IsLibrary(libressl_tls)
    Define Call_tls_init = GetFunction(libressl_tls, "tls_init")
    Define Call_tls_config_new = GetFunction(libressl_tls, "tls_config_new")
    Define Call_tls_load_file = GetFunction(libressl_tls, "tls_load_file")
    Define Call_tls_config_set_ca_mem = GetFunction(libressl_tls, "tls_config_set_ca_mem")
    Define Call_tls_config_set_cert_mem = GetFunction(libressl_tls, "tls_config_set_cert_mem")
    Define Call_tls_config_set_key_mem = GetFunction(libressl_tls, "tls_config_set_key_mem")
    Define Call_tls_server = GetFunction(libressl_tls, "tls_server")
    Define Call_tls_configure = GetFunction(libressl_tls, "tls_configure")
    Define Call_tls_error = GetFunction(libressl_tls, "tls_error")
    Define Call_tls_accept_socket = GetFunction(libressl_tls, "tls_accept_socket")
    Define Call_tls_accept_cbs = GetFunction(libressl_tls, "tls_accept_cbs")
    Define Call_tls_read = GetFunction(libressl_tls, "tls_read")
    Define Call_tls_write = GetFunction(libressl_tls, "tls_write")
    Define Call_tls_handshake = GetFunction(libressl_tls, "tls_handshake")
    Define Call_tls_close = GetFunction(libressl_tls, "tls_close")
    Define Call_tls_free = GetFunction(libressl_tls, "tls_free")
    Define Call_tls_config_free = GetFunction(libressl_tls, "tls_config_free")
  Else
    Debug "libtls.so Library Not found"
    End
  EndIf
  
  
  Global.Pr_tls_init tls_init = Call_tls_init
  Global.Pr_tls_config_new tls_config_new = Call_tls_config_new
  Global.Pr_tls_load_file tls_load_file = Call_tls_load_file
  Global.Pr_tls_load_file_pw tls_load_file_pw = Call_tls_load_file
  Global.Pr_tls_config_set_ca_mem tls_config_set_ca_mem = Call_tls_config_set_ca_mem
  Global.Pr_tls_config_set_cert_mem tls_config_set_cert_mem = Call_tls_config_set_cert_mem
  Global.Pr_tls_config_set_key_mem tls_config_set_key_mem = Call_tls_config_set_key_mem
  Global.Pr_tls_server tls_server = Call_tls_server
  Global.Pr_tls_configure tls_configure = Call_tls_configure
  Global.Pr_tls_error tls_error = Call_tls_error
  Global.Pr_tls_accept_socket tls_accept_socket = Call_tls_accept_socket
  Global.Pr_tls_accept_cbs tls_accept_cbs = Call_tls_accept_cbs
  Global.Pr_tls_read tls_read = Call_tls_read
  Global.Pr_tls_write tls_write = Call_tls_write
  Global.Pr_tls_handshake tls_handshake = Call_tls_handshake
  Global.Pr_tls_close tls_close = Call_tls_close
  Global.Pr_tls_free tls_free = Call_tls_free
  Global.Pr_tls_config_free tls_config_free = Call_tls_config_free
  
  Global *ctx, *cfg
  Global tls_cfg = #Null
  Global tls_ctx = #Null
  
  Procedure InitSimpleTLS(CA.s, Cert.s, Key.s, Password.s, TLSID.i = 0)
    Define Settings.s_tls_server
    Define TLSInitReturn.i
    Settings\CA = CA
    Settings\Cert = Cert
    Settings\Key = Key
    Settings\Password = Password
    TLSInitReturn = InitTLS(@Settings, TLSID)
    ProcedureReturn TLSInitReturn
  EndProcedure
  
  Procedure InitTLS(*Settings.s_tls_server, TLSID.i = 0)
    Protected mem_ptr.i, length.i, returns.i
    If tls_init() <> 0 : ProcedureReturn -1 : EndIf
    tls_cfg = tls_config_new()
    Debug "TLS cfg obj:"+Str(tls_cfg)
    Debug "CA:"+*Settings\CA
    mem_ptr = tls_load_file(*Settings\CA, @length)
    If Not mem_ptr : tls_config_free(tls_cfg) : ProcedureReturn -2 : EndIf
    tls_config_set_ca_mem(tls_cfg, mem_ptr, length)
    Debug "Cert:"+*Settings\Cert
    mem_ptr = tls_load_file(*Settings\Cert, @length)
    If Not mem_ptr : tls_config_free(tls_cfg) : ProcedureReturn -3 : EndIf
    tls_config_set_cert_mem(tls_cfg, mem_ptr, length)
    If Len(*Settings\Password) > 0
      Debug "Key:"+*Settings\Key + " Password:"+*Settings\Password
      mem_ptr = tls_load_file_pw(*Settings\Key, @length, *Settings\Password)
      If Not mem_ptr : tls_config_free(tls_cfg) : ProcedureReturn -4 : EndIf
      tls_config_set_key_mem(tls_cfg, mem_ptr, length)
    Else
      Debug "Key:"+*Settings\Key
      mem_ptr = tls_load_file(*Settings\Key, @length)
      If Not mem_ptr : tls_config_free(tls_cfg) : ProcedureReturn -5 : EndIf
      tls_config_set_key_mem(tls_cfg, mem_ptr, length)
    EndIf
    tls_ctx = tls_server()
    Debug "TLS Server obj:"+Str(tls_ctx)
    If Not tls_ctx : tls_config_free(tls_cfg) : ProcedureReturn -6 : EndIf
    returns = tls_configure(tls_ctx, tls_cfg)
    Debug "Configure Returns:"+Str(returns)
    If returns <> 0 :Debug ErrorTLSSrv(): tls_free(tls_ctx) : tls_config_free(tls_cfg) : ProcedureReturn -7 : EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure WaitTLSSocket(ServerSocket.i, TLSID.i = 0)
    Protected sockID.i , tlssID.i, cctx
    sockID = lsocket::WaitSocket(ServerSocket)
    If sockID < 0 : ProcedureReturn -1 : EndIf
    tlssID = tls_accept_socket(tls_ctx, @cctx, sockID)
    If tlssID = -1 : ProcedureReturn -2 : EndIf
    ProcedureReturn cctx
  EndProcedure
  
  Procedure ReadTLSSocket(Connection.i, Buffer, Length.i)
    Protected Received.i
    Received = tls_read(Connection, Buffer, Length)
    ProcedureReturn Received
  EndProcedure
  
  Procedure WriteTLSSocket(Connection.i, Buffer, Length.i)
    Protected Received.i
    Received = tls_write(Connection, Buffer, Length)
    ProcedureReturn Received
  EndProcedure
  
  Procedure CloseTLSSocket(Connection.i)
    tls_close(Connection)
  EndProcedure
  
  Procedure.s ErrorTLSSrv(TLSID.i = 0)
    Protected Error.s
    Error = PeekS(tls_error(tls_ctx),-1,#PB_Ascii)
    ProcedureReturn Error
  EndProcedure
  
  Procedure.s ErrorTLSCli(Connection.i)
    Protected Error.s
    Error = PeekS(tls_error(Connection),-1,#PB_Ascii)
    ProcedureReturn Error
  EndProcedure
  
  Procedure CloseTLS(TLSID.i = 0)
    tls_free(tls_ctx)
    tls_config_free(tls_cfg)
  EndProcedure
  
EndModule