forked from huggle/huggle
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathIrc.vb
450 lines (351 loc) · 22.2 KB
/
Irc.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
'This is a source code or part of Huggle project
'Copyright (C) 2011 Huggle team
'This program is free software: you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation, either version 3 of the License, or
'(at your option) any later version.
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'GNU General Public License for more details.
Imports System.IO
Imports System.Net.Sockets
Imports System.Text.RegularExpressions
Imports System.Threading
Module Irc
Private Connecting, Connected, Reconnecting, Disconnecting As Boolean
Public IrcThread As Thread
Private IrcTimer As Timer
Public Sub IrcConnect()
Config.IrcMode = True
IrcTimer = New Timer(AddressOf IrcTimer_Tick, Nothing, Config.IrcConnectionTimeout, Timeout.Infinite)
Reconnecting = False
Disconnecting = False
IrcThread = New Thread(AddressOf IrcProcess)
IrcThread.IsBackground = True
IrcThread.Name = "irc"
IrcThread.Start()
End Sub
Dim EditMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07([^]*)14\]\]4 (M?)(B?)10 02.*di" & _
"ff=([^&]*)&oldid=([^]*) 5\* 03([^]*) 5\* \(?([^]*)?\) 10([^]*)?", RegexOptions.Compiled)
Dim NewPageMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07([^]*)14\]\]4 .*N(M?)(B?)" & _
"10 02[^ ]* 5\* 03([^]*) 5\* \(([^\)]*)\) 10([^]*)", RegexOptions.Compiled)
Dim BlockMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/block14\]\]4 block" & _
"10 02 5\* 03([^]*) 5\* 10blocked User:([^]*?) \(([^\)]*)\) with an expiry time of ([^:]*?): " & _
"([^]*?)", RegexOptions.Compiled)
Dim ReblockMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/block14\]\]4 reblock" & _
"10 02 5\* 03([^]*) 5\* 10changed block settings for \[\[02User:([^]*?)10\]\] " & _
"with an expiry time of ([^:]*?) \(([^\)]*)\): ([^]*?)", RegexOptions.Compiled)
Dim UnblockMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/block14\]\]4 unblock" & _
"10 02 5\* 03([^]*) 5\* 10unblocked ""User:([^]*?)""(?:: ([^]*))??", _
RegexOptions.Compiled)
Dim DeleteMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/delete14\]\]4 delete" & _
"10 02 5\* 03([^]*) 5\* 10deleted ""\[\[02([^]*)10\]\]""(?:: ([^]*))?", _
RegexOptions.Compiled)
Dim RestoreMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/delete" & _
"14\]\]4 restore10 02 5\* 03([^]*) 5\* 10restored ""\[\[02([^]*)10\]\]""" & _
": ([^]*)?", RegexOptions.Compiled)
Dim MoveMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/move" & _
"14\]\]4 move(?:_redir)?10 02 5\* 03([^]*?) 5\* 10moved \[\[02([^]*?)10\]\] to " & _
"\[\[([^\]]*)\]\](?: over redirect)?(: ([^]*))?", RegexOptions.Compiled)
Dim NewUserMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/newusers" & _
"14\]\]4 create10 02 5\* 03([^]*?) 5\* 10[Nn]ew user account", RegexOptions.Compiled)
Dim CreateUserMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/newusers" & _
"14\]\]4 create210 02 5\* 03([^]*?) 5\* 10created new account User:([^]*)", _
RegexOptions.Compiled)
Dim UploadMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/upload" & _
"14\]\]4 upload10 02 5\* 03([^]*) 5\* 10uploaded ""\[\[02([^]*?)10\]\]""" & _
"(: ([^]*))??", RegexOptions.Compiled)
Dim OverwriteMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/upload" & _
"14\]\]4 overwrite10 02 5\* 03([^]*) 5\* 10uploaded a new version of """ & _
"\[\[02([^]*)10\]\]""(?:: )?([^]*)?", RegexOptions.Compiled)
Dim ProtectMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/protect14\]\]4 " & _
"protect10 02 5\* 03([^]*) 5\* 10protected ([^\[]*)(?:\[edit=([a-z]*)\] \(([^\)]*\)" & _
"?)\))?(?:\[move=([a-z]*)\] \(([^\)]*\)?)\))?(?:\[create=([a-z]*)\] \(([^\)]*\)?)\))?(?:: ([^^C]*))??", _
RegexOptions.Compiled)
Dim ModifyMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/protect14\]\]4 " & _
"modify10 02 5\* 03([^]*) 5\* 10changed protection level for ""\[\[02([^]*)10\]\]""(?: " & _
"\[edit=([a-z]*)\] \(([^\)]*\)?)\))?(?: \[move=([a-z]*)\] \(([^\)]*\)?)\))?(?: \[create=([a-z]*)\] " & _
"\(([^\)]*\)?)\))?(?:: ([^^C]*))??", RegexOptions.Compiled)
Dim UnprotectMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/protect" & _
"14\]\]4 unprotect10 02 5\* 03([^]*) 5\* 10unprotected ([^]*): ([^]*)?", _
RegexOptions.Compiled)
Dim RenameUserMatch As New Regex(":rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/renameuser" & _
"14\]\]4 renameuser10 02 5\* 03([^]*) 5\* 10renamed ([^ ]*) to ""([^""]*)"": " & _
"(?:[^\.]*)\. Reason: ([^]*)", RegexOptions.Compiled)
Dim UserRightsMatch As New Regex("rc-pmtpa!~rc-pmtpa@[^ ]* PRIVMSG #[^:]*:14\[\[07Special:Log/rights14\]\]4 rights" & _
"10 02 5\* 03([^]*) 5\* 10changed rights for User:(.*) from ([^:]*) to ([^:.]*): " & _
"([^]*)", RegexOptions.Compiled)
Private Sub IrcProcess()
If Config.IrcServer Is Nothing Then Exit Sub
If Config.IrcServerName Is Nothing Then Exit Sub
Connecting = True
Log(Msg("irc-connecting"))
'Username in RC feed IRC channels is "h_" followed by random 6-digit number
Config.IrcUsername = "h_" & New Random(Date.UtcNow.Millisecond).NextDouble.ToString.Substring(2, 6)
Try
Dim Stream As NetworkStream = New TcpClient(Config.IrcServer, Config.IrcPort).GetStream
Dim Reader As New StreamReader(Stream, System.Text.Encoding.UTF8)
Dim Writer As New StreamWriter(Stream)
Writer.WriteLine("USER " & Config.IrcUsername & " 8 * :" & Config.IrcUsername)
Writer.WriteLine("NICK " & Config.IrcUsername)
Writer.WriteLine("JOIN " & Config.IrcChannel)
Writer.Flush()
Dim Message As String = ""
While True
While Not Reader.EndOfStream
Message = Reader.ReadLine
If Message.StartsWith("ERROR ") Then
'If returns an error then...
IrcLog(Msg("irc-disconnected"))
Reconnecting = True
ElseIf Message.StartsWith(":" & Config.IrcServerName & " 001") AndAlso Not Connected Then
' :irc.pmtpa.wikimedia.org 001 Sidonuke :Welcome to the Wikimedia Internet Relay Chat Network Sidonuke
Connected = True
Connecting = False
IrcLog(Msg("irc-connected"))
ElseIf Message.StartsWith(Config.IrcServerName & " :No such channel") Then
' irc.pmtpa.wikimedia.org :No such channel
IrcLog(Msg("irc-nochannel", Config.IrcChannel))
Config.IrcMode = False
Disconnecting = True
ElseIf Message.StartsWith("PING ") Then
'If its a ping request then pong it back
Writer.WriteLine("PONG " & Message.Substring(5))
Writer.Flush()
ElseIf EditMatch.IsMatch(Message) Then
'If the line hits the edit regex then...
Dim NewEdit As New Edit
Dim Match As Match = EditMatch.Match(Message)
NewEdit.Page = GetPage(Match.Groups(1).Value)
NewEdit.User = GetUser(Match.Groups(6).Value)
NewEdit.Bot = Not String.IsNullOrEmpty(Match.Groups(3).Value)
NewEdit.Id = Match.Groups(4).Value
NewEdit.Oldid = Match.Groups(5).Value
NewEdit.Change = CInt(Match.Groups(7).Value)
NewEdit.Summary = Match.Groups(8).Value
If Config.SlowIRC = True Then
Thread.Sleep(100)
End If
Callback(AddressOf ProcessIrcEdit, CObj(NewEdit))
ElseIf NewPageMatch.Match(Message).Success Then
'If the line hits the new page regex then...
Dim NewEdit As New Edit
Dim Match As Match = NewPageMatch.Match(Message)
NewEdit.Page = GetPage(Match.Groups(1).Value)
NewEdit.User = GetUser(Match.Groups(4).Value)
NewEdit.Bot = Not String.IsNullOrEmpty(Match.Groups(3).Value)
NewEdit.Id = "cur"
NewEdit.Oldid = "-1"
NewEdit.Change = CInt(Match.Groups(5).Value)
NewEdit.Summary = Match.Groups(6).Value
NewEdit.Prev = NullEdit
NewEdit.NewPage = True
Callback(AddressOf ProcessIrcEdit, CObj(NewEdit))
'ElseIf NewUserMatch.IsMatch(Message) Then
'Dim Match As Match = NewUserMatch.Match(Message)
ElseIf DeleteMatch.IsMatch(Message) Then
'If the line hits the delete regex then...
Dim NewDelete As New Delete
Dim Match As Match = DeleteMatch.Match(Message)
NewDelete.Time = Date.UtcNow
NewDelete.Admin = GetUser(Match.Groups(1).Value)
NewDelete.Page = GetPage(Match.Groups(2).Value)
NewDelete.Action = "delete"
NewDelete.Comment = Match.Groups(3).Value
Callback(AddressOf ProcessDelete, CObj(NewDelete))
ElseIf BlockMatch.IsMatch(Message) Then
'If the line hits the block regex then...
Dim NewBlock As New Block
Dim Match As Match = BlockMatch.Match(Message)
NewBlock.Time = Date.UtcNow
NewBlock.Admin = GetUser(Match.Groups(1).Value)
NewBlock.User = GetUser(Match.Groups(2).Value)
NewBlock.Options = Match.Groups(3).Value
NewBlock.Duration = Match.Groups(4).Value
NewBlock.Action = "block"
NewBlock.Comment = Match.Groups(5).Value
Callback(AddressOf ProcessBlock, CObj(NewBlock))
ElseIf ReblockMatch.IsMatch(Message) Then
'If the line hits the reblock regex then...
Dim NewBlock As New Block
Dim Match As Match = BlockMatch.Match(Message)
NewBlock.Time = Date.UtcNow
NewBlock.Admin = GetUser(Match.Groups(1).Value)
NewBlock.User = GetUser(Match.Groups(2).Value)
NewBlock.Options = Match.Groups(4).Value
NewBlock.Duration = Match.Groups(3).Value
NewBlock.Action = "reblock"
NewBlock.Comment = Match.Groups(5).Value
Callback(AddressOf ProcessBlock, CObj(NewBlock))
ElseIf MoveMatch.IsMatch(Message) Then
'If the line hits the move regex then...
Dim NewPageMove As New PageMove
Dim Match As Match = MoveMatch.Match(Message)
NewPageMove.Time = Date.UtcNow
NewPageMove.User = GetUser(Match.Groups(1).Value)
NewPageMove.Source = Match.Groups(2).Value
NewPageMove.Destination = Match.Groups(3).Value
NewPageMove.Summary = Match.Groups(5).Value
Callback(AddressOf ProcessPageMove, CObj(NewPageMove))
ElseIf RestoreMatch.IsMatch(Message) Then
'If the line hits the restore regex then...
Dim NewRestore As New Delete
Dim Match As Match = NewPageMatch.Match(Message)
NewRestore.Time = Date.UtcNow
NewRestore.Admin = GetUser(Match.Groups(1).Value)
NewRestore.Page = GetPage(Match.Groups(2).Value)
NewRestore.Action = "restore"
NewRestore.Comment = Match.Groups(3).Value
Callback(AddressOf ProcessRestore, CObj(NewRestore))
ElseIf UnblockMatch.IsMatch(Message) Then
'If the line hits the unblock regex then...
Dim NewUnblock As New Block
Dim Match As Match = UnblockMatch.Match(Message)
NewUnblock.Time = Date.UtcNow
NewUnblock.Admin = GetUser(Match.Groups(1).Value)
NewUnblock.User = GetUser(Match.Groups(2).Value)
NewUnblock.Options = Match.Groups(3).Value
NewUnblock.Duration = Match.Groups(4).Value
NewUnblock.Action = "unblock"
NewUnblock.Comment = Match.Groups(5).Value
Callback(AddressOf ProcessBlock, CObj(NewUnblock))
ElseIf UploadMatch.IsMatch(Message) Then
'If the line hits the unblock regex then...
Dim NewUpload As New Upload
Dim Match As Match = UploadMatch.Match(Message)
NewUpload.Time = Date.UtcNow
NewUpload.User = GetUser(Match.Groups(1).Value)
NewUpload.File = GetPage(Match.Groups(2).Value)
NewUpload.Summary = Match.Groups(3).Value
Callback(AddressOf ProcessUpload, CObj(NewUpload))
ElseIf ProtectMatch.IsMatch(Message) Then
'If the line hits the protect regex then...
Dim NewProtection As New Protection
Dim Match As Match = ProtectMatch.Match(Message)
NewProtection.Admin = GetUser(Match.Groups(1).Value)
NewProtection.Page = GetPage(Match.Groups(2).Value)
NewProtection.EditLevel = Match.Groups(3).Value
NewProtection.EditExpiry = ProcessExpiry(Match.Groups(4).Value)
NewProtection.MoveLevel = Match.Groups(5).Value
NewProtection.MoveExpiry = ProcessExpiry(Match.Groups(6).Value)
NewProtection.CreateLevel = Match.Groups(7).Value
NewProtection.CreateExpiry = ProcessExpiry(Match.Groups(8).Value)
NewProtection.Summary = Match.Groups(9).Value
Callback(AddressOf ProcessProtection, CObj(NewProtection))
ElseIf ModifyMatch.IsMatch(Message) Then
'If the line hits the protection modify regex then...
Dim NewProtection As New Protection
Dim Match As Match = ModifyMatch.Match(Message)
NewProtection.Admin = GetUser(Match.Groups(1).Value)
NewProtection.Page = GetPage(Match.Groups(2).Value)
NewProtection.EditLevel = Match.Groups(3).Value
NewProtection.EditExpiry = ProcessExpiry(Match.Groups(4).Value)
NewProtection.MoveLevel = Match.Groups(5).Value
NewProtection.MoveExpiry = ProcessExpiry(Match.Groups(6).Value)
NewProtection.CreateLevel = Match.Groups(7).Value
NewProtection.CreateExpiry = ProcessExpiry(Match.Groups(8).Value)
NewProtection.Summary = Match.Groups(9).Value
Callback(AddressOf ProcessProtection, CObj(NewProtection))
ElseIf UnprotectMatch.IsMatch(Message) Then
'If the line hits the unprotect regex then...
Dim NewProtection As New Protection
Dim Match As Match = ProtectMatch.Match(Message)
NewProtection.Admin = GetUser(Match.Groups(1).Value)
NewProtection.Page = GetPage(Match.Groups(2).Value)
NewProtection.Summary = Match.Groups(3).Value
Callback(AddressOf ProcessProtection, CObj(NewProtection))
ElseIf OverwriteMatch.IsMatch(Message) Then
'If the line hits the new upload regex then...
Dim NewUpload As New Upload
Dim Match As Match = OverwriteMatch.Match(Message)
NewUpload.Time = Date.UtcNow
NewUpload.User = GetUser(Match.Groups(1).Value)
NewUpload.File = GetPage(Match.Groups(2).Value)
NewUpload.Summary = Match.Groups(3).Value
Callback(AddressOf ProcessUpload, CObj(NewUpload))
'ElseIf CreateUserMatch.IsMatch(Message) Then
'Dim Match As Match = CreateUserMatch.Match(Message)
' ElseIf RenameUserMatch.IsMatch(Message) Then
'Dim Match As Match = RenameUserMatch.Match(Message)
'ElseIf UserRightsMatch.IsMatch(Message) Then
'Dim Match As Match = UserRightsMatch.Match(Message)
End If
If Disconnecting Then
'To disconnect
Connecting = False
Disconnecting = False
Reconnecting = False
Reader.Close()
Writer.Close()
Stream.Close()
Connected = False
Exit Sub
ElseIf Reconnecting Then
'To reconnect
Reconnecting = False
Disconnecting = False
Reader.Close()
Writer.Close()
Stream.Close()
Connected = False
Callback(AddressOf IrcConnect)
Exit Sub
End If
Thread.Sleep(50)
End While
Thread.Sleep(50)
End While
Catch ex As SocketException
'Server didn't like the connection; give up
IrcLog(Msg("irc-error"))
Connecting = False
Config.IrcMode = False
Catch ex As System.Runtime.InteropServices.COMException
Log("error in parsing data")
'Exit Sub
Catch ex As IOException
'Feed was disconnected; retry
IrcLog(Msg("irc-disconnected"))
Callback(AddressOf IrcConnect)
End Try
End Sub
Private Sub IrcTimer_Tick(ByVal O As Object)
If Connecting Then
'No error but connection not established; IRC is probably being intercepted by a firewall
'Abort thread and fall back to API queries
IrcThread.Abort()
IrcLog(Msg("irc-error"))
Connecting = False
Config.IrcMode = False
End If
End Sub
<DebuggerStepThrough()> _
Private Sub ProcessIrcEdit(ByVal EditObject As Object)
Dim Edit As Edit = CType(EditObject, Edit)
ProcessEdit(Edit)
ProcessNewEdit(Edit)
If MainForm IsNot Nothing AndAlso MainForm.Visible Then MainForm.RefreshInterface()
End Sub
Private Function ProcessExpiry(ByVal Text As String) As Date
If String.IsNullOrEmpty(Text) Then Return Date.MinValue
If Text = "indefinite" Then Return Date.MaxValue
Return CDate(FindString(Text, " ").Replace(" (UTC)", ""))
End Function
Private Sub IrcLog(ByVal Message As String)
Callback(AddressOf IrcLogCallback, CObj(Message))
End Sub
Private Sub IrcLogCallback(ByVal MessageObject As Object)
Log(CStr(MessageObject))
End Sub
Public Sub Disconnect()
Disconnecting = True
End Sub
Public Sub Reconnect()
If Connecting OrElse Connected Then
Reconnecting = True
Else
IrcConnect()
End If
End Sub
End Module