PureBasic Forums - English

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

Proxy and asynchronous socket in NetworkLib

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

Page 1 of 2

Proxy and asynchronous socket in NetworkLib

Posted: Sat Dec 29, 2012 11:37 am
by User_Russian
Please add support for proxy servers and asynchronous sockets network library.

It would be nice if the function OpenNetworkConnection() could make connections through HTTP / HTTPS / SOCKS 4/SOCKS 5 proxy server.

Asynchronous sockets needed if you want to make one thread at the same time a lot of connections, rather than one, as in the current implementation of the library, using synchronous sockets.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Fri Feb 01, 2013 10:31 pm
by User_Russian
It is a pity that no one supported the idea. :( :(
Asynchronous socket is indispensable when you need one thread to establish many connections per second and at the same time execute other code. The current implementation, OpenNetworkConnection() does not allow to do it.

Here is the code for Windows, which allows you to set many connections per second, since there is no expectation the connection. In place of this, periodic check the connection, which allows a single thread to establish many connections and execute other code.

Code: Select all

Prototype WSACreateEvent() 
Prototype WSAEventSelect(Socket.i, hEvent.i, lNetworkEvents.l) 
Prototype WSACloseEvent(hEvent.i) 
Prototype WSAWaitForMultipleEvents(EventNum.i, *lphEvents, fWaitAll.b, dwTimeout.l, fAlertable) 
Prototype WSAEnumNetworkEvents(Socket.i, hEventObject, *lpNetworkEvents) 

#HEAP_ZERO_MEMORY=8 

#FD_MAX_EVENTS         = 10 
#FD_CONNECT_BIT        = 4 
#WSA_WAIT_FAILED       = #WAIT_FAILED 
#WSA_INVALID_EVENT     = #Null 
#WSA_NOT_ENOUGH_MEMORY = #ERROR_NOT_ENOUGH_MEMORY 
#WSA_INVALID_HANDLE    = #ERROR_INVALID_HANDLE 
#WSA_INVALID_PARAMETER = #ERROR_INVALID_PARAMETER 
#WSA_WAIT_EVENT_0      = #Null 
#WSA_WAIT_TIMEOUT      = #WAIT_TIMEOUT 
#WSA_WAIT_IO_COMPLETION = #WAIT_IO_COMPLETION 

#PB_NetworkEvent_Connect_TimeOut=2
#PB_NetworkEvent_NoConnect=-1

EventID.Integer 


Structure WSANETWORKEVENTS 
  lNetworkEvents.l 
  iErrorCode.i[#FD_MAX_EVENTS] 
EndStructure 

InitNetwork() 



ws2_32_Module=OpenLibrary(#PB_Any, "ws2_32.dll") 
If ws2_32_Module=0 
  MessageRequester("", "Ошибка загрузки библиотеки 'ws2_32.dll'.", #MB_OK|#MB_ICONERROR) 
  End 
EndIf 

Temp=0 
CallFunction(ws2_32_Module, "WSAStartup", $202, @Temp) 

Global WSACreateEvent.WSACreateEvent = GetFunction(ws2_32_Module, "WSACreateEvent") 
Global WSAEventSelect.WSAEventSelect = GetFunction(ws2_32_Module, "WSAEventSelect") 
Global WSACloseEvent.WSACloseEvent = GetFunction(ws2_32_Module, "WSACloseEvent") 
Global WSAWaitForMultipleEvents.WSAWaitForMultipleEvents = GetFunction(ws2_32_Module, "WSAWaitForMultipleEvents") 
Global WSAEnumNetworkEvents.WSAEnumNetworkEvents = GetFunction(ws2_32_Module, "WSAEnumNetworkEvents") 

Procedure WSA_OpenNetworkConnection(ip.s, port.l, *EventID.Integer) 
  Protected *ptr, clientService.sockaddr_in, argp.l, Socket.i, *Mem, Count 
  Protected sin_addr, *Socket_2, Heap , *hostinfo.HOSTENT
  
  Count = StringByteLength(ip, #PB_Ascii)
  *Mem = AllocateMemory(Count+4)
  If *Mem
    FillMemory(*Mem, Count+4, 0, #PB_Byte)
    PokeS(*Mem, ip, -1, #PB_Ascii)
    sin_addr=inet_addr_(*Mem)
    If sin_addr=-1 Or sin_addr=#INADDR_ANY
      *hostinfo = gethostbyname_(*Mem)
      If *hostinfo
        If *hostinfo\h_addrtype=#AF_INET
          *ptr=PeekI(*hostinfo\h_addr_list)
          If *ptr
            sin_addr=PeekL(*ptr)
          EndIf
          *ptr=0
        EndIf
      Else
        sin_addr=-1
      EndIf
    EndIf
    FreeMemory(*Mem)
  Else
    ProcedureReturn #False
  EndIf
  
  If sin_addr=-1 Or sin_addr=#INADDR_ANY
    ProcedureReturn #False
  EndIf
  
  
  Socket = SOCKET_(#AF_INET, #SOCK_STREAM, #IPPROTO_TCP) 
  
  If Socket = #INVALID_SOCKET 
    ProcedureReturn #False 
  EndIf 
  
  argp=01 ; Asynchronous socket. 
  If ioctlsocket_(Socket, #FIONBIO, @argp)<>#SOCKET_ERROR 
    
    *ptr = clientService.sockaddr_in 
    clientService\sin_family = #AF_INET 
    clientService\sin_addr = sin_addr 
    clientService\sin_port = htons_(port) 
    
    !MOV Eax, dword [_PB_MemoryBase] 
    !MOV dword [p.v_Heap], Eax 
    
    *Socket_2=HeapAlloc_(Heap, #HEAP_ZERO_MEMORY, $10) 
    If *Socket_2 
      PokeL(*Socket_2, 1) 
      PokeL(*Socket_2+8, Socket) 
      
      If *EventID 
        *EventID\i=#WSA_INVALID_EVENT 
        *EventID\i=WSACreateEvent() 
        If *EventID\i<>#WSA_INVALID_EVENT 
          If WSAEventSelect(Socket, *EventID\i, #FD_CONNECT)=#SOCKET_ERROR 
            WSACloseEvent(*EventID\i) 
            Goto WSA_OpenNetworkConnection_Err 
          EndIf 
        Else 
          WSA_OpenNetworkConnection_Err: 
          *EventID\i=0 
          closesocket_(Socket) 
          HeapFree_(Heap, 0, *Socket_2) 
          *Socket_2=0 
          ProcedureReturn #False 
        EndIf 
      EndIf 
      connect_(Socket, *Ptr, SizeOf(sockaddr_in)) 
      
      
      
      ProcedureReturn *Socket_2 
    Else 
      closesocket_(Socket) 
      ProcedureReturn #False 
    EndIf 
  Else 
    closesocket_(Socket) 
    ProcedureReturn #False 
  EndIf 
  
EndProcedure 

Procedure WSA_Event(ConnectID, EventID, CurrentTime, TimeOut)
  x=#False 
  NetworkEvents.WSANETWORKEVENTS 
  
  
  Temp = WSAWaitForMultipleEvents(1, @BlockingMode, #False, 0, #False) 
  If Temp <> #WSA_WAIT_FAILED ; Нет ошибки. 
    If Temp <> #WSA_WAIT_TIMEOUT ; Выход не по таймауту. 
      Socket=ConnectionID(ConnectID) 
      If WSAEnumNetworkEvents(Socket, EventID, @NetworkEvents)<>#SOCKET_ERROR ; Нет ошибки. 
        If NetworkEvents\lNetworkEvents & #FD_CONNECT 
          If NetworkEvents\iErrorCode[#FD_CONNECT_BIT]=0 
            ; ОК, Yes Connect. 
            x=#PB_NetworkEvent_Connect 
            
            WSAEventSelect(Socket, 0, 0)              
            Temp=0 ; Синхронный сокет. 
            ioctlsocket_(Socket, #FIONBIO, @Temp) 
            WSACloseEvent(EventID) 
             
          Else 
            x= #PB_NetworkEvent_NoConnect 
          EndIf 
        EndIf 
      Else ; Error WSAEnumNetworkEvents(). 
        x=#PB_NetworkEvent_NoConnect  
      EndIf 
    EndIf 
  Else ; Error WSAWaitForMultipleEvents(). 
    x=#PB_NetworkEvent_NoConnect 
  EndIf 
  
  
  If x<>#PB_NetworkEvent_Connect
    If ElapsedMilliseconds()-(CurrentTime+TimeOut) > 0
      x = #PB_NetworkEvent_Connect_TimeOut ; Exit on timeout.
    EndIf
  EndIf
  
  
  ProcedureReturn x
EndProcedure

ConnectID=WSA_OpenNetworkConnection("google.com", 80, @EventID) 

CurrentTime=ElapsedMilliseconds()
TimeOut=10000 ; 10 second.

Repeat 
  
  x=WSA_Event(ConnectID, EventID\i, CurrentTime, TimeOut)
  
  If x<>#False
    Break
  EndIf
  
  Delay(100)
   
ForEver

If x=#PB_NetworkEvent_Connect
  Debug "Yes Connect." 
ElseIf x=#PB_NetworkEvent_NoConnect
  Debug "No Connect." 
ElseIf x=#PB_NetworkEvent_Connect_TimeOut
  Debug "No Connect (Exit on timeout)." 
EndIf


WSACloseEvent(EventID\i) 
CloseNetworkConnection(ConnectID)
In the current model of the network library to embed this code is not difficult.

Current syntax function OpenNetworkConnection().

Code: Select all

Connection = OpenNetworkConnection(ServerName$, Port [, Mode [, TimeOut [, LocalIP$ [, LocalPort]]]])
For argument "Mode" to add the flag #PB_Network_TCP_Asynchronous.
Procedure WSA_Event() from the code above, should be called within the function NetworkClientEvent(), if the connection is opened with flag # PB_Network_TCP_Asynchronous.
Argument "TimeOut" function OpenNetworkConnection() must be passed to the procedure WSA_Event().

In the event of a successful connection is established, the function NetworkClientEvent() should return #PB_NetworkEvent_Connect, and in case if it fails to establish a connection, it must return the #PB_NetworkEvent_NoConnect
If you can not establish a connection in the time specified in the argument of "TimeOut", then the function NetworkClientEvent() should return #PB_NetworkEvent_Connect_TimeOut.

If, for any reason, it will not be implemented, please give equivalent code above, for Linux.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sat Feb 02, 2013 2:51 am
by RichAlgeni
Couldn't the same thing be done by opening receiving sockets into an array, then looping through the array to see if anything is in the receive buffer?

Use the NetworkServerEvent() #PB_NetworkEvent_Connect to trigger a new connection. Increment your array, and place the result of EventClient() (client connection) into the incremented array.

Loop through your array, and pass the individual client connection as well as an allocated memory segment to a procedure. Get the socket handle using ConnectionID(), then check to see if anything is in the read buffer using ioctlsocket_(socketHandle, #FIONREAD, @length).

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sat Feb 02, 2013 11:02 am
by User_Russian
RichAlgeni, requires cross-platform code, not just for Windows.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sat Feb 02, 2013 8:33 pm
by RichAlgeni
Ah, ok. Now I Understand.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 5:43 am
by sec
+1 for going async.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 7:30 am
by jassing
+1 -- I had to use a combination of 3rd party to achieve proxy support.. didn't like it... just felt "wrong".

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 12:34 pm
by Golfy
I agree for proxy support.
Unfortunaly (but that's just my opinion) I think that Networks functions aren't priority for Pure Fantasy Team.
1) how to make connection if there is a proxy server between 2 purabasic apps ?
2) why it's not possible to receive email with purebasic (it's possible to send but not receive : one way communication only ?)
3) How to check if a connection still alive (before CloseNetworkConnection)
4) What about IPv6 functions ?

However, 3D functions are priority... :(

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 12:38 pm
by sec
http://www.boost.org/doc/libs/1_52_0/do ... 7/src.html

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 12:39 pm
by KGB_X
I would like HTTPS support.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 1:03 pm
by User_Russian
Golfy wrote:However, 3D functions are priority... :(
More recently, in versions 5.00 and the current, 5.10 have been updated 3D library.
IMHO, 3D is not a priority and I'm not regrets at all if excluded 3D library from PB.
The share of applications written in PB, much more than games. Therefore the game functions can not be a priority.
PureBasic primarily a tool for creating cross-platform applications.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 1:07 pm
by Fred
FYI, nginx (which is the faster webserver around) doesn't use threaded sockets, so long for the 'absolutely needed' async socket to maximize perfs..

Re: Proxy and asynchronous socket in NetworkLib

Posted: Sun Feb 03, 2013 6:43 pm
by mback2k
Aside from async network support, it would be great to have blocking support for NetworkEvent(), e.g. WaitNetworkEvent(), just like the native select() allows you to wait for multiple sockets. That would at least remove those ForEver-Delay(0)-Loops.

Without a server fully implementing multi-threaded tasks, async does not give you that much performance improvements. Blocking network with multiple sockets can be very efficient, though.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Wed Feb 06, 2013 3:38 am
by RichAlgeni
I'd have to disagree with https, or server side SSL because I am not a fan of reinventing the wheel. Besides, that would take up a tremendous amount of time for Fred and Freak. Also, nginx can be used as an SSL termination proxy, and we have shown how to use client side SSL.

Fred mentioned that nginx doesn't use sockets, and that's a good point. But what nginx does have is a way to trigger an event per socket connection, especially when multiple sockets are in use, and this is something that PureBasic is sorely missing.

While #PB_NetworkEvent_Connect needs to remain global (by that I mean not socket specific), #PB_NetworkEvent_Data and #PB_NetworkEvent_Disconnect need to be enhanced to report per socket. Perhaps two new commands should be added, so that backward compatibility is kept. This might satisfy a number of needs that are out there in regards to networking.

Re: Proxy and asynchronous socket in NetworkLib

Posted: Wed Feb 06, 2013 8:41 am
by mback2k
RichAlgeni wrote:I'd have to disagree with https, or server side SSL because I am not a fan of reinventing the wheel. Besides, that would take up a tremendous amount of time for Fred and Freak.
Yes, it would require an amount of time from Fred and Freak, but it's not that hard since there is OpenSSL on Linux, native SecureTransport on Mac OS X and native Schannel on Windows. See my following Schannel include/DLL for Windows:

Code: Select all

; Author: mback2k
EnableExplicit

Import "secur32.lib"
  AcquireCredentialsHandleW(*pszPrincipal, pszPackage.p-unicode, fCredentialUse.l, *pvLogonID, *pAuthData, *pGetKeyFn, *pvGetKeyArgument, *phCredential, *ptsExpiry)
  FreeCredentialsHandle(*phCredential)
  InitializeSecurityContextW(*phCredential, *phContext, pszTargetName.p-unicode, fContextReq.l, Reserved1.l, TargetDataRep.l, *pInput, Reserved2.l, *phNewContext, *pOutput, *pfContextAttr, *ptsExpiry)
  QueryContextAttributesW(*phContext, ulAttribute.l, *pBuffer)
  DeleteSecurityContext(*phContext)
  DecryptMessage(*phContext, *pMessage, MessageSeqNo.l, *pfQOP)
  EncryptMessage(*phContext, fQOP.l, *pMessage, MessageSeqNo.l)
  FreeContextBuffer(*pvContextBuffer)
EndImport

Structure SCHANNEL_CRED
  dwVersion.l
  cCreds.l
  *paCred
  *hRootStore
  cMappers.l
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    PB_Alignment1.b[4]
  CompilerEndIf
  *aphMappers
  cSupportedAlgs.l
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    PB_Alignment2.b[4]
  CompilerEndIf
  *palgSupportedAlgs
  grbitEnabledProtocols.l
  dwMinimumCipherStrength.l
  dwMaximumCipherStrength.l
  dwSessionLifespan.l
  dwFlags.l
  dwCredFormat.l
EndStructure

Structure SecPkgInfo
  fCapabilities.l
  wVersion.w
  wRPCID.w
  cbMaxToken.l
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    PB_Alignment.b[4]
  CompilerEndIf
  *Name
  *Comment
EndStructure

Structure SecPkgContext_StreamSizes
  cbHeader.l
  cbTrailer.l
  cbMaximumMessage.l
  cBuffers.l
  cbBlockSize.l
EndStructure

Structure SecBuffer
  cbBuffer.l
  BufferType.l
  *pvBuffer
EndStructure

Structure SecBufferDesc
  ulVersion.l
  cBuffers.l
  *pBuffers
EndStructure

Structure SecHandle
  *dwLower.Long
  *dwUpper.Long
EndStructure

Structure SecBuffers
  InBufferDesc.SecBufferDesc
  OutBufferDesc.SecBufferDesc
  InBuffers.SecBuffer[4]
  OutBuffers.SecBuffer[4]
EndStructure

Structure SecureConnection
  Magic.i
  Connection.i
  ServerName.s
  Port.i
  Protocol.i
  Flags.i
  PrevBytes.i
  PrevLength.i
  PrevSize.i
  Expiry.i
  CredHandle.SecHandle
  CtxtHandle.SecHandle
  StreamSizes.SecPkgContext_StreamSizes
EndStructure

Enumeration
  #SCHANNEL_CRED_VERSION = 4

  #SCH_CRED_NO_SERVERNAME_CHECK        = $00000004
  #SCH_CRED_MANUAL_CRED_VALIDATION     = $00000008
  #SCH_CRED_NO_DEFAULT_CREDS           = $00000010
  #SCH_CRED_AUTO_CRED_VALIDATION       = $00000020
  #SCH_CRED_REVOCATION_CHECK_END_CERT  = $00000100
  #SCH_CRED_REVOCATION_CHECK_CHAIN     = $00000200

  #SP_PROT_SSL2_CLIENT = $00000008
  #SP_PROT_SSL3_CLIENT = $00000020
  #SP_PROT_TLS1_CLIENT = $00000080
EndEnumeration

Enumeration
  #SECBUFFER_EMPTY                   = $00000000
  #SECBUFFER_VERSION                 = $00000000
  #SECBUFFER_DATA                    = $00000001
  #SECBUFFER_TOKEN                   = $00000002
  #SECBUFFER_PKG_PARAMS              = $00000003
  #SECBUFFER_MISSING                 = $00000004
  #SECBUFFER_EXTRA                   = $00000005
  #SECBUFFER_STREAM_TRAILER          = $00000006
  #SECBUFFER_STREAM_HEADER           = $00000007
  #SECBUFFER_NEGOTIATION_INFO        = $00000008
  #SECBUFFER_ALERT                   = $00000011

  #SECURITY_NATIVE_DREP              = $00000010
  #SECURITY_NETWORK_DREP             = $00000000

  #SECPKG_CRED_INBOUND               = $00000001
  #SECPKG_CRED_OUTBOUND              = $00000002
  #SECPKG_CRED_BOTH                  = $00000003

  #ISC_REQ_DELEGATE                  = $00000001
  #ISC_REQ_MUTUAL_AUTH               = $00000002
  #ISC_REQ_REPLAY_DETECT             = $00000004
  #ISC_REQ_SEQUENCE_DETECT           = $00000008
  #ISC_REQ_CONFIDENTIALITY           = $00000010
  #ISC_REQ_USE_SESSION_KEY           = $00000020
  #ISC_REQ_PROMPT_FOR_CREDS          = $00000040
  #ISC_REQ_USE_SUPPLIED_CREDS        = $00000080
  #ISC_REQ_ALLOCATE_MEMORY           = $00000100
  #ISC_REQ_USE_DCE_STYLE             = $00000200
  #ISC_REQ_DATAGRAM                  = $00000400
  #ISC_REQ_CONNECTION                = $00000800
  #ISC_REQ_CALL_LEVEL                = $00001000
  #ISC_REQ_EXTENDED_ERROR            = $00004000
  #ISC_REQ_STREAM                    = $00008000
  #ISC_REQ_INTEGRITY                 = $00010000
  #ISC_REQ_IDENTIFY                  = $00020000
  #ISC_REQ_NULL_SESSION              = $00040000

  #ASC_REQ_DELEGATE                  = $00000001
  #ASC_REQ_MUTUAL_AUTH               = $00000002
  #ASC_REQ_REPLAY_DETECT             = $00000004
  #ASC_REQ_SEQUENCE_DETECT           = $00000008
  #ASC_REQ_CONFIDENTIALITY           = $00000010
  #ASC_REQ_USE_SESSION_KEY           = $00000020
  #ASC_REQ_ALLOCATE_MEMORY           = $00000100
  #ASC_REQ_USE_DCE_STYLE             = $00000200
  #ASC_REQ_DATAGRAM                  = $00000400
  #ASC_REQ_CONNECTION                = $00000800
  #ASC_REQ_CALL_LEVEL                = $00001000
  #ASC_REQ_EXTENDED_ERROR            = $00008000
  #ASC_REQ_STREAM                    = $00010000
  #ASC_REQ_INTEGRITY                 = $00020000
  #ASC_REQ_LICENSING                 = $00040000
  #ASC_REQ_IDENTIFY                  = $00080000
  #ASC_REQ_ALLOW_NULL_SESSION        = $00100000

  #SECPKG_ATTR_SIZES                 = $00000000
  #SECPKG_ATTR_NAMES                 = $00000001
  #SECPKG_ATTR_LIFESPAN              = $00000002
  #SECPKG_ATTR_DCE_INFO              = $00000003
  #SECPKG_ATTR_STREAM_SIZES          = $00000004
  #SECPKG_ATTR_KEY_INFO              = $00000005
  #SECPKG_ATTR_AUTHORITY             = $00000006
  #SECPKG_ATTR_PROTO_INFO            = $00000007
  #SECPKG_ATTR_PASSWORD_EXPIRY       = $00000008
  #SECPKG_ATTR_SESSION_KEY           = $00000009
  #SECPKG_ATTR_PACKAGE_INFO          = $0000000A
  #SECPKG_ATTR_NATIVE_NAMES          = $0000000D

  #SEC_E_OK                          = $00000000
  #SEC_E_INSUFFICIENT_MEMORY         = $80090300
  #SEC_E_INVALID_HANDLE              = $80090301
  #SEC_E_UNSUPPORTED_FUNCTION        = $80090302
  #SEC_E_TARGET_UNKNOWN              = $80090303
  #SEC_E_INTERNAL_ERROR              = $80090304
  #SEC_E_SECPKG_NOT_FOUND            = $80090305
  #SEC_E_NOT_OWNER                   = $80090306
  #SEC_E_CANNOT_INSTALL              = $80090307
  #SEC_E_INVALID_TOKEN               = $80090308
  #SEC_E_CANNOT_PACK                 = $80090309
  #SEC_E_QOP_NOT_SUPPORTED           = $8009030A
  #SEC_E_NO_IMPERSONATION            = $8009030B
  #SEC_E_LOGON_DENIED                = $8009030C
  #SEC_E_UNKNOWN_CREDENTIALS         = $8009030D
  #SEC_E_NO_CREDENTIALS              = $8009030E
  #SEC_E_MESSAGE_ALTERED             = $8009030F
  #SEC_E_OUT_OF_SEQUENCE             = $80090310
  #SEC_E_NO_AUTHENTICATING_AUTHORITY = $80090311
  #SEC_I_CONTINUE_NEEDED             = $00090312
  #SEC_I_COMPLETE_NEEDED             = $00090313
  #SEC_I_COMPLETE_AND_CONTINUE       = $00090314
  #SEC_I_LOCAL_LOGON                 = $00090315
  #SEC_E_BAD_PKGID                   = $80090316
  #SEC_I_CONTEXT_EXPIRED             = $00090317
  #SEC_E_INCOMPLETE_MESSAGE          = $80090318
  #SEC_E_INCOMPLETE_CREDENTIALS      = $80090320
  #SEC_E_BUFFER_TOO_SMALL            = $80090321
  #SEC_I_INCOMPLETE_CREDENTIALS      = $00090320
  #SEC_I_RENEGOTIATE                 = $00090321
  #SEC_E_WRONG_PRINCIPAL             = $80090322

  #ERROR_NO_SUCH_DOMAIN              = $0000054B
  #ERROR_MORE_DATA                   = $000000EA
  #ERROR_NONE_MAPPED                 = $00000534
EndEnumeration

Procedure HandshakeSecureConnection(*SecureConnection.SecureConnection, Receive = #True)
  Protected *InBytes, InLength, InSize, ReceiveLength, OutFlags, Event, Retries, Status = #SEC_I_CONTINUE_NEEDED
  Protected Buffer.SecBuffers
  If *SecureConnection\PrevBytes And *SecureConnection\PrevLength And *SecureConnection\PrevSize
    *InBytes = AllocateMemory(*SecureConnection\PrevSize)
    InLength = *SecureConnection\PrevLength
    InSize = *SecureConnection\PrevSize
    CopyMemory(*SecureConnection\PrevBytes, *InBytes, *SecureConnection\PrevLength)
    MoveMemory(*SecureConnection\PrevBytes+*SecureConnection\PrevLength, *SecureConnection\PrevBytes, *SecureConnection\PrevLength)
    *SecureConnection\PrevLength = 0
  Else
    *InBytes = AllocateMemory(4096)
    InLength = 0
    InSize = 4096
  EndIf
  If *InBytes
    While Status = #SEC_I_CONTINUE_NEEDED Or Status = #SEC_E_INCOMPLETE_MESSAGE
      If InLength = 0 Or Status = #SEC_E_INCOMPLETE_MESSAGE
        If Receive
          If InSize-InLength < 1024
            *InBytes = ReAllocateMemory(*InBytes, InSize+4096)
            InSize + 4096
          EndIf
          Event = 0
          For Retries = 0 To 100
            Event = NetworkClientEvent(*SecureConnection\Connection)
            If Event = #PB_NetworkEvent_Data
              Break
            EndIf
            Delay(10)
          Next
          If Event = #PB_NetworkEvent_Data
            ReceiveLength = ReceiveNetworkData(*SecureConnection\Connection, *InBytes+InLength, InSize-InLength)
            If ReceiveLength > 0
              InLength + ReceiveLength
            EndIf
          EndIf
        Else
          Receive = #True
        EndIf
      EndIf
      Buffer\InBuffers[0]\pvBuffer    = *InBytes
      Buffer\InBuffers[0]\cbBuffer    = InLength
      Buffer\InBuffers[0]\BufferType  = #SECBUFFER_TOKEN
      Buffer\InBuffers[1]\pvBuffer    = #Null
      Buffer\InBuffers[1]\cbBuffer    = 0
      Buffer\InBuffers[1]\BufferType  = #SECBUFFER_EMPTY
      Buffer\InBufferDesc\cBuffers    = 2
      Buffer\InBufferDesc\pBuffers    = @Buffer\InBuffers
      Buffer\InBufferDesc\ulVersion   = #SECBUFFER_VERSION
      Buffer\OutBuffers[0]\pvBuffer   = #Null
      Buffer\OutBuffers[0]\cbBuffer   = 0;
      Buffer\OutBuffers[0]\BufferType = #SECBUFFER_TOKEN
      Buffer\OutBuffers[1]\pvBuffer   = #Null
      Buffer\OutBuffers[1]\cbBuffer   = 0
      Buffer\OutBuffers[1]\BufferType = #SECBUFFER_ALERT
      Buffer\OutBufferDesc\cBuffers   = 2
      Buffer\OutBufferDesc\pBuffers   = @Buffer\OutBuffers
      Buffer\OutBufferDesc\ulVersion  = #SECBUFFER_VERSION
      Status = InitializeSecurityContextW(@*SecureConnection\CredHandle, @*SecureConnection\CtxtHandle, *SecureConnection\ServerName, *SecureConnection\Flags, 0, #SECURITY_NATIVE_DREP, @Buffer\InBufferDesc, 0, #Null, @Buffer\OutBufferDesc, @OutFlags, @*SecureConnection\Expiry)
      If Status = #SEC_E_OK Or Status = #SEC_I_CONTINUE_NEEDED
        If Buffer\OutBuffers[0]\pvBuffer
          SendNetworkData(*SecureConnection\Connection, Buffer\OutBuffers[0]\pvBuffer, Buffer\OutBuffers[0]\cbBuffer)
          FreeContextBuffer(Buffer\OutBuffers[0]\pvBuffer)
        EndIf
      EndIf
      If Status = #SEC_E_INCOMPLETE_MESSAGE
        Continue
      EndIf
      If Status = #SEC_E_OK
        If Buffer\InBuffers[1]\BufferType = #SECBUFFER_EXTRA
          While *SecureConnection\PrevSize-*SecureConnection\PrevLength < Buffer\InBuffers[1]\cbBuffer
            *SecureConnection\PrevBytes = ReAllocateMemory(*SecureConnection\PrevBytes, *SecureConnection\PrevSize+4096)
            *SecureConnection\PrevSize + 4096
          Wend
          If CopyMemory(*InBytes+InLength-Buffer\InBuffers[1]\cbBuffer, *SecureConnection\PrevBytes+*SecureConnection\PrevLength, Buffer\InBuffers[1]\cbBuffer)
            *SecureConnection\PrevLength + Buffer\InBuffers[1]\cbBuffer
          EndIf
        EndIf
        Break
      EndIf
      If Status = #SEC_I_INCOMPLETE_CREDENTIALS
        Receive = #False
        Status = #SEC_I_CONTINUE_NEEDED
        Continue
      EndIf
      If Buffer\InBuffers[1]\BufferType = #SECBUFFER_EXTRA
        If MoveMemory(*InBytes+InLength-Buffer\InBuffers[1]\cbBuffer, *InBytes, Buffer\InBuffers[1]\cbBuffer)
          InLength = Buffer\InBuffers[1]\cbBuffer
        EndIf
      Else
        InLength = 0
      EndIf
    Wend
  EndIf
  ProcedureReturn *SecureConnection
EndProcedure

Procedure InitializeSecureConnection(*SecureConnection.SecureConnection)
  Protected SConnection, OutFlags
  Protected Buffer.SecBuffers
  Buffer\OutBuffers[0]\pvBuffer   = #Null
  Buffer\OutBuffers[0]\cbBuffer   = 0
  Buffer\OutBuffers[0]\BufferType = #SECBUFFER_TOKEN
  Buffer\OutBufferDesc\cBuffers   = 1
  Buffer\OutBufferDesc\pBuffers   = @Buffer\OutBuffers[0]
  Buffer\OutBufferDesc\ulVersion  = #SECBUFFER_VERSION
  If InitializeSecurityContextW(@*SecureConnection\CredHandle, #Null, *SecureConnection\ServerName, *SecureConnection\Flags, 0, #SECURITY_NATIVE_DREP, #Null, 0, @*SecureConnection\CtxtHandle, @Buffer\OutBufferDesc, @OutFlags, @*SecureConnection\Expiry) = #SEC_I_CONTINUE_NEEDED
    If Buffer\OutBuffers[0]\pvBuffer
      If SendNetworkData(*SecureConnection\Connection, Buffer\OutBuffers[0]\pvBuffer, Buffer\OutBuffers[0]\cbBuffer)
        SConnection = HandshakeSecureConnection(*SecureConnection)
        If SConnection
          ProcedureReturn SConnection
        EndIf
      EndIf
      FreeContextBuffer(Buffer\OutBuffers[0]\pvBuffer)
    EndIf
    If *SecureConnection\CtxtHandle
      DeleteSecurityContext(*SecureConnection\CtxtHandle)
    EndIf
  EndIf
EndProcedure

ProcedureDLL OpenSecureNetworkConnection(ServerName$, Port, Protocol = #SP_PROT_TLS1_CLIENT)
  Protected SConnection, SchannelCred.SCHANNEL_CRED, *SecureConnection.SecureConnection
  *SecureConnection = AllocateMemory(SizeOf(SecureConnection))
  If *SecureConnection
    *SecureConnection\Magic = 'SSPI'
    *SecureConnection\Connection = OpenNetworkConnection(ServerName$, Port, #PB_Network_TCP)
    If *SecureConnection\Connection
      SchannelCred\dwVersion = #SCHANNEL_CRED_VERSION
      SchannelCred\dwFlags = #SCH_CRED_NO_DEFAULT_CREDS | #SCH_CRED_AUTO_CRED_VALIDATION | #SCH_CRED_NO_SERVERNAME_CHECK | #SCH_CRED_REVOCATION_CHECK_END_CERT
      SchannelCred\grbitEnabledProtocols = Protocol
      If AcquireCredentialsHandleW(#Null, "Microsoft Unified Security Protocol Provider", #SECPKG_CRED_OUTBOUND, #Null, @SchannelCred, #Null, #Null, @*SecureConnection\CredHandle, @*SecureConnection\Expiry) = #SEC_E_OK
        *SecureConnection\ServerName = ServerName$
        *SecureConnection\Port = Port
        *SecureConnection\Protocol = SchannelCred\grbitEnabledProtocols
        *SecureConnection\Flags = #ISC_REQ_SEQUENCE_DETECT | #ISC_REQ_REPLAY_DETECT | #ISC_REQ_CONFIDENTIALITY | #ISC_REQ_EXTENDED_ERROR | #ISC_REQ_ALLOCATE_MEMORY | #ISC_REQ_STREAM
        *SecureConnection\PrevBytes = AllocateMemory(4096)
        *SecureConnection\PrevSize = 4096
        SConnection = InitializeSecureConnection(*SecureConnection)
        If SConnection
          ProcedureReturn SConnection
        EndIf
        If *SecureConnection\CredHandle
          FreeCredentialsHandle(*SecureConnection\CredHandle)
        EndIf
        If *SecureConnection\PrevBytes
          FreeMemory(*SecureConnection\PrevBytes)
        EndIf
      EndIf
      CloseNetworkConnection(*SecureConnection\Connection)
    EndIf
  EndIf
EndProcedure

ProcedureDLL CloseSecureNetworkConnection(*SecureConnection.SecureConnection)
  If *SecureConnection And *SecureConnection\Magic = 'SSPI'
    FreeCredentialsHandle(*SecureConnection\CredHandle)
    DeleteSecurityContext(*SecureConnection\CtxtHandle)
    CloseNetworkConnection(*SecureConnection\Connection)
    FreeMemory(*SecureConnection\PrevBytes)
    FreeMemory(*SecureConnection)
  EndIf
EndProcedure

ProcedureDLL ReceiveSecureNetworkData(*SecureConnection.SecureConnection, *DataBuffer, DataBufferLength)
  Protected *InBytes, InLength, InSize, ReceiveLength, OutFlags, Result, Index, Event, Retries, Receive = #True, Status = #SEC_I_CONTINUE_NEEDED
  Protected Buffer.SecBuffers
  If *SecureConnection And *SecureConnection\Magic = 'SSPI' And *DataBuffer And DataBufferLength > 0
    If *SecureConnection\PrevBytes And *SecureConnection\PrevLength And *SecureConnection\PrevSize
      *InBytes = AllocateMemory(*SecureConnection\PrevSize)
      InLength = *SecureConnection\PrevLength
      InSize = *SecureConnection\PrevSize
      CopyMemory(*SecureConnection\PrevBytes, *InBytes, *SecureConnection\PrevLength)
      MoveMemory(*SecureConnection\PrevBytes+*SecureConnection\PrevLength, *SecureConnection\PrevBytes, *SecureConnection\PrevLength)
      *SecureConnection\PrevLength = 0
    Else
      *InBytes = AllocateMemory(4096)
      InLength = 0
      InSize = 4096
    EndIf
    If *InBytes
      While Status = #SEC_I_CONTINUE_NEEDED Or Status = #SEC_E_INCOMPLETE_MESSAGE
        If InLength = 0 Or Status = #SEC_E_INCOMPLETE_MESSAGE
          If InSize-InLength < 1024
            *InBytes = ReAllocateMemory(*InBytes, InSize+4096)
            InSize + 4096
          EndIf
          Event = 0
          For Retries = 0 To 100
            Event = NetworkClientEvent(*SecureConnection\Connection)
            If Event = #PB_NetworkEvent_Data
              Break
            EndIf
            Delay(10)
          Next
          If Event = #PB_NetworkEvent_Data
            ReceiveLength = ReceiveNetworkData(*SecureConnection\Connection, *InBytes+InLength, InSize-InLength)
            If ReceiveLength > 0
              InLength + ReceiveLength
            EndIf
          EndIf
        EndIf
        Buffer\InBuffers[0]\pvBuffer     = *InBytes
        Buffer\InBuffers[0]\cbBuffer     = InLength
        Buffer\InBuffers[0]\BufferType   = #SECBUFFER_DATA
        For Index = 1 To 3
          Buffer\InBuffers[Index]\pvBuffer     = #Null
          Buffer\InBuffers[Index]\cbBuffer     = 0
          Buffer\InBuffers[Index]\BufferType   = #SECBUFFER_EMPTY
        Next
        Buffer\InBufferDesc\ulVersion    = #SECBUFFER_VERSION
        Buffer\InBufferDesc\cBuffers     = 4
        Buffer\InBufferDesc\pBuffers     = @Buffer\InBuffers[0]
        Status = DecryptMessage(@*SecureConnection\CtxtHandle, @Buffer\InBufferDesc, 0, #Null)
        If Status = #SEC_E_OK Or Status = #SEC_I_RENEGOTIATE
          If Buffer\InBuffers[1]\BufferType = #SECBUFFER_DATA
            If Result+Buffer\InBuffers[1]\cbBuffer <= DataBufferLength
              If CopyMemory(Buffer\InBuffers[1]\pvBuffer, *DataBuffer+Result, Buffer\InBuffers[1]\cbBuffer)
                Result + Buffer\InBuffers[1]\cbBuffer
              EndIf
            EndIf
          EndIf
          If Result = 0
            Status = #SEC_I_CONTINUE_NEEDED
          EndIf
        EndIf
        If Status = #SEC_E_INCOMPLETE_MESSAGE
          Continue
        EndIf
        If Status = #SEC_E_OK Or Status = #SEC_I_CONTEXT_EXPIRED
          If Buffer\InBuffers[3]\BufferType = #SECBUFFER_EXTRA
            While *SecureConnection\PrevSize-*SecureConnection\PrevLength < Buffer\InBuffers[3]\cbBuffer
              *SecureConnection\PrevBytes = ReAllocateMemory(*SecureConnection\PrevBytes, *SecureConnection\PrevSize+4096)
              *SecureConnection\PrevSize + 4096
            Wend
            If CopyMemory(*InBytes+InLength-Buffer\InBuffers[3]\cbBuffer, *SecureConnection\PrevBytes+*SecureConnection\PrevLength, Buffer\InBuffers[3]\cbBuffer)
              *SecureConnection\PrevLength + Buffer\InBuffers[3]\cbBuffer
            EndIf
          EndIf
          Break
        EndIf
        If Status = #SEC_I_RENEGOTIATE
          HandshakeSecureConnection(*SecureConnection.SecureConnection, #False)
        EndIf
        If Buffer\InBuffers[3]\BufferType = #SECBUFFER_EXTRA
          If MoveMemory(*InBytes+InLength-Buffer\InBuffers[3]\cbBuffer, *InBytes, Buffer\InBuffers[3]\cbBuffer)
            InLength = Buffer\InBuffers[3]\cbBuffer
          EndIf
        Else
          InLength = 0
        EndIf
      Wend
      ProcedureReturn Result
    EndIf
  EndIf
  ProcedureReturn -1
EndProcedure

ProcedureDLL SendSecureNetworkData(*SecureConnection.SecureConnection, *MemoryBuffer, Length)
  Protected *DataBuffer, Buffer.SecBuffers
  If *SecureConnection And *SecureConnection\Magic = 'SSPI' And *MemoryBuffer And Length > 0
    If Not *SecureConnection\StreamSizes\cbMaximumMessage
      QueryContextAttributesW(*SecureConnection\CtxtHandle, #SECPKG_ATTR_STREAM_SIZES, @*SecureConnection\StreamSizes)
    EndIf
    If Length <= *SecureConnection\StreamSizes\cbMaximumMessage
      *DataBuffer = AllocateMemory(*SecureConnection\StreamSizes\cbHeader+Length+*SecureConnection\StreamSizes\cbTrailer)
      If *DataBuffer
        Buffer\OutBuffers[0]\pvBuffer     = *DataBuffer
        Buffer\OutBuffers[0]\cbBuffer     = *SecureConnection\StreamSizes\cbHeader
        Buffer\OutBuffers[0]\BufferType   = #SECBUFFER_STREAM_HEADER
        Buffer\OutBuffers[1]\pvBuffer     = *DataBuffer+*SecureConnection\StreamSizes\cbHeader
        Buffer\OutBuffers[1]\cbBuffer     = Length
        Buffer\OutBuffers[1]\BufferType   = #SECBUFFER_DATA
        Buffer\OutBuffers[2]\pvBuffer     = *DataBuffer+*SecureConnection\StreamSizes\cbHeader+Length
        Buffer\OutBuffers[2]\cbBuffer     = *SecureConnection\StreamSizes\cbTrailer
        Buffer\OutBuffers[2]\BufferType   = #SECBUFFER_STREAM_TRAILER
        Buffer\OutBuffers[3]\pvBuffer     = #Null
        Buffer\OutBuffers[3]\cbBuffer     = 0
        Buffer\OutBuffers[3]\BufferType   = #SECBUFFER_EMPTY
        Buffer\OutBufferDesc\ulVersion    = #SECBUFFER_VERSION
        Buffer\OutBufferDesc\cBuffers     = 4
        Buffer\OutBufferDesc\pBuffers     = @Buffer\OutBuffers[0]
        If CopyMemory(*MemoryBuffer, Buffer\OutBuffers[1]\pvBuffer, Length)
          If EncryptMessage(*SecureConnection\CtxtHandle, 0, @Buffer\OutBufferDesc, 0) = #SEC_E_OK
            SendNetworkData(*SecureConnection\Connection, *DataBuffer, Buffer\OutBuffers[0]\cbBuffer+Buffer\OutBuffers[1]\cbBuffer+Buffer\OutBuffers[2]\cbBuffer)
            FreeMemory(*DataBuffer)
            ProcedureReturn Length
          EndIf
        EndIf
        FreeMemory(*DataBuffer)
      EndIf
    EndIf
  EndIf
  ProcedureReturn -1
EndProcedure

ProcedureDLL GetSecureConnectionHandle(*SecureConnection.SecureConnection)
  If *SecureConnection And *SecureConnection\Magic = 'SSPI'
    ProcedureReturn *SecureConnection\Connection
  EndIf
EndProcedure
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited