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 OverloadsSub 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 IntegerAs 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 IntegerAs 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 = NothingAs 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 IntegerAs 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 StringAs 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