;************************
;* Library : lhs_net_tls.pbi
;* 
;* TLS Wrapper with simple Interface for stock applications.
;* 
;* Created and develobed by Linder Hard- und Software
;* 
;* Current only usable for Linux.
;*
;*

XIncludeFile "lhs_net_socket.pbi"

DeclareModule tls
  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)
  Declare GetSocket(Connection.i)
EndDeclareModule

Module tls
  Structure tls_socket
    server_id.i
    client_id.i
    tls_id.i
  EndStructure
  
  Global NewMap socket_sort.tls_socket()
  
  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_file(*tls_config , ca_file.p-utf8)
  PrototypeC.i Pr_tls_config_set_ca_path(*tls_config , ca_path.p-utf8)
  PrototypeC.i Pr_tls_config_set_ca_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_cert_file(*tls_config , cert_file.p-utf8)
  PrototypeC.i Pr_tls_config_set_cert_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_crl_file(*tls_config , crl_file.p-utf8)
  PrototypeC.i Pr_tls_config_set_crl_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_key_file(*tls_config , key_file.p-utf8)
  PrototypeC.i Pr_tls_config_set_key_mem(*tls_config , Memory.i, Length.i)
  PrototypeC.i Pr_tls_config_set_keypair_ocsp_file(*tls_config , cert_file.p-utf8, key_file.p-utf8, staple_file.p-utf8)
  PrototypeC.i Pr_tls_config_set_keypair_ocsp_mem(*tls_config , cert_Memory.i, cert_Length.i, key_Memory.i, key_Length.i, staple_Memory.i, staple_Length.i)
  PrototypeC.i Pr_tls_config_add_keypair_file(*tls_config , cert_file.p-utf8, key_file.p-utf8)
  PrototypeC.i Pr_tls_config_add_keypair_mem(*tls_config , cert_Memory.i, cert_Length.i, key_Memory.i, key_Length.i)
  PrototypeC.i Pr_tls_config_add_keypair_ocsp_file(*tls_config , cert_file.p-utf8, key_file.p-utf8, staple_file.p-utf8)
  PrototypeC.i Pr_tls_config_add_keypair_ocsp_mem(*tls_config , cert_Memory.i, cert_Length.i, key_Memory.i, key_Length.i, staple_Memory.i, staple_Length.i)
  PrototypeC.i Pr_tls_config_clear_keys(*tls_config)
  PrototypeC.i Pr_tls_config_set_verify_depth(*tls_config, verify_depth.i)
  PrototypeC.i Pr_tls_config_verify_client(*tls_config)
  PrototypeC.i Pr_tls_config_verify_client_optional(*tls_config)
  PrototypeC.i Pr_tls_default_ca_cert_file()
  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
  
  Define LibraryDir.s
  
  ;OS Detection
  CompilerIf #PB_Compiler_OS = #PB_OS_Linux
    Define LibraryName.s = "libtls.so"  
  CompilerElseIf #PB_Compiler_OS <> #PB_OS_Linux
    CompilerError "Only for Linux"
  CompilerEndIf
  
  ;CPU Architecture Detections
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    LibraryDir = "/usr/lib64/"
  CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x86  
    LibraryDir = "/usr/lib/"
  CompilerElse
    CompilerError "Unsupported Processor Architecture."
  CompilerEndIf 
  
  ;Try to find a Linked Name witouth Version:
  Define libressl_tls = OpenLibrary(#PB_Any, LibraryDir + LibraryName)
  If Not IsLibrary(libressl_tls)
    If ExamineDirectory(0, LibraryDir, LibraryName + ".*")
      While NextDirectoryEntry(0)
        If DirectoryEntryType(0) = #PB_DirectoryEntry_File
          LibraryName = DirectoryEntryName(0)
          libressl_tls = OpenLibrary(#PB_Any, LibraryDir + LibraryName)
          If IsLibrary(libressl_tls)
            Break 1
          EndIf
        EndIf
      Wend
      If IsLibrary(libressl_tls)
        Debug  "Initialized with:" + LibraryDir + LibraryName
      Else
        Debug  "Library not found: " + LibraryDir + LibraryName + " Or " + LibraryDir + LibraryName + ".*"        
        End
      EndIf
      FinishDirectory(0)
    EndIf
  Else 
    Debug  "Initialized with:" + LibraryDir + LibraryName
  EndIf  
  
  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")
  
  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
    socket_sort(Str(cctx))\client_id = sockID
    socket_sort(Str(cctx))\tls_id = cctx
    socket_sort(Str(cctx))\server_id = ServerSocket
    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)
    DeleteMapElement(socket_sort(), Str(Connection))
  EndProcedure
  
  Procedure GetSocket(Connection.i)
    ProcedureReturn socket_sort(Str(Connection))\client_id  
  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