PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

SMTPS - sending emails via gmail using SSL/TLS

https://www.purebasic.fr/english/viewtopic.php?t=40026

Page 3 of 3

Re: SMTPS - sending emails via gmail using SSL/TLS

Posted: Fri Dec 11, 2009 9:27 am
by Fred
There is a #PB_Compiler_Version for this: http://www.purebasic.com/documentation/ ... tives.html . Also note than there is no need to have separate header, as the 4.40 way for CallFunctionFast() still work on 4.30. Again, these functions should not be used anymore (prefer prototypes, which are type-proof and smaller/faster).

Re: SMTPS - sending emails via gmail using SSL/TLS

Posted: Fri Dec 11, 2009 10:38 pm
by Mike Trader
>Again, these functions should not be used - prefer prototypes
http://www.purebasic.com/documentation/ ... types.html

The prototype still needs a type for the arguments no?


DeviceOpen.l = cryptDeviceOpen( pDevice, cryptUser, deviceType, @zName )
or
DeviceOpen.l = cryptDeviceOpen( pDevice, cryptUser, deviceType, zName )


OpenLibrary(0, "cl32.dll")
pFunc.DWORD = GetFunction(0, "cryptDeviceOpen") ; not sure what you use for an unsigned 32bit integer

Then Im not sure of the syntax but something like:

