1	#Region "Microsoft.VisualBasic::a194f3d2f3805399fb991da7477949e0, Microsoft.VisualBasic.Core\Net\Tcp\TcpServicesSocket.vb"
2
3	' Author:
4	'
5	'       asuka (amethyst.asuka@gcmodeller.org)
6	'       xie (genetics@smrucc.org)
7	'       xieguigang (xie.guigang@live.com)
8	'
9	' Copyright (c) 2018 GPL3 Licensed
10	'
11	'
12	' GNU GENERAL PUBLIC LICENSE (GPL3)
13	'
14	'
15	' This program is free software: you can redistribute it and/or modify
16	' it under the terms of the GNU General Public License as published by
17	' the Free Software Foundation, either version 3 of the License, or
18	' (at your option) any later version.
19	'
20	' This program is distributed in the hope that it will be useful,
21	' but WITHOUT ANY WARRANTY; without even the implied warranty of
22	' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23	' GNU General Public License for more details.
24	'
25	' You should have received a copy of the GNU General Public License
26	' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30	' /********************************************************************************/
31
32	' Summaries:
33
34	'     Class TcpServicesSocket
35	'
36	'         Properties: IsShutdown, LocalPort, Responsehandler, Running
37	'
38	'         Constructor: (+2 Overloads) Sub New
39	'
40	'         Function: BeginListen, IsServerInternalException, LoopbackEndPoint, (+2 Overloads) Run, ToString
41	'
42	'         Sub: AcceptCallback, (+2 Overloads) Dispose, ForceCloseHandle, HandleRequest, ReadCallback
43	'              (+2 Overloads) Send, SendCallback, WaitForStart
44	'
45	'
46	' /********************************************************************************/
47
48	#End Region
49
50	Imports System.Net
51	Imports System.Net.Sockets
52	Imports System.Reflection
53	Imports System.Runtime.CompilerServices
54	Imports System.Text
55	Imports System.Threading
56	Imports Microsoft.VisualBasic.ApplicationServices.Debugging.ExceptionExtensions
57	Imports Microsoft.VisualBasic.ComponentModel
58	Imports Microsoft.VisualBasic.Language.Default
59	Imports Microsoft.VisualBasic.Net.Abstract
60	Imports Microsoft.VisualBasic.Net.Http
61	Imports Microsoft.VisualBasic.Net.Protocols
62	Imports TcpEndPoint = System.Net.IPEndPoint
63
64	Namespace Net.Tcp
65
66	''' <summary>
67	''' Socket listening object which is running at the server side asynchronous able multiple threading.
68	''' (运行于服务器端上面的Socket监听对象，多线程模型)
69	''' </summary>
70	''' <remarks></remarks>
71	Public Class TcpServicesSocket
72	Implements IDisposable
73	Implements ITaskDriver
74	Implements IServicesSocket
75
76	#Region "INTERNAL FIELDS"
77
78	Dim _threadEndAccept As Boolean = True
79	Dim _exceptionHandle As ExceptionHandler
80	Dim _servicesSocket As Socket
81
82	#End Region
83
84	''' <summary>
85	''' The server services listening on this local port.(当前的这个服务器对象实例所监听的本地端口号)
86	''' </summary>
87	''' <value></value>
88	''' <returns></returns>
89	''' <remarks></remarks>
90	Public ReadOnly Property LocalPort As Integer Implements IServicesSocket.LocalPort
91
92	''' <summary>
93	''' This function pointer using for the data request handling of the data request from the client socket.
94	''' [Public Delegate Function DataResponseHandler(str As <see cref="String"/>, RemoteAddress As <see cref="TcpEndPoint"/>) As <see cref="String"/>]
95	''' (这个函数指针用于处理来自于客户端的请求)
96	''' </summary>
97	''' <remarks></remarks>
98	Public Property Responsehandler As DataRequestHandler Implements IServicesSocket.Responsehandler
99
100	Public ReadOnly Property IsShutdown As Boolean Implements IServicesSocket.IsShutdown
101	Get
102	Return disposedValue
103	End Get
104	End Property
105
106	Shared ReadOnly defaultHandler As New DefaultValue(Of ExceptionHandler)(AddressOf VBDebugger.PrintException)
107
108	''' <summary>
109	''' 消息处理的方法接口： Public Delegate Function DataResponseHandler(str As String, RemotePort As Integer) As String
110	''' </summary>
111	''' <param name="LocalPort">监听的本地端口号，假若需要进行端口映射的话，则可以在<see cref="Run"></see>方法之中设置映射的端口号</param>
112	''' <remarks></remarks>
113	Sub New(Optional LocalPort As Integer = 11000,
114	Optional exHandler As ExceptionHandler = Nothing)
115
116	Me._LocalPort = LocalPort
117	Me._exceptionHandle = exHandler Or defaultHandler
118	End Sub
119
120	''' <summary>
121	''' 短连接socket服务端
122	''' </summary>
123	''' <param name="DataArrivalEventHandler"></param>
124	''' <param name="localPort"></param>
125	''' <param name="exHandler"></param>
126	Sub New(DataArrivalEventHandler As DataRequestHandler, localPort%, Optional exHandler As ExceptionHandler = Nothing)
127	Me.Responsehandler = DataArrivalEventHandler
128	Me._exceptionHandle = exHandler Or defaultHandler
129	Me._LocalPort = localPort
130	End Sub
131
132	''' <summary>
133	''' 函数返回Socket的注销方法
134	''' </summary>
135	''' <param name="DataArrivalEventHandler">Public Delegate Function DataResponseHandler(str As String, RemotePort As Integer) As String</param>
136	''' <param name="LocalPort"></param>
137	''' <param name="exHandler"></param>
138	''' <returns></returns>
139	''' <remarks></remarks>
140	Public Shared Function BeginListen(DataArrivalEventHandler As DataRequestHandler,
141	Optional LocalPort As Integer = 11000,
142	Optional exHandler As ExceptionHandler = Nothing) As Action
143
144	With New TcpServicesSocket(DataArrivalEventHandler, LocalPort, exHandler)
145	Call New Action(AddressOf .Run).BeginInvoke(Nothing, Nothing)
146	Return AddressOf .Dispose
147	End With
148	End Function
149
150	<MethodImpl(MethodImplOptions.AggressiveInlining)>
151	Public Function LoopbackEndPoint(Port As Integer) As TcpEndPoint
152	Return New TcpEndPoint(System.Net.IPAddress.Loopback, Port)
153	End Function
154
155	Public Overrides Function ToString() As String
156	Return $"{GetIPAddress()}:{LocalPort}"
157	End Function
158
159	''' <summary>
160	''' This server waits for a connection and then uses  asychronous operations to
161	''' accept the connection, get data from the connected client,
162	''' echo that data back to the connected client.
163	''' It then disconnects from the client and waits for another client.(请注意，当服务器的代码运行到这里之后，代码将被阻塞在这里)
164	''' </summary>
165	''' <remarks></remarks>
166	Public Function Run() As Integer Implements ITaskDriver.Run, IServicesSocket.Run
167	' Establish the local endpoint for the socket.
168	Dim localEndPoint As TcpEndPoint = New TcpEndPoint(System.Net.IPAddress.Any, _LocalPort)
169	Return Run(localEndPoint)
170	End Function
171
172	''' <summary>
173	''' This server waits for a connection and then uses  asychronous operations to
174	''' accept the connection, get data from the connected client,
175	''' echo that data back to the connected client.
176	''' It then disconnects from the client and waits for another client.(请注意，当服务器的代码运行到这里之后，代码将被阻塞在这里)
177	''' </summary>
178	''' <remarks></remarks>
179	Public Function Run(localEndPoint As TcpEndPoint) As Integer Implements IServicesSocket.Run
180	_LocalPort = localEndPoint.Port
181	' Create a TCP/IP socket.
182	_servicesSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
183	' Bind the socket to the local endpoint and listen for incoming connections.
184
185	Try
186	Call _servicesSocket.Bind(localEndPoint)
187	Call _servicesSocket.ReceiveBufferSize.SetValue(4096000)
188	Call _servicesSocket.SendBufferSize.SetValue(4096000)
189	Call _servicesSocket.Listen(backlog:=1000)
190	Catch ex As Exception
191	Dim exMessage As String =
192	"Exception on try initialize the socket connection local_EndPoint=" & localEndPoint.ToString &
193	vbCrLf &
194	vbCrLf &
195	ex.ToString
196	Call _exceptionHandle(New Exception(exMessage, ex))
197	Throw
198	Finally
199	#If DEBUG Then
200	Call $"{MethodBase.GetCurrentMethod().GetFullName}  ==> {localEndPoint.ToString}".__DEBUG_ECHO
201	#End If
202	End Try
203	#Region ""
204	'If SelfMapping Then  '端口转发映射设置
205	'    Call Console.WriteLine("Self port mapping @wan_port={0} --->@lan_port", _LocalPort)
206	'    If Microsoft.VisualBasic.PortMapping.SetPortsMapping(_LocalPort, _LocalPort) = False Then
207	'        Call Console.WriteLine("Ports mapping is not successful!")
208	'    End If
209	'Else
210	'    If Not PortMapping < 100 Then
211	'        Call Console.WriteLine("Ports mapping wan_port={0}  ----->  lan_port={1}", PortMapping, LocalPort)
212	'        If False = SetPortsMapping(PortMapping, _LocalPort) Then
213	'            Call Console.WriteLine("Ports mapping is not successful!")
214	'        End If
215	'    End If
216	'End If
217	#End Region
218	_threadEndAccept = True
219	_Running = True
220
221	While Not Me.disposedValue
222
223	If _threadEndAccept Then
224	_threadEndAccept = False
225
226	Dim callback As New AsyncCallback(AddressOf AcceptCallback)
227	Try
228	Call _servicesSocket.BeginAccept(callback, _servicesSocket)  ' Free 之后可能会出现空引用错误，则忽略掉这个错误，退出线程
229	Catch ex As Exception
230	Call App.LogException(ex)
231	End Try
232	End If
233
234	Call Thread.Sleep(1)
235	End While
236
237	_Running = False
238
239	Return 0
240	End Function
241
242	Public ReadOnly Property Running As Boolean = False Implements IServicesSocket.IsRunning
243
244	Public Sub WaitForStart()
245	Do While Running = False
246	Call Thread.Sleep(10)
247	Loop
248	End Sub
249
250	Public Sub AcceptCallback(ar As IAsyncResult)
251	' Get the socket that handles the client request.
252	Dim listener As Socket = DirectCast(ar.AsyncState, Socket)
253
254	' End the operation.
255	Dim handler As Socket
256
257	Try
258	handler = listener.EndAccept(ar)
259	Catch ex As Exception
260	_threadEndAccept = True
261	Return
262	End Try
263
264	' Create the state object for the async receive.
265	Dim state As StateObject = New StateObject With {
266	.workSocket = handler
267	}
268
269	Try
270	Call handler.BeginReceive(state.readBuffer, 0, StateObject.BufferSize, 0, New AsyncCallback(AddressOf ReadCallback), state)
271	Catch ex As Exception
272	' 远程强制关闭主机连接，则放弃这一条数据请求的线程
273	Call ForceCloseHandle(handler.RemoteEndPoint)
274	End Try
275
276	_threadEndAccept = True
277
278	End Sub 'AcceptCallback
279
280	Private Sub ForceCloseHandle(RemoteEndPoint As EndPoint)
281	Call $"Connection was force closed by {RemoteEndPoint.ToString}, services thread abort!".__DEBUG_ECHO
282	End Sub
283
284	Private Sub ReadCallback(ar As IAsyncResult)
285	' Retrieve the state object and the handler socket
286	' from the asynchronous state object.
287	Dim state As StateObject = DirectCast(ar.AsyncState, StateObject)
288	Dim handler As Socket = state.workSocket
289	' Read data from the client socket.
290	Dim bytesRead As Integer
291
292	Try
293	' 在这里可能发生远程客户端主机强制断开连接，由于已经被断开了，
294	' 客户端已经放弃了这一次数据请求，所有在这里将这个请求线程放弃
295	bytesRead = handler.EndReceive(ar)
296	Catch ex As Exception
297	Call ForceCloseHandle(handler.RemoteEndPoint)
298	Return
299	End Try
300
301	' 有新的数据
302	If bytesRead > 0 Then
303
304	' There  might be more data, so store the data received so far.
305	state.ChunkBuffer.AddRange(state.readBuffer.Takes(bytesRead))
306	' Check for end-of-file tag. If it is not there, read
307	' more data.
308	state.readBuffer = state.ChunkBuffer.ToArray
309
310	' 得到的是原始的请求数据
311	Dim requestData As New RequestStream(state.readBuffer)
312
313	If requestData.FullRead Then
314	Call HandleRequest(handler, requestData)
315	Else
316	Try
317	' Not all data received. Get more.
318	Call handler.BeginReceive(state.readBuffer, 0, StateObject.BufferSize, 0, New AsyncCallback(AddressOf ReadCallback), state)
319	Catch ex As Exception
320	Call ForceCloseHandle(handler.RemoteEndPoint)
321	Return
322	End Try
323	End If
324	End If
325	End Sub 'ReadCallback
326
327	''' <summary>
328	''' All the data has been read from the client. Display it on the console.
329	''' Echo the data back to the client.
330	''' </summary>
331	''' <param name="handler"></param>
332	''' <param name="requestData"></param>
333	Private Sub HandleRequest(handler As Socket, requestData As RequestStream)
334	' All the data has been read from the
335	' client. Display it on the console.
336	' Echo the data back to the client.
337	Dim remoteEP = DirectCast(handler.RemoteEndPoint, TcpEndPoint)
338
339	Try
340	If requestData.IsPing Then
341	requestData = NetResponse.RFC_OK
342	Else
343	requestData = Me.Responsehandler()(requestData, remoteEP)
344	End If
345	Call Send(handler, requestData)
346	Catch ex As Exception
347	Call _exceptionHandle(ex)
348	' 错误可能是内部处理请求的时候出错了，则将SERVER_INTERNAL_EXCEPTION结果返回给客户端
349	Try
350	Call Send(handler, NetResponse.RFC_INTERNAL_SERVER_ERROR)
351	Catch ex2 As Exception
352	' 这里处理的是可能是强制断开连接的错误
353	Call _exceptionHandle(ex2)
354	End Try
355	End Try
356	End Sub
357
358	''' <summary>
359	''' Server reply the processing result of the request from the client.
360	''' </summary>
361	''' <param name="handler"></param>
362	''' <param name="data"></param>
363	''' <remarks></remarks>
364	Private Sub Send(handler As Socket, data As String)
365	' Convert the string data to byte data using ASCII encoding.
366	Dim byteData As Byte() = Encoding.UTF8.GetBytes(data)
367	byteData = New RequestStream(0, 0, byteData).Serialize
368	' Begin sending the data to the remote device.
369	Call handler.BeginSend(byteData, 0, byteData.Length, 0, New AsyncCallback(AddressOf SendCallback), handler)
370	End Sub 'Send
371
372	Private Sub Send(handler As Socket, data As RequestStream)
373	' Convert the string data to byte data using ASCII encoding.
374	Dim byteData As Byte() = data.Serialize
375	' Begin sending the data to the remote device.
376	Call handler.BeginSend(byteData, 0, byteData.Length, 0, New AsyncCallback(AddressOf SendCallback), handler)
377	End Sub
378
379	Private Sub SendCallback(ar As IAsyncResult)
380	' Retrieve the socket from the state object.
381	Dim handler As Socket = DirectCast(ar.AsyncState, Socket)
382	' Complete sending the data to the remote device.
383	Dim bytesSent As Integer = handler.EndSend(ar)
384
385	Call handler.Shutdown(SocketShutdown.Both)
386	Call handler.Close()
387	End Sub 'SendCallback
388
389	''' <summary>
390	''' SERVER_INTERNAL_EXCEPTION，Server encounter an internal exception during processing
391	''' the data request from the remote device.
392	''' (判断是否服务器在处理客户端的请求的时候，发生了内部错误)
393	''' </summary>
394	''' <param name="replyData"></param>
395	''' <returns></returns>
396	''' <remarks></remarks>
397	'''
398	<MethodImpl(MethodImplOptions.AggressiveInlining)>
399	Public Shared Function IsServerInternalException(replyData As String) As Boolean
400	Return String.Equals(replyData, NetResponse.RFC_INTERNAL_SERVER_ERROR.GetUTF8String)
401	End Function
402
403	#Region "IDisposable Support"
404
405	''' <summary>
406	''' 退出监听线程所需要的
407	''' </summary>
408	''' <remarks></remarks>
409	Private disposedValue As Boolean = False  ' To detect redundant calls
410
411	' IDisposable
412	Protected Overridable Sub Dispose(disposing As Boolean)
413	If Not Me.disposedValue Then
414	If disposing Then
415
416	Call _servicesSocket.Dispose()
417	Call _servicesSocket.Free()
418	' TODO: dispose managed state (managed objects).
419	End If
420
421	' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
422	' TODO: set large fields to null.
423	End If
424	Me.disposedValue = True
425	End Sub
426
427	' TODO: override Finalize() only if Dispose(      disposing As Boolean) above has code to free unmanaged resources.
428	'Protected Overrides Sub Finalize()
429	'    ' Do not change this code.  Put cleanup code in Dispose(      disposing As Boolean) above.
430	'    Dispose(False)
431	'    MyBase.Finalize()
432	'End Sub
433
434	' This code added by Visual Basic to correctly implement the disposable pattern.
435
436	''' <summary>
437	''' Stop the server socket listening threads.(终止服务器Socket监听线程)
438	''' </summary>
439	''' <remarks></remarks>
440	Public Sub Dispose() Implements IDisposable.Dispose
441	' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
442	Dispose(True)
443	GC.SuppressFinalize(Me)
444	End Sub
445	#End Region
446
447	End Class
448	End Namespace