branches/erry-devel/SrSv/Unreal/Parse.pm

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