CALL BY pFunc cryptDeviceOpen( ....

Re: SMTPS - sending emails via gmail using SSL/TLS

Posted: Sat Dec 12, 2009 8:49 am
by idle

Code: Select all

CompilerIf #PB_Compiler_Version = 440 
  Prototype.i protocryptDeviceOpen( pDevice, cryptUser, deviceType, @zName )
CompilerElse
  Prototype.i protocryptDeviceOpen( pDevice, cryptUser, deviceType, zName )
CompilerEndIf

If OpenLibrary(0, "cl32.dll")

  cryptDeviceOpen.protocryptDeviceOpen = GetFunction(0, "cryptDeviceOpen") 

EndIf 

CryptDeviceOpen(1,2,3,"BoB")

Re: SMTPS - sending emails via gmail using SSL/TLS

Posted: Mon Dec 14, 2009 12:30 am
by Uncle B
Hi again..

I think the last part of the header should be changed to this:

Code: Select all

;  /****************************************************************************
;  *                                                                                                                 *
;  *                                        General Functions                                         *
;  *                                                                                                                 *
;  ****************************************************************************/ 

#Cryptlib = 1

;Global #Cryptlib.l
OpenLibrary(#Cryptlib, "cl32.dll")


Prototype.l Proto_cryptInit()
Global cryptInit.Proto_cryptInit = GetFunction(#Cryptlib, "cryptInit")

Prototype.l Proto_cryptEnd()
Global cryptEnd.Proto_cryptEnd = GetFunction(#Cryptlib, "cryptEnd")

Prototype.l Proto_cryptQueryCapability(device.l, cryptAlgo.l, CQI) ;CQI.CRYPT_QUERY_INFO
Global cryptQueryCapability.Proto_cryptQueryCapability = GetFunction(#Cryptlib, "cryptQueryCapability")

Prototype.l Proto_cryptCreateContext(hContext.l, cryptUser.l, cryptAlgo.l) 
Global cryptCreateContext.Proto_cryptCreateContext = GetFunction(#Cryptlib, "cryptCreateContext")

Prototype.l Proto_cryptDestroyContext(hContext.l) 
Global cryptDestroyContext.Proto_cryptDestroyContext = GetFunction(#Cryptlib, "cryptDestroyContext")

Prototype.l Proto_cryptDestroyObject(hCrypt.l) 
Global cryptDestroyObject.Proto_cryptDestroyObject = GetFunction(#Cryptlib, "cryptDestroyObject")

Prototype.l Proto_cryptGenerateKey(hContext.l) 
Global cryptGenerateKey.Proto_cryptGenerateKey = GetFunction(#Cryptlib, "cryptGenerateKey")

Prototype.l Proto_cryptGenerateKeyAsync(hContext.l) 
Global cryptGenerateKeyAsync.Proto_cryptGenerateKeyAsync = GetFunction(#Cryptlib, "cryptGenerateKeyAsync")

Prototype.l Proto_cryptAsyncQuery(hCrypt.l) 
Global cryptAsyncQuery.Proto_cryptAsyncQuery = GetFunction(#Cryptlib, "cryptAsyncQuery")

Prototype.l Proto_cryptAsyncCancel(hCrypt.l) 
Global cryptAsyncCancel.Proto_cryptAsyncCancel = GetFunction(#Cryptlib, "cryptAsyncCancel")

Prototype.l Proto_cryptEncrypt(hContext.l, pBuffer.i, length.l) 
Global cryptEncrypt.Proto_cryptEncrypt = GetFunction(#Cryptlib, "cryptEncrypt")

Prototype.l Proto_cryptDecrypt(hContext.l, pBuffer.i, length.l) 
Global cryptDecrypt.Proto_cryptDecrypt = GetFunction(#Cryptlib, "cryptDecrypt")

Prototype.l Proto_cryptSetAttribute(hCrypt.l,CryptAttType.l, value.l) 
Global cryptSetAttribute.Proto_cryptSetAttribute = GetFunction(#Cryptlib, "cryptSetAttribute")

Prototype.l Proto_cryptSetAttributeString(hCrypt.l, CryptAttType.l, pBuff.i, StrLen.l) 
Global cryptSetAttributeString.Proto_cryptSetAttributeString = GetFunction(#Cryptlib, "cryptSetAttributeString")

Prototype.l Proto_cryptGetAttribute(hCrypt.l, CryptAttType.l, pRetVal.l) 
Global cryptGetAttribute.Proto_cryptGetAttribute = GetFunction(#Cryptlib, "cryptGetAttribute")

Prototype.l Proto_cryptGetAttributeString(hCrypt.l, CryptAttType.l, pBuff.i, pStrLen.l) 
Global cryptGetAttributeString.Proto_cryptGetAttributeString = GetFunction(#Cryptlib, "cryptGetAttributeString")

Prototype.l Proto_cryptDeleteAttribute(hCrypt.l, CryptAttType.l) 
Global cryptDeleteAttribute.Proto_cryptDeleteAttribute = GetFunction(#Cryptlib, "cryptDeleteAttribute")

Prototype.l Proto_cryptAddRandom(pData.i, RandDataLen.l) 
Global cryptAddRandom.Proto_cryptAddRandom = GetFunction(#Cryptlib, "cryptAddRandom")

Prototype.l Proto_cryptQueryObject(pData.i, pCOI) ;pCOI.CRYPT_OBJECT_INFO)
Global cryptQueryObject.Proto_cryptQueryObject = GetFunction(#Cryptlib, "cryptQueryObject")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                        Mid-level Encryption Functions                             *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptExportKey(pKey.i, pEncryptedKeyLength.l, exportKey.l, sessionKeyContext.l) 
Global cryptExportKey.Proto_cryptExportKey = GetFunction(#Cryptlib, "cryptExportKey")

Prototype.l Proto_cryptExportKeyEx(pKey.i, pEncryptedKeyLength.l, FormatType.l, exportKey.l, sessionKeyContext.l) 
Global cryptExportKeyEx.Proto_cryptExportKeyEx = GetFunction(#Cryptlib, "cryptExportKeyEx")

Prototype.l Proto_cryptImportKey(pKey.i, importKey.l, sessionKeyContext.l)
Global cryptImportKey.Proto_cryptImportKey = GetFunction(#Cryptlib, "cryptImportKey")

Prototype.l Proto_cryptImportKeyEx(pKey.i, importKey.l, sessionKeyContext.l, pReturnedContext.l)
Global cryptImportKeyEx.Proto_cryptImportKeyEx = GetFunction(#Cryptlib, "cryptImportKeyEx")

Prototype.l Proto_cryptCreateSignature(pSig.i, pSignatureLength.l, signContext.l, hashContext.l)
Global cryptCreateSignature.Proto_cryptCreateSignature = GetFunction(#Cryptlib, "cryptCreateSignature")

Prototype.l Proto_cryptCreateSignatureEx(pSig.i, pSignatureLength.l, FormatType.l, signContext.l, hashContext.l, extraData.l)
Global cryptCreateSignatureEx.Proto_cryptCreateSignatureEx = GetFunction(#Cryptlib, "cryptCreateSignatureEx")

Prototype.l Proto_cryptCheckSignature(pSig.i, sigCheckKey.l, hashContext.l)
Global cryptCheckSignature.Proto_cryptCheckSignature = GetFunction(#Cryptlib, "cryptCheckSignature")

Prototype.l Proto_cryptCheckSignatureEx(pSig.i, sigCheckKey.l, hashContext.l, pExtraData.l)
Global cryptCheckSignatureEx.Proto_cryptCheckSignatureEx = GetFunction(#Cryptlib, "cryptCheckSignatureEx")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                                  Keyset Functions                                       *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptKeysetOpen(pKeyset.l, cryptUser.l, keysetType.l, zName.s, options.l)
Global cryptKeysetOpen.Proto_cryptKeysetOpen = GetFunction(#Cryptlib, "cryptKeysetOpen")

Prototype.l Proto_cryptKeysetClose(keyset.l)
Global cryptKeysetClose.Proto_cryptKeysetClose = GetFunction(#Cryptlib, "cryptKeysetClose")

Prototype.l Proto_cryptGetPublicKey(keyset.l, pContext.l, keyIDtype.l, zKeyID.s)
Global cryptGetPublicKey.Proto_cryptGetPublicKey = GetFunction(#Cryptlib, "cryptGetPublicKey")

Prototype.l Proto_cryptGetPrivateKey(keyset.l, pContext.l, keyIDtype.l, zKeyID.s, zPassword.s)
Global cryptGetPrivateKey.Proto_cryptGetPrivateKey = GetFunction(#Cryptlib, "cryptGetPrivateKey")

Prototype.l Proto_cryptGetKey(keyset.l, CryptContext.l, keyIDtype.l, zKeyID.s, zPassword.s)
Global cryptGetKey.Proto_cryptGetKey = GetFunction(#Cryptlib, "cryptGetKey")

Prototype.l Proto_cryptAddPublicKey(keyset.l, certificate.l)
Global cryptAddPublicKey.Proto_cryptAddPublicKey = GetFunction(#Cryptlib, "cryptAddPublicKey")

Prototype.l Proto_cryptAddPrivateKey(keyset.l, cryptKey.l, zPassword.s)
Global cryptAddPrivateKey.Proto_cryptAddPrivateKey = GetFunction(#Cryptlib, "cryptAddPrivateKey")

Prototype.l Proto_cryptDeleteKey(keyset.l, keyIDtype.l, zKeyID.s)
Global cryptDeleteKey.Proto_cryptDeleteKey = GetFunction(#Cryptlib, "cryptDeleteKey")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                                Certificate Functions                                   *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptCreateCert(pCert.l, cryptUser.l, certType.l)
Global cryptCreateCert.Proto_cryptCreateCert = GetFunction(#Cryptlib, "cryptCreateCert")

Prototype.l Proto_cryptDestroyCert(hCert.l)
Global cryptDestroyCert.Proto_cryptDestroyCert = GetFunction(#Cryptlib, "cryptDestroyCert")

Prototype.l Proto_cryptGetCertExtension(hCert.l, zOid.s, pCriticalFlag.l, pExtension.i, pextensionLen.l)
Global cryptGetCertExtension.Proto_cryptGetCertExtension = GetFunction(#Cryptlib, "cryptGetCertExtension")

Prototype.l Proto_cryptAddCertExtension(hCert.l, zOid.s, criticalFlag.l, pExtension.i, extensionLen.l)
Global cryptAddCertExtension.Proto_cryptAddCertExtension = GetFunction(#Cryptlib, "cryptAddCertExtension")

Prototype.l Proto_cryptDeleteCertExtension(hCert.l, zOid.s)
Global cryptDeleteCertExtension.Proto_cryptDeleteCertExtension = GetFunction(#Cryptlib, "cryptDeleteCertExtension")

Prototype.l Proto_cryptSignCert(hCert.l, signContext.l)
Global cryptSignCert.Proto_cryptSignCert = GetFunction(#Cryptlib, "cryptSignCert")

Prototype.l Proto_cryptCheckCert(hCert.l, sigCheckKey.l)
Global cryptCheckCert.Proto_cryptCheckCert = GetFunction(#Cryptlib, "cryptCheckCert")

Prototype.l Proto_cryptImportCert(pCertObj.i, certObjectLength.l, cryptUser.l, pCert.l)
Global cryptImportCert.Proto_cryptImportCert = GetFunction(#Cryptlib, "cryptImportCert")

Prototype.l Proto_cryptExportCert(pCertObj.i, pCertObjectLength.l, certFormatType.l, hCert.l)
Global cryptExportCert.Proto_cryptExportCert = GetFunction(#Cryptlib, "cryptExportCert")

Prototype.l Proto_cryptCAAddItem(keyset.l, hCert.l)
Global cryptCAAddItem.Proto_cryptCAAddItem = GetFunction(#Cryptlib, "cryptCAAddItem")

Prototype.l Proto_cryptCAGetItem(keyset.l, pCert.l, certType.l, keyIDtype.l, zKeyID.s)
Global cryptCAGetItem.Proto_cryptCAGetItem = GetFunction(#Cryptlib, "cryptCAGetItem")

Prototype.l Proto_cryptCADeleteItem(keyset.l, keyIDtype.l, zKeyID.s)
Global cryptCADeleteItem.Proto_cryptCADeleteItem = GetFunction(#Cryptlib, "cryptCADeleteItem")

Prototype.l Proto_cryptCACertManagement(pCert.l, CertAction.l, keyset.l, caKey.l, certRequest.l)
Global cryptCACertManagement.Proto_cryptCACertManagement = GetFunction(#Cryptlib, "cryptCACertManagement")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                        Envelope & Session Functions                               *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptCreateSession(pSession.l, cryptUser.l, SessionType.l)
Global cryptCreateSession.Proto_cryptCreateSession = GetFunction(#Cryptlib, "cryptCreateSession")

Prototype.l Proto_cryptDestroySession(session.l)       
Global cryptDestroySession.Proto_cryptDestroySession = GetFunction(#Cryptlib, "cryptDestroySession")

Prototype.l Proto_cryptCreateEnvelope(pEnvelope.l, cryptUser.l, FormatType.l)     
Global cryptCreateEnvelope.Proto_cryptCreateEnvelope = GetFunction(#Cryptlib, "cryptCreateEnvelope")

Prototype.l Proto_cryptDestroyEnvelope(envelope.l)      
Global cryptDestroyEnvelope.Proto_cryptDestroyEnvelope = GetFunction(#Cryptlib, "cryptDestroyEnvelope")

Prototype.l Proto_cryptPushData(envelope.l, pBuff.i, StrLen.l,  pBytesCopied.l)     
Global cryptPushData.Proto_cryptPushData = GetFunction(#Cryptlib, "cryptPushData")

Prototype.l Proto_cryptFlushData(envelope.l)           
Global cryptFlushData.Proto_cryptFlushData = GetFunction(#Cryptlib, "cryptFlushData")

Prototype.l Proto_cryptPopData(envelope.l, pBuff.i, StrLen.l, pBytesCopied.l)          
Global cryptPopData.Proto_cryptPopData = GetFunction(#Cryptlib, "cryptPopData")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                              Device Functions                                           *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptDeviceOpen(pDevice.l, cryptUser.l, deviceType.l, zName.s)
Global cryptDeviceOpen.Proto_cryptDeviceOpen = GetFunction(#Cryptlib, "cryptDeviceOpen")

Prototype.l Proto_cryptDeviceClose(device.l)
Global cryptDeviceClose.Proto_cryptDeviceClose = GetFunction(#Cryptlib, "cryptDeviceClose")

Prototype.l Proto_cryptDeviceQueryCapability(device.l, cryptAlgo.l, pCryptQueryInfo) ;pCryptQueryInfo.CRYPT_QUERY_INFO
Global cryptDeviceQueryCapability.Proto_cryptDeviceQueryCapability = GetFunction(#Cryptlib, "cryptDeviceQueryCapability")

Prototype.l Proto_cryptDeviceCreateContext(device.l, pContext.l, cryptAlgo.l)
Global cryptDeviceCreateContext.Proto_cryptDeviceCreateContext = GetFunction(#Cryptlib, "cryptDeviceCreateContext")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                          User Management Functions                                   *
;  *                                                                                                                 *    
;  ****************************************************************************/

Prototype.l Proto_cryptLogin(pUser.l, zName.s, zPassword.s)
Global cryptLogin.Proto_cryptLogin = GetFunction(#Cryptlib, "cryptLogin")

Prototype.l Proto_cryptLogout(user.l)
Global cryptLogout.Proto_cryptLogout = GetFunction(#Cryptlib, "cryptLogout")


;  /****************************************************************************
;  *                                                                                                                 *
;  *                                          User Interface Functions                                   *
;  *                                                                                                                 *
;  ****************************************************************************/

Prototype.l Proto_cryptUIGenerateKey(CryptDevice.l, CryptContext.l, CryptCert.l, zPassword.s, hWnd.l)
Global cryptUIGenerateKey.Proto_cryptUIGenerateKey = GetFunction(#Cryptlib, "cryptUIGenerateKey")

Prototype.l Proto_cryptUIDisplayCert(CryptCert.l, hWnd.l)
Global cryptUIDisplayCert.Proto_cryptUIDisplayCert = GetFunction(#Cryptlib, "cryptUIDisplayCert")
As I think it would be a waste to only use cryptLib for Gmail I've been trying to create a PB-like set of functions to build a proper TLS server.
I did manage to do so, but only in a very unstable way. In the below example project the stability decreases as the number of clients increases. As I'm not very experienced I think I might be using a wrong approach. I would highly appriciate any of you to see how this can be done in a stable and fast way with a high number of clients..

Thanks in advance,

Bart

SSL Library.pb:

Code: Select all


XIncludeFile "Cryptlib_Header_V2.pb"

cryptContext.l
cryptKeyset.l
cryptCertificate.l


Structure SSLServerConnection
    ThreadID.l
    ConnectionID.l
    UserName.s
EndStructure

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

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

Structure SSLServerEvents
  ClientID.l
  EventType.l
  pBuffer.l
  BufferLength.l
  Processed.l
EndStructure

Global NewList SSL_Server_Connections.SSLServerConnection()
Global NewList SSL_EventBuffer.SSLServerEvents()

Global SSLServerParameters.SSLServerParams
Global SSLServerMutex = CreateMutex()
Global SSLEventMutex = CreateMutex()

Procedure 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   

Procedure.l WaitSSLServerEvent(ConnectionID)

Protected sBuff.l, BytesReply.l, Buff2.l, oldsize.l, Done.l

sBuff = AllocateMemory(256)

Repeat
      RetVal = CryptPopData(ConnectionID, sBuff, 256, @BytesReply )
      If RetVal <> #CRYPT_OK : Debug "CryptPopData ERROR": EndIf
      
      If BytesReply > 0
            
            Buff2 = AllocateMemory(256)
            CopyMemory(sBuff, Buff2, BytesReply)
            size = BytesReply
            
            Repeat
            
                RetVal = CryptPopData(ConnectionID, sBuff, 256, @BytesReply )
                If RetVal <> #CRYPT_OK : Debug "CryptPopData ERROR": EndIf
      
                If BytesReply > 0
                      Buff2 = ReAllocateMemory(Buff2, size + BytesReply)
                      CopyMemory(sBuff, Buff2 + size, BytesReply)
                      size + BytesReply
                Else
                   done=1
                   Break
                EndIf

            ForEver

      Else
          Delay(200)
      EndIf
      
      If done=1
         Break
      EndIf
      
ForEver

ProcedureReturn Buff2

EndProcedure

Procedure WaitEventProcessing(ConnectionID)

Protected processed.l = 0

Repeat
    LockMutex(SSLEventMutex)
        ForEach SSL_EventBuffer()
           If SSL_EventBuffer()\ClientID = ConnectionID
              If SSL_EventBuffer()\processed = 1
                    DeleteElement(SSL_EventBuffer())
                    processed =1 
              EndIf
              Break
           EndIf
        Next
    UnlockMutex(SSLEventMutex)
Delay(100)
Until processed = 1

EndProcedure

Procedure SSLServer(void)

Protected cryptContext.l, cryptKeyset.l, cryptSession.l
Protected privateKey.l, publicKey.l, Port.l, bytes.l, BytesReply.l
Protected password.s, label.s, fname.s, clientname.s
Protected eventBuffer.SSLServerEvents


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


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

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

;/* Load private key */
         cryptGetPrivateKey(cryptKeyset, @privateKey, #CRYPT_KEYID_NAME, label, password)

;/* 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, privateKey);
       cryptSetAttribute(cryptSession, #CRYPT_SESSINFO_ACTIVE, 1 );

    
    ;***************************************************************************************************
    ;************************************ Create new server thread *************************************
    ;***************************************************************************************************
    ;After a client contacts this server a new server thread must be created to stand by for the next client to log on.
    ;Also register the current cryptSession as ConnectionID in the SSL_Server_Connections() list.
    ;The stand by server thread is always the last one in the list.
    
      thread = CreateThread(@SSLServer(), 0)
        If thread
            LockMutex(SSLServerMutex)
            
                LastElement(SSL_Server_Connections())
                SSL_Server_Connections()\ConnectionID = cryptSession
      
                AddElement(SSL_Server_Connections())
                SSL_Server_Connections()\ThreadID = thread
                
            UnlockMutex(SSLServerMutex)
        EndIf
        
    ;***************************************************************************************************
    ;***************************************************************************************************
    
    sReply.s = ""
    sBuff = AllocateMemory(256)
      
      Repeat

        ;eventBuffer\ClientID = cryptSession
      
      cryptGetAttribute(cryptSession, #CRYPT_SESSINFO_CONNECTIONACTIVE, @connectionActive);
      If connectionActive
     
          Buff = WaitSSLServerEvent(cryptSession)
      
          If Buff
           LockMutex(SSLEventMutex)
              AddElement(SSL_EventBuffer())
              With SSL_EventBuffer()
                   \ClientID = cryptSession
                   \EventType = #SSLEvent_Data
                   \pBuffer = Buff
                   \Bufferlength = MemorySize(Buff)
                   \Processed = 0
              EndWith 
            UnlockMutex(SSLEventMutex)

            WaitEventProcessing(cryptSession)
        
            FreeMemory(Buff)
          EndIf
        
        Else
            Break
        EndIf
      ForEver

;/* Clean up */
    cryptDestroySession(cryptSession)
    cryptKeysetClose(cryptKeyset)
    cryptDestroyContext(cryptContext)

    LockMutex(SSLServerMutex)
      ForEach SSL_Server_Connections()
        If SSL_Server_Connections()\ConnectionID = cryptSession
            DeleteElement(SSL_Server_Connections())
            Break
        EndIf
      Next
    UnlockMutex(SSLServerMutex)

EndProcedure

Procedure SSLEvent()

result = 0
LockMutex(SSLEventMutex)
    If ListSize(SSL_EventBuffer()) > 0
          FirstElement(SSL_EventBuffer())
          result = SSL_EventBuffer()\EventType
          
    EndIf
UnlockMutex(SSLEventMutex)
ProcedureReturn result 

EndProcedure

Procedure SSLEventClient()
Protected result.l = 0
LockMutex(SSLEventMutex)
    If ListSize(SSL_EventBuffer()) > 0
          FirstElement(SSL_EventBuffer())
          result = SSL_EventBuffer()\ClientID
    EndIf
UnlockMutex(SSLEventMutex)
ProcedureReturn result 

EndProcedure

Procedure RecieveSSLData(ConnectionID)

Protected result.l = 0
LockMutex(SSLEventMutex)
    If ListSize(SSL_EventBuffer()) > 0
          ForEach SSL_EventBuffer()
          With SSL_EventBuffer()
            If \ClientID = ConnectionID
                *DataBuffer = AllocateMemory(\BufferLength)
                CopyMemory(\pBuffer, *DataBuffer, \BufferLength)
                result = *DataBuffer
                \Processed = 1
                Break
            EndIf
          EndWith
          Next
    EndIf
UnlockMutex(SSLEventMutex)

ProcedureReturn result 

EndProcedure

Procedure OpenSSLConnection(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 );

    ProcedureReturn cryptSession

EndProcedure

Procedure SendSSLString(ConnectionID.l, string$) 

Protected copied.l

pBuff.s = Space(255)

If ConnectionID
      ;RetVal = cryptPopData(ConnectionID, @pBuff, 256, @copied)
      ;If RetVal <> 0 : Debug "popData Error" : ProcedureReturn 0 : EndIf

      RetVal = cryptPushData(ConnectionID, @string$, Len(string$), @copied)
      If RetVal <> 0 : Debug "pushData Error" : ProcedureReturn 0 : EndIf
      
      RetVal = cryptFlushData(ConnectionID)
      If RetVal <> 0
          ProcedureReturn 0
      EndIf
      
Else
    ProcedureReturn 0
EndIf

ProcedureReturn 1

EndProcedure

Procedure CreateSSLServer(Port.l, KeySetFile.s, KeySetLabel.s, KeySetPassword.s)

With SSLServerParameters
    \ServerPort = Port
    \KeysetFile = KeySetFile
    \KeysetLabel = KeySetLabel
    \KeysetPassword = KeySetPassWord
EndWith

ClearList(SSL_Server_Connections())
thread = CreateThread(@SSLServer(), 0)

If thread
    LastElement(SSL_Server_Connections())
    AddElement(SSL_Server_Connections())
    SSL_Server_Connections()\ThreadID = thread
    
    ProcedureReturn 1
Else
    ProcedureReturn 0
EndIf

EndProcedure

Procedure SSLServerShutDown()

  LockMutex(SSLServerMutex)
    ForEach SSL_Server_Connections()
      If IsThread(SSL_Server_Connections()\ThreadID)
        KillThread(SSL_Server_Connections()\ThreadID)
      EndIf
      DeleteElement(SSL_Server_Connections())
    Next
  UnlockMutex(SSLServerMutex)

EndProcedure
Server.pb:

Code: Select all

XIncludeFile "SSL Library.pb"

cryptInit()

If GenerateKeyset("TestKeyset.p15", "key", "commonname", "password")
    Debug "Keyset generated succesfully..."
Else
    Debug "Unable to generate keyset..."
EndIf

CreateSSLServer(6000, "TestKeyset.p15", "key", "password")

Repeat

    Event = SSLEvent()
    
        If Event
        
            ClientID = SSLEventClient()
            
            Select Event
                
                Case #SSLEvent_Data
                                  
                   DataBuffer = RecieveSSLData(ClientID)
                   
                   string$ = PeekS(DataBuffer)
                   Debug string$
                   sendSSLString(ClientID, "String received OK"); + Chr(10) + Chr(13))
                   
                   FreeMemory(DataBuffer)
                   
            
            EndSelect
        EndIf
        
Delay(200) ; Increase delay to increase stability...

ForEver

SSLServerShutDown()
Client.pb:

Code: Select all

XIncludeFile "SSL Library.pb"

cryptInit()

Procedure startclient(number)

  ConnectionID = OpenSSLConnection("localhost", 6000)

  cnt = 0

  If ConnectionID
    Repeat
        res = SendSSLString(ConnectionID, "This is test string #"+Str(cnt)+" from client #"+ Str(number))
        If res 
            cnt +1
            *Buffer = WaitSSLServerEvent(ConnectionID)
            
            If *Buffer
                  sReply.s = PeekS(*Buffer)
                  Debug "sReply= " + sReply
                  FreeMemory(*Buffer)
            EndIf
            Delay(1000)

        Else
            Break
        EndIf

    ForEver
  EndIf
  
EndProcedure
  
 
 
 For i = 1 To 3
    CreateThread(@startclient(),i)
    Delay(1050)
 Next
 
 Repeat
 
    Delay(1000)
 
 ForEver
All times are UTC+01:00
Page 3 of 3

Powered by phpBB® Forum Software © phpBB Limited