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