]> jfr.im git - irc/SurrealServices/srsv.git/blame - branches/0.5.0/SrSv/Unreal/Parse.pm
projects / irc / SurrealServices / srsv.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fixed some more stuff.. No more getuuid for normal users!
[irc/SurrealServices/srsv.git] / branches / 0.5.0 / SrSv / Unreal / Parse.pm
CommitLineData
aecfa1fd 1# This file is part of SurrealServices.
2#
3# SurrealServices is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 2 of the License, or
6# (at your option) any later version.
7#
8# SurrealServices is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with SurrealServices; if not, write to the Free Software
15# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16
17package SrSv::IRCd::Parse;
18
19use strict;
20
21use Exporter 'import';
22# parse_sjoin shouldn't get used anywhere else, as we never produce SJOINs
23# parse_tkl however is used for loopbacks.
5e682044 24BEGIN { our @EXPORT_OK = qw(parse_line parse_tkl parse_addline) }
aecfa1fd 25
26# FIXME
27BEGIN { *SJB64 = \&ircd::SJB64; *CLK = \&ircd::CLK; *NICKIP = \&ircd::NICKIP; }
28
29use SrSv::Conf 'main';
aecfa1fd 30
31use SrSv::Debug;
32use SrSv::IRCd::State qw($ircline $remoteserv create_server get_server_children set_server_state get_server_state %IRCd_capabilities);
33use SrSv::IRCd::Queue qw(queue_size);
5e682044 34use SrSv::IRCd::IO qw( ircsend ircsendimm);
aecfa1fd 35use SrSv::Unreal::Modes qw(%opmodes);
36
37# Unreal uses its own modified base64 for everything except NICKIP
38use SrSv::Unreal::Base64 qw(b64toi itob64);
026939ee 39use SrSv::User '/./';
aecfa1fd 40# Unreal uses unmodified base64 for NICKIP.
41# Consider private implementation,
42# tho MIME's is probably faster
43use MIME::Base64;
026939ee 44use Data::Dumper;
aecfa1fd 45# FIXME
46use constant {
47 # Wait For
48 WF_NONE => 0,
49 WF_NICK => 1,
50 WF_CHAN => 2,
51 WF_ALL => 3,
52};
53
54use SrSv::Shared qw(@servernum);
55
56our %cmdhash;
57
58sub parse_line($) {
59 my ($in) = @_;
5e682044 60 if (!$in) {
61 return;
62 }
aecfa1fd 63 my $cmd;
64
65 if($in =~ /^(?:@|:)(\S+) (\S+)/) {
66 $cmd = $2;
67 }
68 elsif ($in =~ /^(\S+)/) {
69 $cmd = $1;
70 }
aecfa1fd 71 my $sub = $cmdhash{$cmd};
72 unless (defined($sub)) {
73 print "Bailing out from $ircline:$cmd for lack of cmdhash\n" if DEBUG();
74 return undef();
75 }
76 my ($event, $src, $dst, $wf, @args) = &$sub($in);
77 unless (defined($event)) {
78 print "Bailing out from $ircline:$cmd for lack of event\n" if DEBUG;
79 return undef();
80 }
81 #return unless defined $event;
82
83 my (@recipients, @out);
84 if(defined($dst)) {
85 #$args[$dst] = lc $args[$dst];
86 @recipients = split(/\,/, $args[$dst]);
87 }
88 #if(defined($src)) { $args[$src] = lc $args[$src]; }
89
90 if(@recipients > 1) {
91 foreach my $rcpt (@recipients) {
92 $args[$dst] = $rcpt;
93 push @out, [$event, $src, $dst, $wf, [@args]];
94 }
95 } else {
96 @out = [$event, $src, $dst, $wf, [@args]];
97 }
98
99 return @out;
100}
aecfa1fd 101sub parse_sjoin($$$$) {
102 my ($server, $ts, $cn, $parms) = @_;
103 my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
104
105 $server = '' unless $server;
106
107 if($parms =~ /^:(.*)/) {
108 $blobs = $1;
109 } else {
110 ($chmodes, $blobs) = split(/ :/, $parms, 2);
111 ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
112 }
113 @blobs = split(/ /, $blobs);
114
115 foreach my $x (@blobs) {
116 if($x =~ /^(\&|\"|\')(.*)$/) {
117 my $type;
118 push @bans, $2 if $1 eq '&';
119 push @excepts, $2 if $1 eq '"';
120 push @invex, $2 if $1 eq "\'";
121 } else {
122 $x =~ /^([*~@%+]*)(.*)$/;
123 my ($prefixes, $nick) = ($1, $2);
124 my @prefixes = split(//, $prefixes);
125 my $op = 0;
126 foreach my $prefix (@prefixes) {
127 $op |= $opmodes{q} if ($prefix eq '*');
128 $op |= $opmodes{a} if ($prefix eq '~');
129 $op |= $opmodes{o} if ($prefix eq '@');
130 $op |= $opmodes{h} if ($prefix eq '%');
131 $op |= $opmodes{v} if ($prefix eq '+');
132 }
133
134 push @users, { NICK => $nick, __OP => $op };
135 }
136 }
137
138 return ($server, $cn, $ts, $chmodes, $chmodeparms, \@users, \@bans, \@excepts, \@invex);
139}
aecfa1fd 140sub parse_tkl ($) {
141 my ($in) = @_;
142 # This function is intended to accept ALL tkl types,
143 # tho maybe not parse all of them in the first version.
144
145 # Discard first token, 'TKL'
146 my (undef, $sign, $type, $params) = split(/ /, $in, 4);
147
148 # Yes, TKL types are case sensitive!
149 # also be aware (and this applies to the net.pm generator functions too)
150 # This implementation may appear naiive, but Unreal assumes that, for a given
151 # TKL type, that all parameters are non-null.
152 # Thus, if any parameters ARE null, Unreal WILL segfault.
153 ## Update: this problem may have been fixed since Unreal 3.2.2 or so.
154 if ($type eq 'G' or $type eq 'Z' or $type eq 's' or $type eq 'Q') {
155 # format is
156 # TKL + type ident host setter expiretime settime :reason
157 # TKL - type ident host setter
158 # for Q, ident is always '*' or 'h' (Services HOLDs)
159 if ($sign eq '+') {
160 my ($ident, $host, $setter, $expire, $time, $reason) = split(/ /, $params, 6);
161
162 $reason =~ s/^\://;
163 return ($type, +1, $ident, $host, $setter, $expire, $time, $reason);
164 }
165 elsif($sign eq '-') {
166 my ($ident, $host, $setter) = split(/ /, $params, 3);
167 return ($type, -1, $ident, $host, $setter);
168 }
169 }
170 elsif($type eq 'F') {
171 # TKL + F cpnNPq b saturn!attitude@netadmin.SCnet.ops 0 1099959668 86400 Possible_mIRC_DNS_exploit :\/dns (\d+\.){3}\d
172 # TKL + F u g saturn!attitude@saturn.netadmin.SCnet.ops 0 1102273855 604800 sploogatheunbreakable:_Excessively_offensive_behavior,_ban_evasion. :.*!imleetnig@.*\.dsl\.mindspring\.com
173 # TKL - F u Z tabris!northman@tabris.netadmin.SCnet.ops 0 0 :do_not!use@mask
174 if ($sign eq '+') {
175 my ($target, $action, $setter, $expire, $time, $bantime, $reason, $mask) = split(/ /, $params, 8);
176 $mask =~ s/^\://;
177 return ($type, +1, $target, $action, $setter, $expire, $time, $bantime, $reason, $mask);
178 }
179 elsif($sign eq '-') {
180 my ($target, $action, $setter, $expire, $time, $mask) = split(/ /, $params, 6);
181 $mask =~ s/^\://;
182 return ($type, -1, $target, $action, $setter, $mask);
183 }
184 }
185}
186
187sub PING($) {
188 my ($event, $src, $dst, @args);
189 $_[0] =~ /^(?:8|PING) :(\S+)$/;
190 # ($event, $src, $dst, $args)
191 return ('PING', undef, undef, WF_NONE, $1);
192}
aecfa1fd 193sub EOS($) {
194 my $event;
026939ee 195 $_[0] =~ /^(@|:)(\S+) (?:EOS|ES)/; # Sometimes there's extra crap on the end?
196 my $server;
197 if ($1 eq '@') {
198 $server = $servernum[b64toi($2)];
aecfa1fd 199 }
200 else {
026939ee 201 $server = $2;
aecfa1fd 202 }
026939ee 203 print "SERVER $server\n";
204 set_server_state($server, 1);
205 return undef() unless get_server_state($remoteserv);
206 if($server eq $remoteserv) { $event = 'SEOS' } else { $event = 'EOS' }
207 print "Ok. we had EOS\n";
208 return ($event, undef, undef, WF_ALL, $server);
aecfa1fd 209}
210
211sub SERVER($) {
212 #ircd::debug($_[0]) if $debug;
026939ee 213
aecfa1fd 214 if($_[0] =~ /^(?:SERVER|\') (\S+) (\S+) :(U[0-9]+)-([A-Za-z0-9]+)-([0-9]+) (.*)$/) {
026939ee 215 # SERVER test-tab.surrealchat.net 1 :U2307-FhinXeOoZEmM-200 SurrealChat
216 # cmd, servername, hopCount, U<protocol>-<buildflags>-<numeric> infoLine
aecfa1fd 217 $remoteserv = $1;
218 create_server($1);
219 $servernum[$5] = $1;
220
221 return ('SERVER', undef, undef, WF_ALL, undef, $1, $2, $6, $5, $3, $4);
222 # src, serverName, numHops, infoLine, serverNumeric, protocolVersion, buildFlags
223 }
224 elsif($_[0] =~ /^(:|@)(\S+) (?:SERVER|\') (\S+) (\d+) (\d+) :(.*)$/) {
225 # @38 SERVER test-hermes.surrealchat.net 2 100 :SurrealChat
226 # source, cmd, new server, hopCount, serverNumeric, infoLine
227 my ($numeric, $name);
228 if ($1 eq '@') {
229 $name = $servernum[b64toi($2)];
230 }
231 else {
232 $name = $2;
233 }
234 create_server($3, $name);
235 $servernum[$5] = $3;
236
237 return ('SERVER', undef, undef, WF_ALL, $name, $3, $4, $6, $5);
238 # src, serverName, numHops, infoLine, serverNumeric
239 }
240 if($_[0] =~ /^(?:SERVER|\') (\S+) (\S+) :(.*)$/) {
241 $remoteserv = $1;
242 create_server($1);
243 return ('SERVER', undef, undef, WF_ALL, undef, $1, $2, $3);
244 # src, serverName, numHops, infoLine
245 }
246 elsif($_[0] =~ /^:(\S+) (?:SERVER|\') (\S+) (\d+) :(.*)$/) {
247 # source, new server, hop count, description
248 create_server($2, $1);
249 return ('SERVER', undef, undef, WF_ALL, $1, $2, $3, $4);
250 # src, serverName, numHops, infoLine
251 }
026939ee 252 elsif ($_[0] =~ /SERVER (\S+) (\S+) (\d+) (\S+) :(.*)$/) {
253 #SERVER inspircd.erry.omg mypass 0 583 :erry World
254 #SERVER servername password hopcount SID :Server Desc
255 $remoteserv = $4;
256 create_server ($4);
257 #since from now on we'll be getting commands as sent from the SID it's much wiser to keep that than the name.
258 return ("SERVER", undef, undef, WF_ALL, undef, $1, $3, $5, $4);
259 }
aecfa1fd 260}
261
262sub SQUIT($) {
263 if($_[0] =~ /^(?:SQUIT|-) (\S+) :(.*)$/) {
264 my $list = [get_server_children($1)];
265 set_server_state($1, undef());
266 return ('SQUIT', undef, undef, WF_ALL, undef, $list, $2);
267 }
268 elsif($_[0] =~ /^(:|@)(\S+) (?:SQUIT|-) (\S+) :(.*)$/) {
269 my $name;
270 if ($1 eq '@') {
271 $name = $servernum[b64toi($2)];
272 }
273 else {
274 $name = $2;
275 }
276 my $list = [get_server_children($3)];
277 set_server_state($3, undef());
278 return ('SQUIT', undef, undef, WF_ALL, $name, $list, $4);
279 }
280}
281
282sub NETINFO($) {
283 $_[0] =~ /^(?:NETINFO|AO) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/;
284 return ('NETINFO', undef, undef, WF_NONE, $1, $2, $3, $4, $5, $6, $7, $8);
285}
286
287sub PROTOCTL($) {
288 $_[0] =~ /^PROTOCTL (.*)$/;
289 return ('PROTOCTL', undef, undef, WF_NONE, $1);
290}
291
292sub JOIN($) {
293 $_[0] =~ /^:(\S+) (?:C|JOIN) (\S+)$/;
026939ee 294 my $user = { NICK => $1 };
295 get_user_id ($user);
296 return ('JOIN', undef, 1, WF_CHAN, $user, $2);
5e682044 297}
026939ee 298
aecfa1fd 299sub SJOIN($) {
300 if ($_[0] =~ /^(?:\~|SJOIN) (\S+) (\S+) (.*)$/) {
301 my ($ts, $cn, $payload) = ($1, $2, $3);
302 if ($ts =~ s/^!//) {
303 $ts = b64toi($ts);
304 }
305 return ('SJOIN', undef, undef, WF_CHAN, parse_sjoin($remoteserv, $ts, $cn, $payload));
306 }
307 elsif($_[0] =~ /^(@|:)(\S+) (?:\~|SJOIN) (\S+) (\S+) (.*)$/) {
026939ee 308 print "SJOIN\n";
aecfa1fd 309 my ($server, $ts, $cn, $payload) = ($2, $3, $4, $5);
310 if ($1 eq '@') {
311 $server = $servernum[b64toi($2)];
312 }
313 else {
314 $server = $2;
315 }
316 if ($ts =~ s/^!//) {
317 $ts = b64toi($ts);
318 }
319 return ('SJOIN', undef, undef, WF_CHAN, parse_sjoin($server, $ts, $cn, $payload));
320 }
321}
322
323sub PART($) {
026939ee 324 my $user;
325
aecfa1fd 326 if($_[0] =~ /^:(\S+) (?:D|PART) (\S+) :(.*)$/) {
026939ee 327 $user = {NICK => $1};
328 get_user_id ($user);
329 return ('PART', undef, 0, WF_CHAN, $user, $2, $3);
aecfa1fd 330 }
331 elsif($_[0] =~ /^:(\S+) (?:D|PART) (\S+)$/) {
026939ee 332 $user = {NICK => $1};
333 get_user_id ($user);
334 return ('PART', undef, 0, WF_CHAN, $user, $2, undef);
aecfa1fd 335 }
336}
aecfa1fd 337sub MODE($) {
026939ee 338 my $user;
339
aecfa1fd 340 if($_[0] =~ /^(@|:)(\S+) (?:G|MODE) (#\S+) (\S+) (.*)(?: \d+)?$/) {
341 my $name;
342 if ($1 eq '@') {
343 $name = $servernum[b64toi($2)];
026939ee 344 $user = {NICK => $name};
aecfa1fd 345 }
346 else {
347 $name = $2;
026939ee 348 $user = { NICK=>$name};
349 get_user_id ($user);
aecfa1fd 350 }
026939ee 351 return ('MODE', undef, 1, WF_ALL, $user, $3, $4, $5);
aecfa1fd 352 }
353 elsif($_[0] =~ /^:(\S+) (?:G|MODE) (\S+) :(\S+)$/) {
354 # We shouldn't ever get this, as UMODE2 is preferred
026939ee 355 $user = { NICK => $1 };
356 get_user_id($user);
357 return ('UMODE', 0, 0, WF_ALL, $user, $3);
aecfa1fd 358 }
359
360}
361
362sub MESSAGE($) {
363 my ($event, @args);
364 if($_[0] =~ /^(@|:)(\S+) (?:\!|PRIVMSG) (\S+) :(.*)$/) {
026939ee 365
366 my ($name, $srcUser, $dstUser) ;
aecfa1fd 367 if ($1 eq '@') {
368 $name = $servernum[b64toi($2)];
026939ee 369 $srcUser = {NICK=>$name};
aecfa1fd 370 }
371 else {
372 $name = $2;
026939ee 373 $srcUser = {NICK=>$name};
374 get_user_id ($srcUser);
aecfa1fd 375 }
5e682044 376 my $dest = $3;
026939ee 377 $dstUser = {NICK=>$dest};
378 $event = 'PRIVMSG'; @args = ($srcUser, $dstUser, $4);
aecfa1fd 379 }
380 elsif($_[0] =~ /^(@|:)(\S+) (?:B|NOTICE) (\S+) :(.*)$/) {
381 my $name;
382 if ($1 eq '@') {
383 $name = $servernum[b64toi($2)];
384 }
385 else {
386 $name = $2;
387 }
388 $event = 'NOTICE'; @args = ($name, $3, $4);
389 }
390 $args[1] =~ s/\@${main_conf{local}}.*//io;
391
392 if(queue_size > 50 and $event eq 'PRIVMSG' and $args[1] !~ /^#/ and $args[2] =~ /^\w/) {
393 ircd::notice($args[1], $args[0], "It looks like the system is busy. You don't need to do your command again, just hold on a minute...");
394 }
395
396 return ($event, 0, 1, WF_ALL, @args);
397}
398
399sub AWAY($) {
400 if($_[0] =~ /^:(\S+) (?:6|AWAY) :(.*)$/) {
026939ee 401 my $user = {NICK=>$1};
402 get_user_id($user);
403 return ('AWAY', undef, undef, WF_ALL, $user, $2);
aecfa1fd 404 }
026939ee 405 elsif($_[0] =~ /^:(\S+) (?:6|AWAY)$/) {
406 my $user = {NICK => $1};
407 get_user_id ($user);
408 return ('BACK', undef, undef, WF_ALL, $user);
aecfa1fd 409 }
410}
411
412sub NICK($) {
413 my ($event, @args);
88eba747 414 #>> 32 :erry_ & erry2 :1310809099
aecfa1fd 415 if($_[0] =~ /^:(\S+) (?:NICK|\&) (\S+) :?(\S+)$/) {
88eba747 416 my $user = {NICK=>$1};
417 return ('NICKCHANGE', undef, undef, WF_NICK, $user, $2, $3);
aecfa1fd 418 }
419 elsif(CLK && NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\d+) (\S+) (\S+) (\S+) (\S+) (\d+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
420#NICK Guest57385 1 !14b7t0 northman tabriel.tabris.net 38 0 +iowghaAxNWzt netadmin.SCnet.ops SCnet-3B0714C4.tabris.net CgECgw== :Sponsored By Skuld
421#NICK outis 1 !14corv northman localhost 38 0 +iowghaAxNWzt tabris.netadmin.SCnet.ops SCnet-D8C01838 AAAAAAAAAAAAAAAAAAAAAQ== :Sponsored By Skuld
422 my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $cloakhost, $IP, $gecos) =
423 ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
424 if ($ts =~ s/^!//) {
425 $ts = b64toi($ts);
426 }
427 if (SJB64 and length($server) <= 2 and $server !~ /\./) {
428 $server = $servernum[b64toi($server)];
429
430 }
026939ee 431 if((length($IP) > 8)) {
432 #$IP = Socket6::inet_ntop(AF_INET6, MIME::Base64::decode($IP));
aecfa1fd 433 } else {
434 $IP = join('.', unpack('C4', MIME::Base64::decode($IP)));
435 }
026939ee 436 my $user = {NICK=>$nick};
437 return ('NICKCONN', undef, undef, WF_NICK, $user, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost,
aecfa1fd 438 $gecos, $IP, $cloakhost
439 );
440 }
441 elsif(!CLK && NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
442#NICK tab 1 1116196525 northman tabriel.tabris.net test-tab.surrealchat.net 0 +iowghaAxNWzt netadmin.SCnet.ops CgECgw== :Sponsored by Skuld
443 my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $IP, $gecos) =
444 ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
445 if ($ts =~ s/^!//) {
446 $ts = b64toi($ts);
447 }
448 if (SJB64 and length($server) <= 2 and $server !~ /\./) {
449 $server = $servernum[b64toi($server)];
450
451 }
026939ee 452 if( length($IP) > 8) {
aecfa1fd 453 $IP = Socket6::inet_ntop(AF_INET6, MIME::Base64::decode($IP));
454 } else {
455 $IP = join('.', unpack('C4', MIME::Base64::decode($IP)));
456 }
026939ee 457 my $user = {NICK=>$nick};
458 return ('NICKCONN', undef, undef, WF_NICK, $user, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost,
aecfa1fd 459 $gecos, $IP
460 );
461 }
462 elsif(!CLK && !NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
463#NICK tab 1 1116196525 northman tabriel.tabris.net test-tab.surrealchat.net 0 +iowghaAxNWzt netadmin.SCnet.ops :Sponsored by Skuld
464 my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $gecos) =
465 ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
466 if ($ts =~ s/^!//) {
467 $ts = b64toi($ts);
468 }
469 if (SJB64 and length($server) <= 2 and $server !~ /\./) {
470 $server = $servernum[b64toi($server)];
471
472 }
026939ee 473 my $user = {NICK=>$nick};
474 return ('NICKCONN', undef, undef, WF_NICK, $user, $hops, $ts, $ident, $host, $server, $stamp, $modes,
aecfa1fd 475 $vhost, $gecos);
476 }
477}
478
479sub QUIT($) {
88eba747 480 print "?????????/";
481 $_[0] =~ /^:(\S+) (?:QUIT|\,) :(.*)$/;
482 my $user = { NICK=>$1 };
483 return ('QUIT', 0, undef, WF_NICK, $user, $2);
aecfa1fd 484}
485
486sub KILL($) {
026939ee 487 $_[0] =~ /^:(\S+) KILL (\S+) :(.*)$/;
488 my $murderer = {NICK=>$1};
489 my $victim = {NICK=>$2};
490 return ("KILL", 0, 1, WF_NICK, $murderer, $victim, $3, undef);
aecfa1fd 491}
aecfa1fd 492sub KICK($) {
493#:tabris KICK #diagnostics SurrealBot :i know you don't like this. but it's for science!
494 $_[0] =~ /^(@|:)(\S+) (?:KICK|H) (\S+) (\S+) :(.*)$/;
495 # source, chan, target, reason
496 #$src = 0; #$dst = 2;
497 my $name;
498 if ($1 eq '@') {
499 $name = $servernum[b64toi($2)];
500 }
501 else {
502 $name = $2;
503 }
026939ee 504 my $user = {NICK => $name};
505 return ('KICK', 0, undef, WF_CHAN, $user, $3, $4, $5);
aecfa1fd 506}
507
508sub HOST($) {
509 if($_[0] =~ /^:(\S+) (?:CHGHOST|AL) (\S+) (\S+)$/) {
510 #:Agent CHGHOST tabris tabris.netadmin.SCnet.ops
511 return ('CHGHOST', 0, 1, WF_CHAN, $1, $2, $3);
512 #setter, target, vhost
513 }
514 elsif($_[0] =~ /^:(\S+) (?:SETHOST|AA) (\S+)$/) {
515 #:tabris SETHOST tabris.netadmin.SCnet.ops
516 return ('CHGHOST', 0, 1, WF_CHAN, $1, $1, $2);
517 }
518
519 elsif ($_[0] =~ /^:(?:\S* )?302 (\S+) :(\S+?)\*?=[+-].*?\@(.*)/) {
520 #:serebii.razorville.co.uk 302 leif :Jesture=+~Jesture00@buzz-3F604D09.sympatico.ca
521 return ('CHGHOST', 0, 1, WF_CHAN, $1, $2, $3);
522 }
523}
524
525
526sub USERIP($) {
527 $_[0] =~ /^:(?:\S* )?340 (\S+) :(\S+?)\*?=[+-].*?\@((?:\.|\d)*)/;
528 return ('USERIP', 0, 1, WF_CHAN, $1, $2, $3);
529}
530
531sub IDENT($) {
532 if($_[0] =~ /^:(\S+) (?:CHGIDENT|AL) (\S+) (\S+)$/) {
533 return ('CHGIDENT', 0, 1, WF_ALL, $1, $2, $3);
534 #setter, target, IDENT
535 }
536 elsif($_[0] =~ /^:(\S+) (?:SETIDENT|AD) (\S+)$/) {
537 return ('CHGIDENT', 0, 1, WF_ALL, $1, $1, $2);
538 #setter, target, ident
539 }
540}
541
542
543sub TOPIC($) {
544 if($_[0] =~ /^(@|:)(\S+) (?:TOPIC|\)) (\S+) (\S+) (\S+) :(.*)$/) {
545 #:tabris TOPIC #the_lounge tabris 1089336598 :Small Channel in search of Strong Founder for long term relationship, growth, and great conversation.
546 my $name;
547 my ($name, $cn, $setter, $ts, $topic) = ($2, $3, $4, $5, $6);
548 if ($1 eq '@') {
549 $name = $servernum[b64toi($2)];
550 }
551 else {
552 $name = $2;
553 }
554 if ($ts =~ s/^!//) {
555 $ts = b64toi($ts);
556 }
026939ee 557 my $usetter = {NICK=>$name};
558 return ('TOPIC', 0, 1, WF_ALL, $usetter, $cn, $setter, $ts, $topic);
aecfa1fd 559 }
560 elsif($_[0] =~ /^(?:TOPIC|\)) (\S+) (\S+) (\S+) :(.*)$/) {
561 my ($cn, $setter, $ts, $topic) = ($1, $2, $3, $4);
562 if ($ts =~ s/^!//) {
563 $ts = b64toi($ts);
564 }
026939ee 565 # src, channel, setter, timestamp, topic
566 my $usetter = {NICK=>$setter};
567 return ('TOPIC', 0, 1, WF_ALL, undef, $cn, $usetter, $ts, $topic);
aecfa1fd 568 }
569}
570
571sub UMODE($) {
572#:tabris | +oghaANWt
573 $_[0] =~ /^:(\S+) (?:UMODE2|\|) (\S+)$/;
574 # src, umodes
575 # a note, not all umodes are passed
576 # +s, +O, and +t are not passed. possibly others
577 # also not all umodes do we care about.
578 # umodes we need care about:
579 # oper modes: hoaACN,O oper-only modes: HSq
580 # regular modes: rxB,izV (V is only somewhat, as the ircd
581 # does the conversions from NOTICE to PRIVSMG for us).
582
583 # Yes, I'm changing the event type on this
584 # It's better called UMODE, and easily emulated
585 # on IRCds with only MODE.
586 return ('UMODE', 0, 0, WF_ALL, $1, $2);
587}
aecfa1fd 588sub SVSMODE($) {
589#:tabris | +oghaANWt
590 $_[0] =~ /^:(\S+) (?:SVS2?MODE|n|v) (\S+) (\S+)$/;
591 # src, umodes
592 # a note, not all umodes are passed
593 # +s, +O, and +t are not passed. possibly others
594 # also not all umodes do we care about.
595 # umodes we need care about:
596 # oper modes: hoaACN,O oper-only modes: HSq
597 # regular modes: rxB,izV (V is only somewhat, as the ircd
598 # does the conversions from NOTICE to PRIVSMG for us).
599
600 return ('UMODE', 0, 0, WF_ALL, $2, $3);
601}
602
603sub WHOIS($) {
604# :tab WHOIS ConnectServ :ConnectServ
605 if($_[0] =~ /^:(\S+) (?:WHOIS|\#) (\S+)$/) {
606 return ('WHOIS', 0, undef, WF_NONE, $1, $2);
607 }
608 elsif($_[0] =~ /^:(\S+) (?:WHOIS|\#) (\S+) :(\S+)$/) {
609 return ('WHOIS', 0, undef, WF_NONE, $1, $3);
610 }
611}
612
613sub TSCTL($) {
614 $_[0] =~ /^:(\S+) (?:TSCTL|AW) alltime$/;
615 ircsend(":$main_conf{local} NOTICE $1 *** Server=$main_conf{local} TSTime=".
616 time." time()=".time." TSOffset=0");
617 return;
618}
619
620sub VERSION($) {
621 $_[0] =~ /^:(\S+) (?:VERSION|\+).*$/;
622 return ('VERSION', 0, undef, WF_NONE, $1);
623}
624
625sub TKL($) {
626 if ($_[0] =~ /^(@|:)(\S+) (?:TKL|BD) (.*)$/) {
627 # We discard the source anyway.
628 #my $server;
629 #if ($1 eq '@') {
630 # $server = $servernum[b64toi($2)];
631 #}
632 #else {
633 # $server = $2;
634 #}
635 return ('TKL', undef, undef, WF_NONE, parse_tkl("TKL $3"));
636 }
637 elsif ($_[0] =~ /^(?:TKL|BD) (.*)$/) {
638 return ('TKL', undef, undef, WF_NONE, parse_tkl("TKL $1"));
639 }
640}
641
642sub SNOTICE($) {
643 $_[0] =~ /^(@|:)(\S+) (SENDSNO|Ss|SMO|AU) ([A-Za-z]) :(.*)$/;
644 #@servernumeric Ss snomask :message
645 my $name;
646 if ($1 eq '@') {
647 $name = $servernum[b64toi($2)];
648 }
649 else {
650 $name = $2;
651 }
652 my $event;
653 $event = 'SENDSNO' if(($3 eq 'SENDSNO' or $3 eq 'Ss'));
654 $event = 'SMO' if(($3 eq 'SMO' or $3 eq 'AU'));
655 return ($event, 0, undef, WF_NONE, $name, $4, $5);
656}
657
658sub GLOBOPS($) {
659 $_[0] =~ /^(@|:)(\S+) (?:GLOBOPS|\]) :(.*)$/;
660 #@servernumeric [ :message
661 my $name;
662 if ($1 eq '@') {
663 $name = $servernum[b64toi($2)];
664 }
665 else {
666 $name = $2;
667 }
668 return ('GLOBOPS', 0, undef, WF_NONE, $name, $3);
669}
670
671sub ISUPPORT($) {
672 $_[0] =~ /^:(\S+) (?:105|005) (\S+) (.+) :are supported by this server$/;
673 # :test-tab.surrealchat.net 105 services.SC.net CMDS=KNOCK,MAP,DCCALLOW,USERIP :are supported by this server
674 foreach my $token (split(/\s+/, $3)) {
675 my ($key, $value) = split('=', $token);
676 $IRCd_capabilities{$key} = ($value ? $value : 1);
677 }
a1a0e944 678 # Insp compatibility... :(
026939ee 679 $IRCd_capabilities{"CHGHOST"} = 1;
680 $IRCd_capabilities{"CHGIDENT"} = 1;
681 $IRCd_capabilities{"CLOAKHOST"} = 1;
682 $IRCd_capabilities{"CLOAK"} = 1;
683 $IRCd_capabilities{"ADMIN"} = 'a';
684 $IRCd_capabilities{"FOUNDER"} = 'q';
685 $IRCd_capabilities{"SILENCE"} = 32;
686 $IRCd_capabilities{"WATCH"} = 32;
687 $IRCd_capabilities{"REG"} = 1;
1eb006d9 688 $IRCd_capabilities{"HALFOP"} = 'h';
a1a0e944 689 $IRCd_capabilities{"INSP"} = 0;
690 # so ugly. Ugly Ugly UGLY.
aecfa1fd 691}
692
693sub STATS($) {
694 $_[0] =~ /^:(\S+) (?:STATS|2) (\S) :(.+)$/;
695 return ('STATS', undef, undef, WF_NONE, $1, $2, $3)
696}
697
698BEGIN {
699 %cmdhash = (
700 PING => \&PING,
701 '8' => \&PING,
702
703 EOS => \&EOS,
704 ES => \&EOS,
aecfa1fd 705 SERVER => \&SERVER,
706 "\'" => \&SERVER,
707
708 SQUIT => \&SQUIT,
709 '-' => \&SQUIT,
710
711 NETINFO => \&NETINFO,
712 AO => \&NETINFO,
713
714 PROTOCTL => \&PROTOCTL,
715
716 JOIN => \&JOIN,
717 C => \&JOIN,
718
719 PART => \&PART,
720 D => \&PART,
721
722 SJOIN => \&SJOIN,
723 '~' => \&SJOIN,
5e682044 724 FJOIN => \&FJOIN,
026939ee 725 FMODE => \&FMODE,
aecfa1fd 726 MODE => \&MODE,
727 G => \&MODE,
728
729 PRIVMSG => \&MESSAGE,
730 '!' => \&MESSAGE,
731 NOTICE => \&MESSAGE,
732 B => \&MESSAGE,
733
734 AWAY => \&AWAY,
735 '6' => \&AWAY,
736
737 NICK => \&NICK,
738 '&' => \&NICK,
739
740 QUIT => \&QUIT,
741 ',' => \&QUIT,
742
743 KILL => \&KILL,
744 '.' => \&KILL,
745
746 KICK => \&KICK,
747 H => \&KICK,
748
749 CHGHOST => \&HOST,
750 AL => \&HOST,
751 SETHOST => \&HOST,
752 AA => \&HOST,
753 '302' => \&HOST,
754
755 '340' => \&USERIP,
756
757 CHGIDENT => \&IDENT,
758 AZ => \&IDENT,
759 SETIDENT => \&IDENT,
760 AD => \&IDENT,
761
762 TOPIC => \&TOPIC,
763 ')' => \&TOPIC,
764
765 UMODE2 => \&UMODE,
766 '|' => \&UMODE,
767
768 TSCTL => \&TSCTL,
769 AW => \&TSCTL,
770
771 VERSION => \&VERSION,
772 '+' => \&VERSION,
773
774 TKL => \&TKL,
775 BD => \&TKL,
776
777 WHOIS => \&WHOIS,
778 '#' => \&WHOIS,
779
780 SENDSNO => \&SNOTICE,
781 Ss => \&SNOTICE,
782
783 SMO => \&SNOTICE,
784 AU => \&SNOTICE,
785
786 GLOBOPS => \&GLOBOPS,
787 ']' => \&GLOBOPS,
788
789 '105' => \&ISUPPORT,
790 '005' => \&ISUPPORT,
791
792 SVSMODE => \&SVSMODE,
793 'n' => \&SVSMODE,
794 SVS2MODE => \&SVSMODE,
795 'v' => \&SVSMODE,
796
797 STATS => \&STATS,
798 '2' => \&STATS,
799 );
800}
801
8021;
Unnamed repository; edit this file 'description' to name the repository.