SSL\TLS Client\Server lib based on Cryptlib Encryption Toolk

[Uncle B]

Hi guys,

I've made a little SSL\TLS lib based on the Cryptlib library by Peter Gutmann.
Cryptlib_Header.pb and cl32.dll are both available at Mike Traders http://www.coastrd.com
For as far as I could test it it's very stable, also with a large number of clients running.
the client side functions are also suitable for use with i.e gmail accounts.
have fun with it.

(Don't forget to compile in thread safe mode!!)

SSL Library (SSL_Library.pb)

Code: Select all

;*******************************************************
;*                                                     *
;*                SSL Library V1.0                     *
;*                ================                     *
;*     SSL/TLS Network lib by Uncle B for PureBasic    *
;*         for use with Cryptlib library V3.3.3        *
;*                                                     *
;*              Rotterdam, NL, May 2010                *
;*                                                     *
;*     Needs: - Cryptlib_Header.pb (Include file)      *
;*            - cl32.dll (cryptlib library)            *
;*                                                     *
;*    Conditions for usage of cryptlib library see:    *
;*    http://www.cs.auckland.ac.nz/~pgut001/cryptlib/  *
;*                                                     *
;*    Cryptlib_Header.pb and cl32.dll available at:    *
;*    http://www.coastrd.com/download                  *
;*                                                     *
;*                                                     *
;*          COMPILE IN THREAD SAFE MODE!!!             *
;*                                                     *
;*******************************************************

XIncludeFile "Cryptlib_Header.pb"

Enumeration 
  #SSLEvent_Connect = 1   
  #SSLEvent_Data  
  #SSLEvent_File
  #SSLEvent_Disconnect
  #SSLEvent_ServerShutDown
  #SSLEvent_SessionStopped
EndEnumeration

Enumeration
  #SSL_Error_None = 0
  #SSL_Error_Push
  #SSL_Error_Pop
  #SSL_Error_AllocateMemory
EndEnumeration

Structure SSLEvent
 Event.l
*pBuffer.l
 Length.l
 Pos.l
 ID.l
EndStructure

Structure SSLSession
  hSession.l
  *pRequest.SSLEvent
  *pEvent.SSLEvent
  Error.l
  Lock.l
  ClientName.s
  ClientPort.l
EndStructure

Structure SSLServerParams
    ServerPort.l
    KeysetFile.s
    KeysetLabel.s
    KeysetPassword.s
EndStructure

Structure SSLServerData
*Request.SSLEvent
*Event.SSLEvent
*ServerParams.SSLServerParams
EventSemaphore.l
Quit.l
EndStructure

Structure SSLServer
*SSLServerData.SSLServerData
*SSLLastEvent.SSLEvent
*SSLServerParameters.SSLServerParams
*SSLServerPrivateKey
*pSession
Error.l
EndStructure

Structure SSLClient
 hSession.l
 *DataBuffer
 DataBufferLength.l
 Position.l
EndStructure

Structure SSLSessions
  ThreadID.l
  SessionID.l
EndStructure

Declare SSL_Server_CloseConnection(Client.l)

;- ********* Internal procedures *********

Procedure.s SSL_INT_GeneratePass(NumChars)

pass$ = ""

For i = 1 To NumChars

x = Random(34)

If x < 9
    c = 48 + x
    pass$ + Chr(c)
Else
    c = x - 9 + 97
    pass$ + Chr(c)
EndIf

Next

ProcedureReturn pass$

EndProcedure

Procedure SSL_INT_PopData(hSession.l, *Buffer)

Protected result.l, pBuff.l, BufferSize.l, BytesReply.l, BytesReceived.l
Protected ReturnBuffer.l, newBuffer.l

pBuff = AllocateMemory(1000)

BytesReceived = 0 

    Repeat
    result = cryptPopData(hSession, pBuff, 1000, @BytesReply)

      If BytesReply > 0
          newBuffer = ReAllocateMemory(ReturnBuffer, BytesReceived + BytesReply)
          CopyMemory(pBuff, newBuffer + BytesReceived, BytesReply)
          BytesReceived + BytesReply
          ReturnBuffer = newBuffer 
      Else
          Break 
      EndIf

    ForEver
    
    PokeL(*Buffer, ReturnBuffer)
    FreeMemory(pBuff)

    ProcedureReturn BytesReceived 
    
EndProcedure

Procedure SSL_INT_PushData(hSession.l, *MemoryBuffer, BufferLength.l)

Protected BytesReply.l, RetVal.l
   
   result = cryptPushData(hSession, *MemoryBuffer, BufferLength, @BytesReply)
   result = cryptFlushData(hSession)
   
   If result = 0
        RetVal = 1
   Else
        RetVal = 0
   EndIf
   
ProcedureReturn RetVal

EndProcedure

Procedure SSL_INT_SessionThread(*Server.SSLServer)

Protected cryptContext.l, cryptKeyset.l, cryptSession.l
Protected privateKey.l, publicKey.l, Port.l
Protected password.s, label.s, fname.s, name.s
Protected connectionsActive.l, nameLength.l, clientPort.l

With *Server\SSLServerParameters
    Port = \ServerPort
    label = \KeysetLabel
    fname = \KeysetFile ;"TestKeyset.p15"
    password = \KeysetPassword
EndWith 

Protected *Session.SSLSession, *Event.SSLEvent, *Request.SSLEvent

*Session.SSLSession = AllocateMemory(SizeOf(SSLSession))
*Event.SSLEvent = AllocateMemory(SizeOf(SSLEvent))
*Request.SSLEvent = AllocateMemory(SizeOf(SSLEvent))

*Event\ID = *Session
*Session\Error = 0

;/* Create the session */
      cryptCreateSession(@cryptSession, #CRYPT_UNUSED, #CRYPT_SESSION_SSL_SERVER)

;/* Add the server key/certificate, add the port and activate the session */
      cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_SERVER_PORT, Port)
      cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_PRIVATEKEY, *Server\SSLServerPrivateKey);
      cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_ACTIVE, 1);

