1 #Region "Microsoft.VisualBasic::e2bedcdf5e58f2ae305d7fadc4f32379, Microsoft.VisualBasic.Core\ApplicationServices\Tools\Network\Tcp\Persistent\MessagePushServices\User.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 USER
35     
36     '         Properties: USER_ID
37     
38     '         Constructor: (+4 OverloadsSub New
39     
40     '         Function: __receiveBroadcastMessage, (+3 Overloads) __sendMessage, __sendMessageToMe, IsUserOnLine, (+4 Overloads) SendMessage
41     '                   ToString
42     
43     '         Sub: (+2 Overloads) BeginConnect, (+2 Overloads) BroadCastMessage, (+2 Overloads) Dispose, SetDisconnectHandle
44     
45     
46     ' /********************************************************************************/
47
48 #End Region
49
50 Imports System.Text
51 Imports System.Threading
52 Imports Microsoft.VisualBasic.Net.Http
53 Imports Microsoft.VisualBasic.Net.Persistent.Application.Protocols
54 Imports Microsoft.VisualBasic.Net.Protocols
55 Imports Microsoft.VisualBasic.Net.Protocols.Reflection
56 Imports Microsoft.VisualBasic.Parallel
57
58 Namespace Net.Persistent.Application
59
60     ''' <summary>
61     ''' 服务器也相当于一个USER,只不过服务器的UID为0,即最高级的用户
62     ''' </summary>
63     ''' 
64     <Protocol(GetType(ServicesProtocol.Protocols))>
65     Public Class USER : Implements System.IDisposable
66
67         Public ReadOnly Property USER_ID As Long
68
69         Friend remotePort As Integer, remoteHost As String
70         Dim __exceptionHandler As Abstract.ExceptionHandler
71         Dim _requestHandler As ProtocolHandler
72
73         ''' <summary>
74         ''' 
75         ''' </summary>
76         ''' <param name="HostName"></param>
77         ''' <param name="RemotePort"></param>
78         ''' <param name="ID"></param>
79         ''' <param name="DataRequestHandle">使用这个函数来获取外部发送过来的用户消息</param>
80         ''' <param name="ExceptionHandler"></param>
81         Sub New(HostName As String,
82                 RemotePort As Integer,
83                 ID As Long,
84                 DataRequestHandle As PushMessage,
85                 Optional ExceptionHandler As Abstract.ExceptionHandler = Nothing)
86
87             Me.remoteHost = HostName
88             Me.USER_ID = ID
89             Me.remotePort = RemotePort
90             Me.__dataRequestHandle = DataRequestHandle
91             Me._requestHandler = New ProtocolHandler(Me)
92         End Sub
93
94         Sub New(services As System.Net.IPEndPoint, ID As Long, DataRequestHandle As PushMessage, Optional ExceptionHandler As Abstract.ExceptionHandler = Nothing)
95             Call Me.New(New IPEndPoint(services), ID, DataRequestHandle, ExceptionHandler)
96         End Sub
97
98         Sub New(services As IPEndPoint, ID As Long, DataRequestHandle As PushMessage, Optional ExceptionHandler As Abstract.ExceptionHandler = Nothing)
99             Call Me.New(services.IPAddress, services.Port, ID, DataRequestHandle, ExceptionHandler)
100         End Sub
101
102         Sub New(post As UserId, DataRequestHandle As PushMessage, Optional ExceptionHandler As Abstract.ExceptionHandler = Nothing)
103             Call Me.New(post.Remote.IPAddress, post.Remote.Port, post.uid, DataRequestHandle, ExceptionHandler)
104         End Sub
105
106         Dim __dataRequestHandle As PushMessage
107         Dim _pcnnSocket As Socket.PersistentClient
108
109         Public Sub SetDisconnectHandle(handle As MethodInvoker)
110             Try
111                 _pcnnSocket.RemoteServerShutdown = handle
112             Catch ex As Exception
113                 ' 可能是在socket还没有启动的时候就设置句柄了,导致空引用,不过这个没有太多的影响,忽略这个错误
114             End Try
115         End Sub
116
117         ''' <summary>
118         ''' 请注意,线程会在这里阻塞
119         ''' </summary>
120         ''' <param name="ForceCloseConnection">远程主机强制关闭连接之后触发这个动作</param>
121         Public Sub BeginConnect(Optional ForceCloseConnection As MethodInvoker = NothingOptional CA As Net.SSL.Certificate = Nothing)
122             Dim remoteEp As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Parse(Me.remoteHost), Me.remotePort)
123             Dim request As RequestStream = ServicesProtocol.GetServicesConnection
124
125             Call $"Begin connect to {remoteEp.ToString}".__DEBUG_ECHO
126             If CA Is Nothing Then
127                 request = New Net.AsynInvoke(remoteEp).SendMessage(request)
128             Else
129                 request = New Net.AsynInvoke(remoteEp).SendMessage(request, CA)
130             End If
131
132             Dim port As Integer = CInt(Val(request.GetUTF8String))
133
134             Me._pcnnSocket = New Socket.PersistentClient(Me.remoteHost, port, Me.__exceptionHandler)
135             Me._pcnnSocket.RemoteServerShutdown = ForceCloseConnection
136             Me._pcnnSocket.Responsehandler = AddressOf Me._requestHandler.HandleRequest
137
138             Call RunTask(AddressOf Me._pcnnSocket.BeginConnect)
139             Call Me._pcnnSocket.WaitForConnected()
140             Call Thread.Sleep(1000)
141             Call Me._pcnnSocket.WaitForHash()
142
143             request = ServicesProtocol.LogOnRequest(Me.USER_ID, Me._pcnnSocket.OnServerHashCode)
144             If CA Is Nothing Then
145                 request = __sendMessage(request)
146             Else
147                 request = CA.Encrypt(request)
148                 request = __sendMessage(request)
149                 request = CA.Decrypt(request)
150             End If
151
152             If Not request.Protocol = HTTP_RFC.RFC_OK Then
153                 '连接不成功
154                 Throw New Exception(NetResponse.RFC_BAD_REQUEST.GetUTF8String)
155             End If
156
157             Do While Not Me.disposedValue
158                 Call Thread.Sleep(1000)
159             Loop
160         End Sub
161
162         ''' <summary>
163         ''' 不会发生阻塞
164         ''' </summary>
165         ''' <param name="ForceCloseConnection">远程主机强制关闭连接之后触发这个动作</param>
166         Public Sub BeginConnect(CA As Net.SSL.Certificate, Optional ForceCloseConnection As MethodInvoker = Nothing)
167             Call RunTask(Sub() Call BeginConnect(ForceCloseConnection, CA))
168         End Sub
169
170         ''' <summary>
171         ''' 
172         ''' </summary>
173         ''' <param name="CA"></param>
174         ''' <param name="request"></param>
175         ''' <param name="remote">由于数据都是通过中心服务器转发的,所以这个已经没有存在的意义了,但是为了和短连接的socket的数据处理接口保持兼容,所以还保留这个参数</param>
176         ''' <returns></returns>
177         <Protocol(ServicesProtocol.Protocols.SendMessage)>
178         Private Function __sendMessageToMe(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
179             Dim post As New SendMessagePost(request.ChunkBuffer)
180             Return Me.__dataRequestHandle(post.FROM, post.Message)
181         End Function
182
183         <Protocol(ServicesProtocol.Protocols.Broadcast)>
184         Private Function __receiveBroadcastMessage(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
185             Return Me.__dataRequestHandle(CA, request)
186         End Function
187
188         Private Function __sendMessage(Message As StringAs String
189 #If DEBUG Then
190             Call Console.WriteLine($" * >> {NameOf(__sendMessage)}   {Message}")
191 #End If
192             Dim reply As String = New Net.AsynInvoke(Me.remoteHost, Me.remotePort, Me.__exceptionHandler).SendMessage(Message)
193             Return reply
194         End Function
195
196         Private Function __sendMessage(Message As Byte()) As Byte()
197             Dim reply = New Net.AsynInvoke(Me.remoteHost, Me.remotePort, Me.__exceptionHandler).SendMessage(Message)
198             Return reply
199         End Function
200
201         Private Function __sendMessage(request As RequestStream) As RequestStream
202             Return New RequestStream(__sendMessage(request.Serialize))
203         End Function
204
205         ''' <summary>
206         ''' True标识发送成功,False标识用户离线
207         ''' </summary>
208         ''' <param name="USER_ID"></param>
209         ''' <param name="Message">在发送之前请对消息进行加密处理</param>
210         ''' <returns></returns>
211         Public Function SendMessage(USER_ID As LongMessage As RequestStream) As Boolean
212             Dim request = ServicesProtocol.SendMessageRequest(Me.USER_ID, USER_ID, Message)
213             Return SendMessage(request)
214         End Function
215
216         Public Function SendMessage(USER_ID As LongMessage As RequestStream, CA As SSL.Certificate) As Boolean
217             Dim request = ServicesProtocol.SendMessageRequest(Me.USER_ID, USER_ID, Message)
218             request = CA.Encrypt(request)
219             Return SendMessage(request)
220         End Function
221
222         Public Function SendMessage(Message As RequestStream) As Boolean
223             Dim bytesData = Message.Serialize
224             bytesData = __sendMessage(bytesData)
225             If RequestStream.IsAvaliableStream(bytesData) Then
226                 Message = New RequestStream(bytesData)
227                 Return Message.Protocol = HTTP_RFC.RFC_OK
228             Else
229                 Return System.Text.Encoding.UTF8.GetString(bytesData).ParseBoolean
230             End If
231         End Function
232
233         Public Function SendMessage(Message As RequestStream, CA As SSL.Certificate, Optional isPublicToken As Boolean = FalseAs Boolean
234             Dim byteData = If(isPublicToken, CA.PublicEncrypt(Message), CA.Encrypt(Message)).Serialize
235             byteData = __sendMessage(byteData)
236             If RequestStream.IsAvaliableStream(byteData) Then
237                 Message = New RequestStream(byteData)
238
239                 If Message.IsSSLProtocol Then
240                     Message = CA.Decrypt(Message)
241                 Else
242                     Return CA.DecryptString(Message.GetUTF8String).ParseBoolean
243                 End If
244
245                 Return Message.GetUTF8String.ParseBoolean
246             Else
247                 Return Encoding.UTF8.GetString(byteData).ParseBoolean
248             End If
249         End Function
250
251         Public Sub BroadCastMessage(Message As RequestStream)
252             Dim request As RequestStream = ServicesProtocol.BroadcastMessage(Me.USER_ID, Message)
253             request = __sendMessage(request)
254         End Sub
255
256         Public Sub BroadCastMessage(Message As RequestStream, CA As SSL.Certificate)
257             Dim request As RequestStream = ServicesProtocol.BroadcastMessage(Me.USER_ID, Message)
258             request = CA.Encrypt(request)
259             Call SendMessage(request)
260         End Sub
261
262         Public Function IsUserOnLine(USER_ID As LongAs Boolean
263             Dim request As RequestStream = ServicesProtocol.IsUserOnlineRequest(USER_ID)
264             request = __sendMessage(request)
265             Return request.Protocol = HTTP_RFC.RFC_OK
266         End Function
267
268         Public Overrides Function ToString() As String
269             Return USER_ID
270         End Function
271
272 #Region "IDisposable Support"
273         Private disposedValue As Boolean To detect redundant calls
274
275         ' IDisposable
276         Protected Overridable Sub Dispose(disposing As Boolean)
277             If Not disposedValue Then
278                 If disposing Then
279
280                     ' TODO: dispose managed state (managed objects).
281                 End If
282
283                 ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
284                 ' TODO: set large fields to null.
285             End If
286             disposedValue = True
287         End Sub
288
289         ' TODO: override Finalize() only if Dispose(disposing As Boolean) above has code to free unmanaged resources.
290         'Protected Overrides Sub Finalize()
291         '    ' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
292         '    Dispose(False)
293         '    MyBase.Finalize()
294         'End Sub
295
296         ' This code added by Visual Basic to correctly implement the disposable pattern.
297         Public Sub Dispose() Implements IDisposable.Dispose
298             Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
299             Dispose(True)
300             ' TODO: uncomment the following line if Finalize() is overridden above.
301             ' GC.SuppressFinalize(Me)
302         End Sub
303 #End Region
304     End Class
305 End Namespace