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