;/*------ Thread paused until new client connects ------*/;

PokeL(*Server\pSession, *Session)

*Session\hSession = cryptSession
QuitSession.l = 0

;Get Client name (IP)
name = Space(#CRYPT_MAX_TEXTSIZE + 1)
cryptGetAttributeString(cryptSession, #CRYPT_SESSINFO_CLIENT_NAME, @name, @nameLength)
*Session\ClientName = Left(name, nameLength)

;Get client port nr.
cryptGetAttribute(cryptSession, #CRYPT_SESSINFO_CLIENT_PORT, @clientPort)
*Session\ClientPort = clientPort

Repeat

LoopStart = ElapsedMilliseconds()


      ;Check if the connection is still active
       cryptGetAttribute(cryptSession, #CRYPT_SESSINFO_CONNECTIONACTIVE, @connectionActive)
          
          If connectionActive = 0
                *Event\Event =  #SSLEvent_Disconnect
                *Session\pEvent = *Event
                Break
          EndIf
           
      ;Check for new request
      If *Session\pRequest <> 0
            
            *Request.SSLEvent = *Session\pRequest
              
            With *Request
              Select \Event 
              
                  Case #SSLEvent_Data ;Request to send data to client
                        res = SSL_INT_PushData(cryptSession, \pBuffer, \Length)
                        If res = 0 : *Session\Error = #SSL_Error_Push : EndIf
                        
                  Case #SSLEvent_Disconnect ;Request to kill session        
                        QuitSession = 1
                        *Event\Event = #SSLEvent_SessionStopped
                       
              EndSelect
            EndWith
            
              
      *Session\pRequest = 0        
      EndIf

      ;Check for new data
      buff.l
      Bytes = SSL_INT_Popdata(cryptSession, @buff)
      If Bytes > 0
            
            *Event\pBuffer = ReAllocateMemory(*Event\pBuffer, Bytes)
            CopyMemory(buff, *Event\pBuffer, Bytes)
            *Event\Event = #SSLEvent_Data
            *Event\Length = Bytes
            *Event\Pos = 0
            *Session\pEvent = *Event
            
         
            FreeMemory(buff)
         
      EndIf


      
LoopEnd = ElapsedMilliseconds()
If LoopEnd - LoopStart = 0 ;Indicates that the client has disconnected without proper closure of the session (client crashed)
      QuitSession = 1
      *Event\Event=#SSLEvent_Disconnect
      *Session\pEvent = *Event
      FreeMemory(*Request)
EndIf

If QuitSession = 1
      Break
EndIf

ForEver

cryptDestroySession(cryptSession)

EndProcedure

Procedure SSL_INT_MainServerThread(*Server.SSLServer)

Protected BytesReply.l, BytesCopied.l
Protected cryptContext.l, cryptKeyset.l, privateKey.l
Protected pBuff.l, ServerState.l

With *Server\SSLServerParameters

;/* Create cryptContext */
      cryptCreateContext(@cryptContext, #CRYPT_UNUSED, #CRYPT_ALGO_RSA)

;/* Open Keyset file */
      cryptKeysetOpen(@cryptKeyset, #CRYPT_UNUSED, #CRYPT_KEYSET_FILE, \KeysetFile, #CRYPT_KEYOPT_READONLY);

;/* Load private key */
      cryptGetPrivateKey(cryptKeyset, @privateKey, #CRYPT_KEYID_NAME, \KeySetLabel, \KeysetPassword)
    
EndWith

*Server\SSLServerPrivateKey = privateKey

Dim Sessions.SSLSessions(0)
SessionCnt = 0

newSession.l = 0
*Server\pSession = @newSession
newThread = CreateThread(@SSL_INT_SessionThread(),*Server) ; Start first server session

Repeat

      ;Check for new connection
      If newSession <> 0 And *Server\SSLServerData\Quit = 0
          SessionCnt + 1
          ReDim Sessions.SSLSessions(SessionCnt)
          Sessions(SessionCnt)\SessionID = newSession
          Sessions(SessionCnt)\ThreadID = newThread
          newSession = 0
          newThread = 0
          *Server\pSession = @newSession
          ;Start new session
          newThread = CreateThread(@SSL_INT_SessionThread(),*Server)
          
      EndIf


      If SessionCnt > 0
      
        ;Check for new client events (Client to server communication)
        ;(Server to client communication is directly handled by the sessionthread)
        For i = 1 To SessionCnt
              *Sess.SSLSession = Sessions(i)\SessionID
              If *Sess\pEvent <> 0 And *Sess\Lock = 0;New event available
                    
                    *ev.SSLEvent = *Sess\pEvent
                    
                    Select *ev\Event
                        Case #SSLEvent_Data
                            *Server\SSLServerData\Event = *Sess\pEvent
                            *Sess\Lock=1
                            WaitSemaphore(*Server\SSLServerData\EventSemaphore)
                        
                        Case #SSLEvent_Disconnect
                            
                            If i < SessionCnt
                                 Sessions(i)\SessionID = Sessions(SessionCnt)\SessionID
                                 Sessions(i)\ThreadID = Sessions(SessionCnt)\ThreadID
                            EndIf
                            
                            SessionCnt -1
                            ReDim Sessions(SessionCnt)
                            
                            *Server\SSLServerData\Event = *Sess\pEvent
                            WaitSemaphore(*Server\SSLServerData\EventSemaphore)
                            
                            FreeMemory(*ev)
                            FreeMemory(*Sess)

                        Case #SSLEvent_SessionStopped
                            If i < SessionCnt
                                 Sessions(i)\SessionID = Sessions(SessionCnt)\SessionID
                                 Sessions(i)\ThreadID = Sessions(SessionCnt)\ThreadID
                            EndIf
                            
                            SessionCnt -1
                            ReDim Sessions(SessionCnt)
                            
                            FreeMemory(*Sess\pEvent)
                            FreeMemory(*Sess\pRequest)
                            FreeMemory(*Sess)
                            
                     EndSelect     

              EndIf
              
              If *Sess\Error <> 0
                    *Server\Error = *Sess\Error
              EndIf
              
        Next
         

      EndIf

      ;Check for request to quit server
      If *Server\SSLServerdata\Quit = 1 And Exit <> 1
            If IsThread(newThread)
                KillThread(newThread)
            EndIf
            For i = 1 To SessionCnt
                SSL_Server_CloseConnection(Sessions(i)\SessionID)
            Next
            Exit = 1
      ElseIf *Server\SSLServerData\Quit=1 And Exit = 1
            Break
      EndIf

ForEver

EndProcedure

Procedure SSL_INT_GenerateKeyset(newKeysetFile.s, KeysetLabel.s, CommonName.s, PassWord.s)

;Parameter specifications:
;========================
;newKeysetFile:   a path+filename where the keyset and certificate can be saved to. 
;                 existing files will be overwritten. The common used extension for this kind of file is *.p15 (see Cryptlib manual).
;KeysetLabel:     a label where to identify the generated keyset by in the keyset file.
;PassWord:        password used for future extraction of the private key.
;CommonName:      Name used for certificate. This should typically be the server name (e.g. www.yourserver.com) but every random string is accepted.
;                 Not using the server name may cause some browsers to generate warning messages (see Cryptlib manual).
;========================


;*** Generate keyset with certificate ***

Protected cryptContext.l, cryptKeyset.l, cryptCertificate.l
Protected ReturnValue.l = 1


RetVal = cryptCreateContext(@cryptContext, #CRYPT_UNUSED, #CRYPT_ALGO_RSA) ;Create encription context
If RetVal <> 0 : ReturnValue = 0 : EndIf

    RetVal = cryptSetAttributeString(cryptContext, #CRYPT_CTXINFO_LABEL, @KeysetLabel, Len(KeysetLabel));
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
    RetVal = cryptGenerateKey(cryptContext);
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
    RetVal = cryptKeysetOpen(@cryptKeyset, #CRYPT_UNUSED, #CRYPT_KEYSET_FILE, newKeysetFile, #CRYPT_KEYOPT_CREATE);
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
    ;/* Load/store keys */
        RetVal = cryptAddPrivateKey(cryptKeyset, cryptContext, PassWord);
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        ;/* Create a simplified certificate */
        RetVal = cryptCreateCert(@cryptCertificate, #CRYPT_UNUSED, #CRYPT_CERTTYPE_CERTIFICATE);
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        RetVal = cryptSetAttribute(cryptCertificate, #CRYPT_CERTINFO_XYZZY, 1);
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        ;/* Add the public key And certificate owner name And sign the certificate with the private key */
        RetVal = cryptSetAttribute(cryptCertificate, #CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO, cryptContext);
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        RetVal = cryptSetAttributeString(cryptCertificate, #CRYPT_CERTINFO_COMMONNAME, @CommonName, Len(CommonName));
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        RetVal = cryptSignCert(cryptCertificate, cryptContext);
        If RetVal <> 0 : ReturnValue = 0 : EndIf
        
        RetVal = cryptAddPublicKey(cryptKeyset, cryptCertificate );
        If RetVal <> 0 : ReturnValue = 0 : EndIf

    RetVal = cryptKeysetClose(cryptKeyset)
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
RetVal = cryptDestroyContext(cryptContext);
If RetVal <> 0 : ReturnValue = 0 : EndIf

ProcedureReturn ReturnValue

EndProcedure

;- ******** SSL Server procedures ********

Procedure SSL_Server_Create(Port.l, ServerName.s)

KeySetFile$ = GetTemporaryDirectory()+SSL_INT_GeneratePass(8) + ".p15"
Pass$ = SSL_INT_GeneratePass(16)
SSL_INT_GenerateKeyset(KeySetFile$, "key", ServerName, Pass$)

*Server.SSLServer = AllocateMemory(SizeOf(SSLServer))

With *Server
 \SSLServerData = AllocateMemory(SizeOf(SSLServerData))
 \SSLLastEvent = AllocateMemory(SizeOf(SSLEvent))
 \SSLServerParameters = AllocateMemory(SizeOf(SSLServerParams))
 \SSLServerPrivateKey = AllocateMemory(4)
EndWith

*Server\SSLServerData\EventSemaphore = CreateSemaphore()

With *Server\SSLServerParameters
    \ServerPort = Port.l
    \KeysetLabel = "key"
    \KeysetFile = KeySetFile$
    \KeysetPassword = Pass$
EndWith 
  
  CreateThread(@SSL_INT_MainServerThread(), *Server)
  Delay(20)
  DeleteFile(KeySetFile$)

  ProcedureReturn *Server

EndProcedure

Procedure SSL_Server_Destroy(ServerID)
*Server.SSLServer = ServerID
*Server\SSLServerdata\Quit = 1
EndProcedure

Procedure SSL_Server_Event(ServerID)

*Server.SSLServer = ServerID

res = 0
    If *Server\SSLServerData\Event <> 0
           
           *event.SSLEvent = *Server\SSLServerData\Event
           Debug "event noticed"
           
           Select *event\Event
                  Case #SSLEvent_Data
                        res = #SSLEvent_Data
                        With *Server\SSLLastEvent
                            \Event = #SSLEvent_Data
                            \ID = *event\ID
                            \Length = *event\Length
                            \pBuffer = ReAllocateMemory(\pBuffer, \Length)
                            \Pos = 0
                            CopyMemory(*event\pBuffer, \pBuffer, \Length)
                            *Session.SSLSession = \ID
                            *Session\pEvent = 0
                            *Session\Lock = 0
                        EndWith
                  Case #SSLEvent_Disconnect
                        res = #SSLEvent_Disconnect
                        With *Server\SSLLastEvent
                            \Event = #SSLEvent_Disconnect
                            \ID = *event\ID
                            *Session.SSLSession = \ID
                            *Session\pEvent = 0
                            *Session\Lock = 0
                        EndWith     
                        
           EndSelect
    *Server\SSLServerData\Event = 0
    SignalSemaphore(*Server\SSLServerData\EventSemaphore)
    EndIf

ProcedureReturn res

EndProcedure 

Procedure SSL_Server_EventClient(ServerID)
    *Server.SSLServer = ServerID
    res = *Server\SSLLastEvent\ID
    ProcedureReturn res
EndProcedure

Procedure SSL_Server_ReceiveData(ServerID, *MemoryBuffer, Length)

*Server.SSLServer = ServerID

LastRun = 0
    With *Server\SSLLastEvent
        If \pos < \Length
              BytesToGo.l = \Length - \pos
              If BytesToGo < Length
                    BytesToRead = BytesToGo
                    LastRun = 1
              Else
                    BytesToRead = Length      
              EndIf
              
              CopyMemory(\pBuffer + \pos, *MemoryBuffer, BytesToRead)
              \pos + BytesToRead
         Else
            Lastrun = 1
         EndIf
              
         If LastRun = 1
              \Event = 0
              \Length = 0
              \Pos = 0
              *Sess.SSLSession = \ID
              *Sess\Lock = 0
         EndIf
    
    EndWith
    
    ProcedureReturn BytesToRead
    
EndProcedure

Procedure SSL_Server_Error(ServerID)

*Server.SSLServer = ServerID
ProcedureReturn *Server\Error 

EndProcedure

Procedure SSL_Server_SendData(Client.l, *MemoryBuffer, Length.l)

*Sess.SSLSession = Client
*Request.SSLEvent = AllocateMemory(SizeOf(SSLEvent))

With *Request
    \Event = #SSLEvent_Data
    \ID = Client
    \Length = Length
    *buff = ReAllocateMemory(\pBuffer, Length)
    If *buff
      \pBuffer = *buff
      CopyMemory(*MemoryBuffer, \pBuffer, Length)
    Else
      *Sess\Error = #SSL_Error_AllocateMemory
    EndIf
EndWith

*Sess\pRequest = *Request

EndProcedure

Procedure SSL_Server_SendString(Client.l, String.s)

Length = Len(String)

If Length > 0

*Sess.SSLSession = Client
*Request.SSLEvent = AllocateMemory(SizeOf(SSLEvent))

With *Request
    \Event = #SSLEvent_Data
    \ID = Client
    \Length = Length
    *buff = ReAllocateMemory(\pBuffer, Length)
    If *buff
      \pBuffer = *buff
      PokeS(\pBuffer, String)
    Else
      *Sess\Error = #SSL_Error_AllocateMemory
    EndIf
EndWith

*Sess\pRequest = *Request

EndIf

EndProcedure

Procedure SSL_Server_CloseConnection(Client.l)
  *Sess.SSLSession = Client
  *Request.SSLEvent = AllocateMemory(SizeOf(SSLEvent))
  With *Request
      \Event = #SSLEvent_Disconnect
      \ID = Client
  EndWith
  *Sess\pRequest = *Request
EndProcedure

Procedure SSL_Server_SessionHandle(Client.l)
  *Sess.SSLSession = Client
  handle.l = *Sess\hSession
  ProcedureReturn handle
EndProcedure

Procedure.s SSL_Server_GetClientIP(Client.l)

*Sess.SSLSession = Client
ProcedureReturn *Sess\ClientName

EndProcedure

Procedure SSL_Server_GetClientPort(Client.l)

*Sess.SSLSession = Client
ProcedureReturn *Sess\ClientPort

EndProcedure

;- ******** SSL Client procedures *********

Procedure SSL_Client_OpenConnection(ServerName.s, Port.l)

Protected cryptSession;

;/* Create the session */
    cryptCreateSession(@cryptSession, #CRYPT_UNUSED, #CRYPT_SESSION_SSL);

;/* Add the server name and activate the session */
    cryptSetAttributeString(cryptSession, #CRYPT_SESSINFO_SERVER_NAME, @ServerName, Len(ServerName));
    cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_SERVER_PORT, Port)
    cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_ACTIVE, 1 );
   
    *newConnection.SSLClient = AllocateMemory(SizeOf(SSLClient))
    With *newConnection
          \hSession = cryptSession
    EndWith

    ProcedureReturn *newConnection

EndProcedure

Procedure SSL_Client_Event(Client)

Protected connectionActive.l, buff.l
*Conn.SSLClient = Client

With *Conn
      cryptGetAttribute(\hSession, #CRYPT_SESSINFO_CONNECTIONACTIVE, @connectionActive)
      If connectionActive
          
          Bytes = SSL_INT_PopData(\hSession, @buff)
          If Bytes > 0
              \DataBuffer = buff
              \DataBufferLength = Bytes
              \Position =0
              RetVal = #SSLEvent_Data
          EndIf
          
      Else
          RetVal = #SSLEvent_Disconnect
      EndIf
EndWith

ProcedureReturn RetVal

EndProcedure

Procedure SSL_Client_ReceiveData(Client, *MemoryBuffer, Length.l)

Protected BytesToCopy.l = 0

*Conn.SSLClient = Client

With *Conn

If \DataBuffer <> 0
    
    If Length < (\DataBufferLength - \Position)
          BytesToCopy = Length
    Else
          BytesToCopy = (\DataBufferLength - \Position)
    EndIf
    
    CopyMemory(\DataBuffer + \Position, *MemoryBuffer, BytesToCopy)
    
    totalCopied = \Position + BytesToCopy
    \Position = totalCopied
    
    If BytesToCopy < Length
       FreeMemory(\DataBuffer)
       \DataBuffer = 0  
       \DataBufferLength = 0
       \Position = 0
    EndIf
    
EndIf
    
EndWith

ProcedureReturn BytesToCopy

EndProcedure

Procedure SSL_Client_SendData(Client, *MemoryBuffer, BufferLength.l);

Protected BytesCopied.l, result.l

*Conn.SSLClient = Client

result = 0

If cryptPushData(*Conn\hSession, *MemoryBuffer, BufferLength, @BytesCopied) = 0
   cryptFlushData(*Conn\hSession)
   result = 1
EndIf

ProcedureReturn result

EndProcedure

Procedure SSL_Client_SendString(Client, String$);

Protected BytesCopied.l, result.l

*Conn.SSLClient = Client

result = 0

If cryptPushData(*Conn\hSession, @String$, Len(String$), @BytesCopied) = 0
   cryptFlushData(*Conn\hSession)
   result = 1
EndIf

ProcedureReturn result

EndProcedure

Procedure SSL_Client_CloseConnection(Client)

    Protected *Conn.SSLClient
    Protected result = 0
    
    *Conn = Client
    
    If cryptDestroySession(*Conn\hSession) = 0
            result = 1
    EndIf

    If *Conn\DataBuffer <> 0
        FreeMemory(*Conn\DataBuffer)
    EndIf
    FreeMemory(*Conn)
    
ProcedureReturn result    

EndProcedure

Example server:

Code: Select all

XIncludeFile "SSL_Library.pb"

cryptInit()

ServerID = SSL_Server_Create(6000, "http:\\www.i-can-do-ssl.com")
Debug "Server created, serverID = " + Str(ServerID)

*Buffer = AllocateMemory(1000)

Repeat

  event = SSL_Server_Event(ServerID)
  Select event
        Case #SSLEvent_Data
            
            Connection = SSL_Server_EventClient(ServerID)
            str$ = ""
            
            Repeat
              Bytes = SSL_Server_ReceiveData(ServerID, *Buffer, 1000)
              If Bytes
                str$ + PeekS(*Buffer, Bytes)
              EndIf
            Until Bytes < 1000
                 
            Debug "Server received: " + str$ + " from client: " + Str(Connection)
            SSL_Server_SendString(Connection, "Hello client " + Str(Connection))

        Case #SSLEvent_Disconnect
            clientid = SSL_Server_EventClient(ServerID)
            Debug "Client " + Str(clientid) + " disconnected"

  EndSelect
  
Delay(10)

ForEver

Example client

Code: Select all

XIncludeFile "SSL_Library.pb"

cryptInit()

    ClientID = SSL_Client_OpenConnection("Localhost", 6000)
    
    If ClientID
    
    String$ = "Hello Server!"    
    *MemBuff = AllocateMemory(1000)
    
    SSL_Client_SendString(ClientID, String$)
    Debug "Client sending:  " + String$
    
    Repeat
                
        event = SSL_Client_Event(ClientID)
        
        Select event
            Case #SSLEvent_Data
            
            Debug "Server replied:"
            
                    Repeat
                      Bytes = SSL_Client_ReceiveData(ClientID, *MemBuff, 1000)
                      str$ + PeekS(*MemBuff, Bytes)
                    Until Bytes < 1000
                    
                    Debug str$
                    str$ = ""  
                    
                    SSL_Client_SendString(ClientID, String$)
                    Delay(1000)
                    
            Case #SSLEvent_Disconnect
                Debug "Connection lost"
                Break
                
        EndSelect
               
        Delay(10)
          
    ForEver
    
    EndIf
    

[epidemicz]

You should be able to interface with google talk with this right?

Can you point me to where i can find cryptlib_header.pb? I'm not able to find it on that site.

[Mike Trader]

Nice work.
I have update the downloads with some cryptlib examples in C++/purebasic/powerbasic
http://www.coastrd.com/download

Dont forget to checkout the SChannel code.
http://www.coastrd.com/tls-with-schannel

This provides native SSL support on windows platforms using the API. That could save you 1MB of library

[Uncle B]

You should be able to interface with google talk with this right?

Can you point me to where i can find cryptlib_header.pb? I'm not able to find it on that site.

Header file can be found in the download section under:

SMTPS - Updated November 2009
C++/BASIC headers + source code for gmail client Download (79k)

This does work with Gmail, I just assume it works with google talk.

regards,

Bart

[cas]

Thanks for sharing this code. I have one question... Can this be used to implement https support in atomic web server?

[Joakim Christiansen]

Seems interesting, I will see if I can get this to work with HTTP GET and POST, thanks!

[Uncle B]

Thanks for sharing this code. I have one question... Can this be used to implement https support in atomic web server?

Hi Cas,

For now I'm just taking my moment for actually getting it to work.
I've not really cared yet for what it can be used for. I think that's for you to find out..
I'm glad you like it though!

Regards,

Bart

[Mike Trader]

>Can this be used to implement https support in atomic web server?

Web servers present a whole array of problems that need sophisticated solutions because to be of any use beyond a personal amusement, they must scale. Handling multiple requests simultaneously puts the whole server in one of two categories:
- One thread per request
- Thread pool

Luckily windows has an industrial grade solution for Winsock, thread pools for multiprocessors and queuing work called I/O completion ports:
http://www.coastrd.com/windows-iocp

There are many examples of source code in C++ like
http://www.codeproject.com/KB/IP/IOCP_how_to_cook.aspx

But it is possible to build a simple IOCP server in basic. If Uncle B is willing to help, i'll make the code available.

[infratec]

Hi,

I just tried something with cryptlib and I run into a big problem:
When I reach

Code: Select all

RetVal = cryptGenerateKey(cryptContext)

I get an

[ERROR]Illegal instruction.(Executing binary data?)

I have no idea.

I use Win XP SP3 32bit.

Hope somone can give me a hint.
At the memory where cryptGenerateKey() points to, are valid x86 assemebler commands.
I checked the first 2 instructions.

Bernd

[Uncle B]

Hi Bernd,

I think the problem might be the cryptContext.
This is not always a pointer, but only with cryptCreateContext().
See below example. This has worked fine for me up to now.

The same thing goes for a lot of cryptLib procedures.

Regards,

Bart

Code: Select all

Protected cryptContext.l, cryptKeyset.l, cryptCertificate.l
Protected ReturnValue.l = 1

RetVal = cryptCreateContext(@cryptContext, #CRYPT_UNUSED, #CRYPT_ALGO_RSA) ;Create encription context
If RetVal <> 0 : ReturnValue = 0 : EndIf

    RetVal = cryptSetAttributeString(cryptContext, #CRYPT_CTXINFO_LABEL, @KeysetLabel, Len(KeysetLabel));
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
    RetVal = cryptGenerateKey(cryptContext);
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    
    RetVal = cryptKeysetOpen(@cryptKeyset, #CRYPT_UNUSED, #CRYPT_KEYSET_FILE, newKeysetFile, #CRYPT_KEYOPT_CREATE);
    If RetVal <> 0 : ReturnValue = 0 : EndIf
    

[infratec]

Hi Bart,

thanks for your fast reply.

I use exactly your SSL_Library.pb

So I can not understand why this error occure.


Best regards,

Bernd

[Uncle B]

strange...
Have you called cryptInit() at the start of your code?

btw I've recently fixed a few bugs in SSL_Library.pb
If you like, i can email it to you. I'll also ask mike trader to update the download on his website..

[infratec]

Hi Bart,

it is definately no problem with my program, because it is also your program

I'm not able to run your program Server.pb from your first posting.

I can see the value of cryptContext (something between 200 and 900), so everything up to cryptGenerateKey()
should be ok.

After looking at the original header file of the cryptlib, I'm thinking that something is wrong with your prototypes.
Because an int from 'C' is also an .i in PureBASIC and not a .l . That's only the case if you use the 64bit version.
Or am I wrong?

But even when I change this, I get the same result.

Btw. have you ever looked at PolarSSL ?

Best regards,

Bernd

[Uncle B]

Hi Bernd,

I don't think I'll be of much help then..
Especially because I can't reproduce the error.
Everything works fine here.

Any way, have you tried debugging the RetVal values of a few preceding functions?
These should all return 0. If one of them doesn't that might give you a clue on where to look..

Where does your error come from anyway? PB compiler?
I don't recognise this to be a standard cryptlib return value..

Regs,

Bart

[xakep]

Seems interesting, I will see if I can get this to work with HTTP GET and POST, thanks!

Like this:

Code: Select all

EnableExplicit
#SSL_RESPONSE_TIMEOUT = 5000 ; m/s

#CRYPT_OK = 0
#CRYPT_SESSION_SSL = 03 ; /* SSL/TLS */                      
#CRYPT_SESSION_SSL_SERVER = 04 ; /* SSL/TLS SERVER */  
#CRYPT_UNUSED = -101 ; /* A magic value for unused parameters */  
#CRYPT_SESSINFO_SERVER_NAME = 6008 ; /* SERVER NAME */
#CRYPT_SESSINFO_SERVER_PORT = 6009 ; /* SERVER PORT number */
#CRYPT_SESSINFO_ACTIVE = 6001 ; /* Whether session is active */
#CRYPT_SESSINFO_VERSION = 6015
#TLSv1_1 = 2 
#TLSv1_2 = 3


Global cl32_Dll.l

Global cryptInit.l
Global cryptEnd.l
Global cryptCreateSession.l
Global cryptSetAttributeString.l
Global cryptSetAttribute.l
Global cryptDestroySession.l
Global cryptPopData.l
Global cryptPushData.l
Global cryptFlushData.l

Prototype C_NoParameters()
Prototype C_cryptCreateSession(*cryptSession, cryptUser.l, SessionType.l)
Prototype C_cryptDestroySession(cryptSession.l)
Prototype C_cryptSetAttributeString(cryptSession.l, CryptAttrType.l, *Buffer, BufferLen.l)
Prototype C_cryptSetAttribute(cryptSession.l, CryptAttrType.l, Value.l)
Prototype C_cryptPopData(envelope.l, *Buffer, BufferLen.l, pBytesCopied.l)
Prototype C_cryptPushData(envelope.l, *pBuff, BufLen.l, pBytesCopied.l)
Prototype C_cryptFlushData(envelope.l)

Procedure ResolveFunc(BaseAddress.l, lpProcName.s)
  Define *DOS_Header.IMAGE_DOS_HEADER, *PE_Header.IMAGE_NT_HEADERS, *IDD_Export.IMAGE_DATA_DIRECTORY, *ExportDirectory.IMAGE_EXPORT_DIRECTORY, FuncTable.l, OrdinalTable.l, NameTableThunk.l, i.i, FuncAddr.l
  Define lVAddress.l, lVSize.l, lBase.l, sForward.s, fStr.i, newFunction.s, newDLL.s, nDLL.l
  
  If BaseAddress
    *DOS_Header = BaseAddress
    *PE_Header = BaseAddress + *DOS_Header\e_lfanew
    
    lVAddress = BaseAddress + *PE_Header\OptionalHeader\DataDirectory\VirtualAddress
    lVSize = lVAddress + *PE_Header\OptionalHeader\DataDirectory\Size
    
    *IDD_Export = *PE_Header\OptionalHeader\DataDirectory[#IMAGE_DIRECTORY_ENTRY_EXPORT] 
    *ExportDirectory = BaseAddress + *IDD_Export\VirtualAddress
    
    FuncTable = BaseAddress + *ExportDirectory\AddressOfFunctions
    OrdinalTable = BaseAddress + *ExportDirectory\AddressOfNameOrdinals
    NameTableThunk = BaseAddress + *ExportDirectory\AddressOfNames
    
    If *ExportDirectory\NumberOfNames > 4096 ; 4096 = Max exported functions
      ProcedureReturn
    EndIf
    
    For i = 0 To *ExportDirectory\NumberOfNames - 1

      If PeekS(BaseAddress + PeekL(NameTableThunk + i * SizeOf(Long)), -1, #PB_Ascii) = lpProcName 

        FuncAddr = BaseAddress + PeekL(FuncTable + PeekW(OrdinalTable + i * SizeOf(Word)) * SizeOf(Long))
        
        If FuncAddr >= lVAddress And FuncAddr <= lVSize
          ;Forwarded function
          sForward = PeekS(FuncAddr, #PB_Any, #PB_Ascii)
          FuncAddr = 0
          
          fStr = FindString(sForward, ".")
          
          If fStr > 0
            
            newDLL = Mid(sForward, 0, fStr - 1)
            newFunction = Mid(sForward, fStr + 1)
            sForward = ""
            
            nDLL = LoadLibrary_(newDLL)
            If nDLL
              FuncAddr = ResolveFunc(nDLL, newFunction)
            EndIf
            
          EndIf
          
        EndIf
        
        Break
      EndIf
    Next
    
    i = 0
    ProcedureReturn FuncAddr
  EndIf

EndProcedure
  
Procedure.b cl32_Init()
  
  If cl32_Dll = #False
    cl32_Dll = LoadLibrary_("cl32.dll")
  EndIf
  
  If cl32_Dll > 0
    
    If cryptInit = #False
      cryptInit = ResolveFunc(cl32_Dll, "cryptInit")
    EndIf
    
    If cryptEnd = #False
      cryptEnd = ResolveFunc(cl32_Dll, "cryptEnd")
    EndIf
    
    If cryptCreateSession = #False
      cryptCreateSession = ResolveFunc(cl32_Dll, "cryptCreateSession")
    EndIf
    
    If cryptSetAttributeString = #False
      cryptSetAttributeString = ResolveFunc(cl32_Dll, "cryptSetAttributeString")
    EndIf
    
    If cryptSetAttribute = #False
      cryptSetAttribute = ResolveFunc(cl32_Dll, "cryptSetAttribute")
    EndIf
    
    If cryptDestroySession = #False
      cryptDestroySession = ResolveFunc(cl32_Dll, "cryptDestroySession")
    EndIf
    
    If cryptPopData = #False
      cryptPopData = ResolveFunc(cl32_Dll, "cryptPopData")
    EndIf
    
    If cryptPushData = #False
      cryptPushData = Resolvefunc(cl32_Dll, "cryptPushData")
    EndIf
    
    If cryptFlushData = #False
      cryptFlushData = Resolvefunc(cl32_Dll, "cryptFlushData")
    EndIf
    
    If cryptFlushData > 0 And cryptPushData > 0 And cryptInit > 0 And cryptEnd > 0 And cryptCreateSession > 0 And cryptSetAttributeString > 0 And cryptSetAttribute > 0 And cryptDestroySession > 0 And cryptPopData > 0
      ProcedureReturn #True
    EndIf
  EndIf
  
EndProcedure

Procedure cl32_cryptFlushData(envelope.l)
  Define Crypt.C_cryptFlushData
  
  If cryptFlushData
    Crypt.C_cryptFlushData = cryptFlushData
    
    ProcedureReturn Crypt(envelope)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptPushData(envelope.l, *pBuff, BufLen.l, pBytesCopied.l)
  Define Crypt.C_cryptPushData
  
  If cryptPushData
    Crypt.C_cryptPushData = cryptPushData
    
    ProcedureReturn Crypt(envelope, *pBuff, BufLen, pBytesCopied)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptInit()
  Define Crypt.C_NoParameters
  
  If cryptInit
    Crypt.C_NoParameters = cryptInit
    
    ProcedureReturn Crypt()
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptEnd()
  Define Crypt.C_NoParameters
  
  If cryptEnd
    Crypt.C_NoParameters = cryptEnd
    
    ProcedureReturn Crypt()
  EndIf
  
EndProcedure

Procedure cl32_cryptCreateSession(*cryptSession, cryptUser.l, SessionType.l)
  Define Crypt.C_cryptCreateSession
  
  If cryptCreateSession
    Crypt.C_cryptCreateSession = cryptCreateSession
    
    ProcedureReturn Crypt(*cryptSession, cryptUser, SessionType)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptDestroySession(SessionId.l)
  Define Crypt.C_cryptDestroySession
  
  If cryptDestroySession
    Crypt.C_cryptDestroySession = cryptDestroySession
    
    ProcedureReturn Crypt(SessionId)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptSetAttributeString(cryptSession.l, CryptAttrType.l, *Buffer, BufferLen.l)
  Define Crypt.C_cryptSetAttributeString
  
  If cryptSetAttributeString
    Crypt.C_cryptSetAttributeString = cryptSetAttributeString
    
    ProcedureReturn Crypt(cryptSession, CryptAttrType, *Buffer, BufferLen)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptSetAttribute(cryptSession.l, CryptAttrType.l, Value.l)
  Define Crypt.C_cryptSetAttribute
  
  If cryptSetAttribute
    Crypt.C_cryptSetAttribute = cryptSetAttribute
    
    ProcedureReturn Crypt(cryptSession, CryptAttrType, Value)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure cl32_cryptPopData(envelope.l, *Buffer, BufferLen.l, pBytesCopied.l)
  Define Crypt.C_cryptPopData
  
  If cryptPopData
    Crypt.C_cryptPopData = cryptPopData
    
    ProcedureReturn Crypt(envelope, *Buffer, BufferLen, pBytesCopied)
  Else
    ProcedureReturn -1
  EndIf
  
EndProcedure

Procedure sslRecvData(secureSession.l, *returnData, *lenRtnData, buffSize.l)
  Define totalMS.l, retValue.l, totReturned.l
  
  Repeat
    Delay(100)
    totalMS = totalMS + 100
    
    If totalMS > #SSL_RESPONSE_TIMEOUT
      Break
    EndIf
    
    retValue = cl32_cryptPopData(secureSession, *returnData, buffSize, @totReturned)
    If retValue <> #CRYPT_OK
      ProcedureReturn -1
    Else
      If totReturned > 0
        PokeL(*lenRtnData, totReturned)
        Break
      EndIf
      
    EndIf
  ForEver
  
  ProcedureReturn retValue
EndProcedure

Procedure.b sslSendData(secureSession.l, *sendText, lenSendText.l)
  Define bytesSent.l, sRet.l
  
  sRet = cl32_cryptPushData(secureSession, *sendText, lenSendText, @bytesSent)
  If sRet = #CRYPT_OK
    If cl32_cryptFlushData(secureSession) = #CRYPT_OK
      ProcedureReturn #CRYPT_OK
    Else
      ProcedureReturn -1
    EndIf
  Else
    ProcedureReturn sRet
  EndIf
    
EndProcedure

Procedure TLS_Talk(Host.s, Port.l, Headers.s)
  Define SessionId.l, *Server, SvLen.l, Host.s, Port.l, *serverReply, replySize.l, bytesRecvd.l, rcvRet.l, *serverSend, SendSize.l, SendRet.l, Send.s
  
    If cl32_cryptCreateSession(@SessionId, #CRYPT_UNUSED, #CRYPT_SESSION_SSL) = #CRYPT_OK
      If cl32_cryptSetAttribute(SessionId, #CRYPT_SESSINFO_VERSION, #TLSv1_2) <> #CRYPT_OK
        Goto cleanup
      EndIf
      
      SvLen = Len(Host)
      *Server = AllocateMemory(SvLen + SizeOf(Character))
      If *Server
        PokeS(*Server, Host, -1, #PB_Ascii)
        If cl32_cryptSetAttributeString(SessionId, #CRYPT_SESSINFO_SERVER_NAME, *Server, SvLen) <> #CRYPT_OK
          FreeMemory(*Server)
          Goto cleanup
        EndIf
        FreeMemory(*Server)
      EndIf

      If cl32_cryptSetAttribute(SessionId, #CRYPT_SESSINFO_SERVER_PORT, Port) <> #CRYPT_OK
        Goto cleanup
      EndIf
      
      If cl32_cryptSetAttribute(SessionId, #CRYPT_SESSINFO_ACTIVE, 1) <> #CRYPT_OK
        Goto cleanup
      EndIf
      
      SendSize = Len(Headers)
      *serverSend = AllocateMemory(SendSize + SizeOf(Character))
      
      If *serverSend
        PokeS(*serverSend, Headers, -1, #PB_Ascii)
        SendRet = sslSendData(SessionId, *serverSend, SendSize)
        If SendRet <> #CRYPT_OK
          FreeMemory(*serverSend)
          Goto cleanup
        EndIf
        FreeMemory(*serverSend)
      EndIf
      
      replySize = 1024
      *serverReply = AllocateMemory(replySize)
      If *serverReply
        rcvRet = sslRecvData(SessionId, *serverReply, @bytesRecvd, replySize)
        If rcvRet <> #CRYPT_OK
          FreeMemory(*serverReply)
          Goto cleanup
        EndIf
        
        Debug "sslRecvData : OK : " + #CRLF$ + PeekS(*serverReply, -1, #PB_Ascii)
      
        FreeMemory(*serverReply)
      EndIf
      
      cl32_cryptDestroySession(SessionId)
    EndIf
    
  cleanup:
  If SessionId
    cl32_cryptDestroySession(SessionId)
  EndIf
EndProcedure

Procedure Main()
  Define Headers.s
  
  If cl32_Init() = #False
    ProcedureReturn
  EndIf
  
  Debug "cl32.dll loaded"
  
  If cl32_cryptInit() = #CRYPT_OK
    Debug "cl32 initialized"

    Headers = "GET /humans.txt HTTP/1.1 " + #CRLF$ +
             "Host: www.google.com" + #CRLF$ +
             "User-Agent: Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:59.0) Gecko/20100101 Firefox/59.0" + #CRLF$ +
             "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" + #CRLF$ +
             "Accept-Language: en-US,en;q=0.5" + #CRLF$ + 
             "Accept-Encoding: *" + #CRLF$ +
             "Connection: close" + #CRLF$ + #CRLF$
    
    TLS_Talk("www.google.com", 443, Headers)
  
    cl32_cryptEnd()
  EndIf
EndProcedure

Main()

Sorry for resurrecting this old topic, but i was looking for the same and i just wrote this code )