Proxy and asynchronous socket in NetworkLib
-
- Addict
- Posts: 1520
- Joined: Wed Nov 12, 2008 5:01 pm
- Location: Russia
Proxy and asynchronous socket in NetworkLib
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.
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.
-
- Addict
- Posts: 1520
- Joined: Wed Nov 12, 2008 5:01 pm
- Location: Russia
Re: Proxy and asynchronous socket in NetworkLib
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.In the current model of the network library to embed this code is not difficult.
Current syntax function OpenNetworkConnection().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.


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)
Current syntax function OpenNetworkConnection().
Code: Select all
Connection = OpenNetworkConnection(ServerName$, Port [, Mode [, TimeOut [, LocalIP$ [, LocalPort]]]])
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.
- RichAlgeni
- Addict
- Posts: 935
- Joined: Wed Sep 22, 2010 1:50 am
- Location: Bradenton, FL
Re: Proxy and asynchronous socket in NetworkLib
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).
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).
-
- Addict
- Posts: 1520
- Joined: Wed Nov 12, 2008 5:01 pm
- Location: Russia
Re: Proxy and asynchronous socket in NetworkLib
RichAlgeni, requires cross-platform code, not just for Windows.
- RichAlgeni
- Addict
- Posts: 935
- Joined: Wed Sep 22, 2010 1:50 am
- Location: Bradenton, FL
Re: Proxy and asynchronous socket in NetworkLib
Ah, ok. Now I Understand.
-
- Enthusiast
- Posts: 792
- Joined: Sat Aug 09, 2003 3:13 am
- Location: 90-61-92 // EU or ASIA
- Contact:
Re: Proxy and asynchronous socket in NetworkLib
+1 for going async.
Re: Proxy and asynchronous socket in NetworkLib
+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
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...
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...

Last edited by Golfy on Sun Feb 03, 2013 6:42 pm, edited 1 time in total.
Re: Proxy and asynchronous socket in NetworkLib
I would like HTTPS support.
-
- Addict
- Posts: 1520
- Joined: Wed Nov 12, 2008 5:01 pm
- Location: Russia
Re: Proxy and asynchronous socket in NetworkLib
More recently, in versions 5.00 and the current, 5.10 have been updated 3D library.Golfy wrote:However, 3D functions are priority...
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
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
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.
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.
- RichAlgeni
- Addict
- Posts: 935
- Joined: Wed Sep 22, 2010 1:50 am
- Location: Bradenton, FL
Re: Proxy and asynchronous socket in NetworkLib
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.
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
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: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.
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