branches/0.5.0/SrSv/Insp/Send.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 package ircd;
  17
  18 use strict;
  19 use IO::Socket::INET;
  20 use Event;
  21 use Carp;
  22 use MIME::Base64;
  23 use Data::Dumper;
  24 use SrSv::Conf 'main';
  25 use SrSv::Insp::UUID;
  26 use SrSv::Debug;
  27 use SrSv::Log;
  28 use Exporter 'import';
  29 our @EXPORT = qw (agent_doconn getRevUuid getUuid setRevUuid setUuid);
  30 # FIXME
  31 use constant {
  32         MAXBUFLEN => 510,
  33
  34 # These appear to match the implementations I've seen, but are unspecified in the RFCs.
  35 # They may vary by implementation.
  36         NICKLEN => 30, # some ircds are different. hyperion is 16.
  37         IDENTLEN => 10, # Sometimes 8 or 9.
  38                         # hyperion may break this due to it's ident format: [ni]=identhere, like this n=northman
  39         HOSTLEN => 63, # I think I've seen 64 here before.
  40         MASKLEN => 30 + 10 + 63 + 2, # 105, or maybe 106. the 2 constant is for !@
  41
  42         CHANNELLEN => 32, # From 005 reply. hyperion is 30.
  43
  44         SJ3 => 1,
  45         NOQUIT => 1,
  46         NICKIP => 1,
  47         SJB64 => 1,
  48         CLK => 1,
  49
  50         PREFIXAQ_DISABLE => 0,
  51 };
  52 die "NICKIP must be enabled if CLK is\n" if CLK && !NICKIP;
  53
  54 use SrSv::IRCd::IO qw(ircd_connect ircsend ircsendimm ircd_flush_queue);
  55 use SrSv::IRCd::Event qw(addhandler callfuncs);
  56 use SrSv::IRCd::State qw($ircline $remoteserv $ircd_ready synced initial_synced set_server_state set_server_juped get_server_state get_online_servers);
  57
  58 use SrSv::Unreal::Modes qw(@opmodes %opmodes $scm $ocm $acm);
  59 use SrSv::Unreal::Tokens;
  60 use SrSv::IRCd::Parse qw(parse_tkl parse_addline);
  61 use SrSv::Unreal::Base64 qw(itob64 b64toi);
  62
  63 use SrSv::Text::Format qw( wordwrap );
  64
  65 use SrSv::Agent;
  66
  67 use SrSv::Process::InParent qw(update_userkill getRevUuid getUuid setRevUuid SetUUid);
  68
  69 our %defer_mode;
  70 our %preconnect_defer_mode;
  71 our @userkill;
  72 our $unreal_protocol_version;
  73 our $count = 65;
  74 our %uuids; #NickServ -> AAAAAA
  75 our %reverse_uuids; #AAAAA -> NickServ
  76 addhandler('SEOS', undef(), undef(), 'ircd::eos', 1);
  77 addhandler('NETINFO', undef(), undef(), 'ircd::netinfo', 1);
  78 addhandler('VERSION', undef(), undef(), 'ircd::version', 1);
  79 addhandler('SERVER', undef(), undef(), 'ircd::handle_server', 1);
  80 addhandler('ENDBURST',undef(),undef(),'ircd::endburst',1);
  81 sub getRevUuid($) {
  82         my $id = $_[0];
  83         my $nick = $reverse_uuids{$id};
  84         $uuids{lc $nick} = $id;
  85         return $nick;
  86 }
  87 sub getUuid($) {
  88         my $nick = lc $_[0];
  89         my $id = $uuids{$nick};
  90         print "getUuid $nick $id\n";
  91         return $id;
  92 }
  93 sub setRevUuid ($$) {
  94         my ($id, $nick) = @_;
  95         $reverse_uuids{$id} = lc $nick;
  96 }
  97 sub setUuid ($$) {
  98         my ($nick, $id) = @_;
  99         $uuids{lc $nick} = $id;
 100 }
 101 sub serv_connect() {
 102         my $remote = $main_conf{remote};
 103         my $port = $main_conf{port};
 104         ircd_connect($remote, $port);
 105         #ircsendimm('PROTOCTL '.($tkn ? 'TOKEN ' : '').'NICKv2 UMODE2 TKLEXT'.
 106                 #(CLK ? ' CLK' : ' VHP'). # CLK obsoletes VHP. Plus if you leave VHP on, CLK doesn't work.
 107         #       (NOQUIT ? ' NOQUIT' : '').(SJ3 ? ' SJOIN SJOIN2 SJ3' : '').
 108         #       (NICKIP ? ' NICKIP' : '').
 109         #       (SJB64 ? ' SJB64 NS VL' : ''),
 110         #CONNECTCRAP
 111         ircsendimm(     'PASS :'.$main_conf{pass},
 112                 'SERVER '.$main_conf{local}.' ' . $main_conf{pass} . ' 0 ' .$main_conf{numeric} . ' ' .$main_conf{info} );
 113         ircsendimm ('BURST ' .time);
 114         %preconnect_defer_mode = %defer_mode;
 115         %defer_mode = ();
 116 }
 117
 118 # Helper Functions
 119
 120 sub handle_server($$$$;$$$) {
 121 # This is mostly a stub function, but we may need the $unreal_protocol_version
 122 # at a later date. Plus we may want to maintain a server tree in another module.
 123         my ($src_server, $server_name, $num_hops, $info_line, $server_numeric, $protocol_version, $build_flags) = @_;
 124         $unreal_protocol_version = $protocol_version if defined $protocol_version;
 125 }
 126
 127
 128
 129 # Handler functions
 130 sub pong($$$) {
 131     my ($src, $cookie, $dst) = @_;
 132         # This will only make sense if you remember that
 133         # $src is where it came from, $dst is where it went (us)
 134         # we're basically bouncing it back, but changing from PING to PONG.
 135         if (defined($dst) and defined($cookie)) {
 136                 # $dst is always $main_conf{local} anyway...
 137                 # this is only valid b/c we never have messages routed THROUGH us
 138                 # we are always an end point.
 139                 ircsendimm(":$dst $tkn{PONG}[$tkn] $src :$cookie");
 140         }
 141         else {
 142                 ircsendimm("$tkn{PONG}[$tkn] :$src");
 143         }
 144 }
 145 sub endburst {
 146         print "GOT ENDBURST\n\n";
 147         ircd_flush_queue();
 148         ircsendimm ("ENDBURST");
 149         $ircd_ready = 1; #!
 150 }
 151 sub eos {
 152         print "GOT EOS\n\n";
 153
 154         #foreach my $k (keys %servers) {
 155         #       print "Server: $k ircline: ",$servers{$k}[0], " state: ", $servers{$k}[1], "\n";
 156         #}
 157         #print "Synced: ", synced(), "\n\n";
 158         #exit;
 159
 160         ircsendimm(':'.$main_conf{local}.' '.$tkn{EOS}[$tkn], 'VERSION');
 161
 162         agent_sync();
 163         flushmodes(\%preconnect_defer_mode);
 164         ircd_flush_queue();
 165
 166         $ircd_ready = 1;
 167 }
 168
 169 sub netinfo($$$$$$$$) {
 170         ircsendimm($tkn{NETINFO}[$tkn].' 0 '.time." $_[2] $_[3] 0 0 0 :$_[7]");
 171         $main_conf{network} = $_[7];
 172 }
 173
 174 sub tssync {
 175         ircsendimm((SJB64 ? '@'.itob64($main_conf{numeric}) : ':'.$main_conf{local})." $tkn{TSCTL}[$tkn] SVSTIME ".time);
 176 }
 177
 178 sub parse_sjoin($$$$) {
 179         my ($server, $ts, $cn, $parms) = @_;
 180         my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
 181
 182         $server = '' unless $server;
 183
 184         if($parms =~ /^:(.*)/) {
 185                 $blobs = $1;
 186         } else {
 187                 ($chmodes, $blobs) = split(/ :/, $parms, 2);
 188                 ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
 189         }
 190         @blobs = split(/ /, $blobs);
 191
 192         foreach my $x (@blobs) {
 193                 if($x =~ /^(\&|\"|\')(.*)$/) {
 194                         my $type;
 195                         push @bans, $2 if $1 eq '&';
 196                         push @excepts, $2 if $1 eq '"';
 197                         push @invex, $2 if $1 eq "\'";
 198                 } else {
 199                         $x =~ /^([*~@%+]*)(.*)$/;
 200                         my ($prefixes, $nick) = ($1, $2);
 201                         my @prefixes = split(//, $prefixes);
 202                         my $op;
 203                         foreach my $prefix (@prefixes) {
 204                                 $op |= $opmodes{q} if ($prefix eq '*');
 205                                 $op |= $opmodes{a} if ($prefix eq '~');
 206                                 $op |= $opmodes{o} if ($prefix eq '@');
 207                                 $op |= $opmodes{h} if ($prefix eq '%');
 208                                 $op |= $opmodes{v} if ($prefix eq '+');
 209                         }
 210
 211                         push @users, { NICK => $nick, __OP => $op };
 212                 }
 213         }
 214
 215         return ($server, $cn, $ts, $chmodes, $chmodeparms, \@users, \@bans, \@excepts, \@invex);
 216 }
 217
 218 # Send Functions
 219
 220 sub kick($$$$) {
 221         my ($src, $chan, $target, $reason) = @_;
 222         $src = $main_conf{local} unless initial_synced();
 223         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 224         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 225         ircsend(":$srcId $tkn{KICK}[$tkn] $chan $targetId :$reason");
 226         callfuncs('KICK', 0, 2, [$srcId, $chan, $targetId, $reason]);
 227 }
 228
 229 sub invite($$$) {
 230         my ($src, $chan, $target) = @_;
 231         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 232         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 233         ircsend(":$srcId $tkn{INVITE}[$tkn] $targetId $chan 0");
 234 }
 235
 236 sub ping {
 237 #       if(@_ == 1) {
 238                 ircsend(':'.$main_conf{local}.' '.$tkn{PING}[$tkn].' :'.$main_conf{local});
 239 #       } else {
 240 #               ircsend(':'.$_[2].' '.$tkn{PONG}[$tkn].' '.$_[0].' :'.$_[1]);
 241 #       }
 242 }
 243
 244 sub privmsg($$@) {
 245         my ($src, $dst, @msgs) = @_;
 246         my @bufs;
 247         foreach my $buf (@msgs) {
 248                 # 3 spaces, two colons, PRIVMSG=7
 249                 # Length restrictions are for CLIENT Protocol
 250                 # hence the (MASKLEN - (NICKLEN + 1))
 251                 # Technically optimizable if we use $agent{lc $src}'s ident and host
 252                 my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
 253                 push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
 254         }
 255         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 256
 257         # submit a list of messages as a single packet to the server
 258         ircsend(":$srcId $tkn{PRIVMSG}[$tkn] $dst :".join("\r\n".":$src $tkn{PRIVMSG}[$tkn] $dst :", @bufs));
 259         callfuncs('LOOP_PRIVMSG', 0, 1, [$src, $dst, \@bufs]);
 260 }
 261
 262 sub debug(@) {
 263         my (@msgs) = @_;
 264         debug_privmsg($main_conf{local}, $main_conf{diag}, @msgs);
 265         write_log('diag', '<'.$main_conf{local}.'>', @msgs);
 266 }
 267 sub write_log () { }
 268 sub debug_nolog(@) {
 269         my (@msgs) = @_;
 270         debug_privmsg($main_conf{local}, $main_conf{diag}, @msgs);
 271 }
 272
 273 sub debug_privmsg($$@) {
 274         my ($src, $dst, @msgs) = @_;
 275
 276         my @bufs;
 277         foreach my $buf (@msgs) {
 278                 # 3 spaces, two colons, PRIVMSG=7
 279                 # Length restrictions are for CLIENT Protocol
 280                 # hence the (MASKLEN - (NICKLEN + 1))
 281                 my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
 282                 push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
 283         }
 284
 285         # submit a list of messages as a single packet to the server
 286         ircsendimm(":$src $tkn{PRIVMSG}[$tkn] $dst :".join("\r\n".":$src $tkn{PRIVMSG}[$tkn] $dst :", @bufs));
 287         callfuncs('LOOP_PRIVMSG', 0, 1, [$src, $dst, \@bufs]);
 288 }
 289
 290 sub notice($$@) {
 291         my ($src, $dst, @msgs) = @_;
 292         my $target = $dst; #lazy erry
 293         my @bufs;
 294         foreach my $buf (@msgs) {
 295                 # 3 spaces, two colons, NOTICE=6
 296                 # Length restrictions are for CLIENT Protocol
 297                 # hence the (MASKLEN - (NICKLEN + 1))
 298                 my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
 299                 push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
 300         }
 301         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 302         my $targetId;
 303         if (ref ($dst) eq "HASH") { #User Object
 304                 $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 305         }
 306         else { # /notice #channel This probably sucks. Blame erry :(
 307                 $targetId = $dst;
 308         }
 309         print "targid $targetId\n";
 310         ircsend(":$srcId $tkn{NOTICE}[$tkn] $targetId :".join("\r\n".":$srcId $tkn{NOTICE}[$tkn] $targetId :", @bufs));
 311         callfuncs('LOOP_NOTICE', 0, 1, [$srcId, $targetId, \@bufs]);
 312 }
 313
 314 sub ctcp($$@) {
 315         my ($src, $dst, $cmd, @toks) = @_;
 316         my $target = $dst; #lazy erry
 317         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 318         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 319         privmsg($srcId, $targetId, "\x01".join(' ', ($cmd, @toks))."\x01");
 320 }
 321
 322 sub ctcp_reply($$@) {
 323         my ($src, $dst, $cmd, @toks) = @_;
 324         my $target = $dst; #lazy erry
 325         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 326         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 327         notice($srcId, $targetId, "\x01".join(' ', ($cmd, @toks))."\x01");
 328 }
 329
 330 sub setumode($$$) {
 331         my ($src, $dst, $modes) = @_;
 332         my $target = $dst; #lazy erry
 333         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 334         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 335         ircsend(":$srcId $tkn{SVSMODE}[$tkn] $targetId $modes");
 336         callfuncs('UMODE', 0, undef, [$dst, $modes]);
 337 }
 338
 339 sub setsvsstamp($$$) {
 340         my ($src, $dst, $stamp) = @_;
 341
 342         ircsend(":$src $tkn{SVS2MODE}[$tkn] $dst +d $stamp");
 343         # This function basically set the svsstamp to
 344         # be the same as the userid. Not all ircd will
 345         # support this function.
 346         # We obviously already know the userid, so don't
 347         # use a callback here.
 348         #callfuncs('UMODE', 0, undef, [$dst, $modes]);
 349 }
 350
 351 sub setagent_umode($$) {
 352         my ($src, $modes) = @_;
 353         ircsend(":$src $tkn{UMODE2}[$tkn] $modes");
 354 }
 355
 356 sub setmode2($$@) {
 357         my ($src, $dst, @modelist) = @_;
 358         #debug(" --", "-- ircd::setmode2: ".$_[0], split(/\n/, Carp::longmess($@)), " --");
 359         foreach my $modetuple (@modelist) {
 360                 my $target = $modetuple->[1];
 361                 setmode($src, $dst, $modetuple->[0], $modetuple->[1]);
 362         }
 363 }
 364 sub ban_list($$$$@) {
 365 # Convenience function for lots of bans or excepts.
 366         my ($src, $cn, $sign, $mode, @parms) = @_;
 367         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 368         my @masklist;
 369         foreach my $mask (@parms) {
 370                 push @masklist, [( ($sign >= 1) ? '+' : '-').$mode, $mask];
 371         }
 372         ircd::setmode2($srcId, $cn, @masklist);
 373 }
 374
 375 sub setmode($$$;$) {
 376         my ($src, $dst, $modes, $target) = @_;
 377         my $srcId;
 378         if (initial_synced()) {
 379                 $srcId = ($src->{ID}?$src->{ID}:($src->{UUID}?$src->{UUID}:$src->{NICK}));
 380         }
 381         else {
 382                 $src = $main_conf{numeric};
 383                 $srcId = $src;
 384         }
 385         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 386         callfuncs('MODE', undef, 1, [$srcId, $dst, $modes, $targetId]);
 387         #print "$ircline -- setmode($srcId, $dst, $modes, $targetId)\n" ;
 388         ircsend(":$srcId MODE $dst $modes $targetId");
 389 }
 390
 391 sub setmode_many($$$;@) {
 392         my ($src, $dst, $modes, @targets) = @_;
 393         my $srcId;
 394         if (initial_synced()) {
 395                 $srcId = ($src->{ID}?$src->{ID}:($src->{UUID}?$src->{UUID}:$src->{NICK}));
 396         }
 397         else {
 398                 $src = $main_conf{local};
 399                 $srcId = $src;
 400         }
 401         my $parms = "";
 402         foreach my $target (@targets) {
 403                 my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 404                 $parms .= ($parms == ""?"":" ") . $targetId;
 405         }
 406         callfuncs('MODE', undef, 1, [$srcId, $dst, $modes, $parms]);
 407         print "$ircline -- setmode($srcId, $dst, $modes, $parms)\n" ;
 408         ircsend(":$srcId MODE $dst $modes $parms");
 409 }
 410
 411
 412 sub flushmodes(;$) {
 413         my $dm = (shift or \%defer_mode);
 414         my @k = keys(%$dm); my @v = values(%$dm);
 415         for(my $i; $i<@k; $i++) {
 416                 my ($src, $dst) = split(/ /, $k[$i]);
 417                 my @m = @{$v[$i]};
 418                 foreach my $m (@m) {
 419                         my ($modes, $parms) = split(/ /, $m, 2);
 420                         setmode_real($src, $dst, $modes, $parms);
 421                 }
 422         }
 423         %$dm = ();
 424 }
 425
 426 sub setmode_real($$$;$) {
 427         my ($src, $dst, $modes, $parms) = @_;
 428         print "$ircline -- setmode_real($src, $dst, $modes, $parms)\n";
 429         # for server sources, there must be a timestamp. but you can put 0 for unspecified.
 430         $parms =~ s/\s+$//; #trim any trailing whitespace, as it might break the simple parser in the ircd.
 431
 432         ircsend(":$src ".$tkn{MODE}[$tkn]." $dst $modes".($parms?" $parms":'').($src =~ /\./ ? ' 0' : ''));
 433 }
 434
 435 sub settopic($$$$$) {
 436         my ($src, $chan, $setter, $time, $topic) = @_;
 437         $src = $main_conf{numeric} unless initial_synced();
 438         #>> 38 :583AAAAAF TOPIC #erry :Welcome to erry(world|net). Have a cookie.
 439         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 440         ircsend(":$srcId ".$tkn{TOPIC}[$tkn]." $chan :$topic");
 441         callfuncs('TOPIC', undef, undef, [$srcId, $chan, $setter, $time, $topic]);
 442 }
 443
 444 sub wallops ($$) {
 445         my ($src, $message) = @_;
 446         ircsend(":$src $tkn{WALLOPS}[$tkn] :$message");
 447 }
 448
 449 sub globops ($$) {
 450         my ($src, $message) = @_;
 451         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 452         ircsend(":$srcId $tkn{GLOBOPS}[$tkn] :$message");
 453 }
 454
 455 sub kline ($$$$$) {
 456     my ($setter, $ident, $host, $expiry, $reason) = @_;
 457         $setter = $main_conf{local} unless defined($setter);
 458         $ident = '*' unless defined($ident);
 459         # you need to use ADDLINE for this. GLINE is a user command
 460     # format is
 461     #>> 47 :583AAAAAA ADDLINE G test@testie inspircd.erry.omg 1308118489 0 :hi
 462     #NOTE FOR ALL ADDLINES:
 463     #note that you need to provide expiry alone, not expiry +time
 464     #otherwise you will end up with insanely long bans
 465     my $setId = getUuid($setter);
 466     if ($setId) { $setter = $setId; }
 467     my $line = ":$setter ADDLINE G $ident\@$host " . $main_conf{local} . " ". time() . " " . ($expiry)." :$reason";
 468         ircsend($line);
 469         #return ($type, +1, $ident, $host, $setter, $expire, $time, $reason);
 470         callfuncs('TKL', undef, undef, [parse_addline($line)]);
 471 }
 472
 473 sub unkline ($$$) {
 474         my ($setter, $ident, $host) = @_;
 475         my $line = "TKL - G $ident $host $setter";
 476         my $setId = getUuid($setter);
 477     if ($setId) { $setter = $setId; }
 478         #:583AAAAAE DELLINE G test@test.com
 479         my $line = ":$setter DELLINE G $ident\@$host";
 480         ircsend($line);
 481         callfuncs('TKL', undef, undef, [parse_delline($line)]);
 482 }
 483
 484 sub zline ($$$$) {
 485         my ($setter, $host, $expiry, $reason) = @_;
 486         $setter=$main_conf{local} unless defined($setter);
 487         my $setId = getUuid($setter);
 488     if ($setId) { $setter = $setId; }
 489     #:583AAAAAE ADDLINE Z test.com inspircd.erry.omg 1308216407 0 :go away
 490         my $line = ":$setter ADDLINE Z $host " . $main_conf{local} . " ". time() . " " . ($expiry)." :$reason";
 491         ircsend($line);
 492         callfuncs('TKL', undef, undef, [parse_addline($line)]);
 493 }
 494
 495 sub unzline ($$) {
 496         my ($setter, $host) = @_;
 497         my $setId = getUuid($setter);
 498     if ($setId) { $setter = $setId; }
 499         my $line = ":$setter DELLINE Z $host";
 500         ircsend($line);
 501         callfuncs('TKL', undef, undef, [parse_delline($line)]);
 502 }
 503
 504 sub spamfilter($$$$$$$) {
 505 # Note the hardcoded zero (0).
 506 # Looks like theoretically one can have expirable spamfilters.
 507 # This is untested however.
 508         my ($sign, $tkl_target, $tkl_action, $setter, $bantime, $reason, $regex) = @_;
 509         my $tkl = "TKL ".($sign ? '+' : '-' )." F $tkl_target $tkl_action $setter 0 ".time()." $bantime $reason :$regex";
 510         ircsend($tkl);
 511         callfuncs('TKL', undef, undef, [parse_tkl($tkl)]);
 512 }
 513
 514 sub update_userkill($) {
 515         my ($target) = @_;
 516
 517         # This is a simple way to do it, that _could_ be defeated
 518         # with enough users getting killed at once.
 519         # The alternative would require a timer to expire the old entries.
 520         return undef if (time() == $userkill[1] and $target eq $userkill[0]);
 521         @userkill = ($target, time());
 522
 523         return 1;
 524 }
 525
 526 sub irckill($$$) {
 527         my ($src, $target, $reason) = @_;
 528         $src = $main_conf{local} unless initial_synced();
 529         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 530         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 531         my $srcNick = $target->{NICK};
 532         return 0 unless update_userkill($targetId);
 533         ircsendimm(":$srcId ".$tkn{KILL}[$tkn]." $targetId :$srcNick ($reason)");
 534         callfuncs('KILL', 0, 1, [$srcId, $targetId, $srcNick, $reason]);
 535 }
 536
 537 sub svssno($$$) {
 538     my ($src, $target, $snomasks) = @_;
 539     $src=$main_conf{local} unless defined($src);
 540     # TODO:
 541     # None, this doesn't affect us.
 542
 543     # SVSSNO is not in tokens.txt nor msg.h
 544     ircsend(":$src ".'SVS2SNO'." $target $snomasks ".time);
 545 }
 546
 547 sub svsnick($$$) {
 548     my ($src, $target, $newnick) = @_;
 549     $src=$main_conf{local} unless defined($src);
 550     # note: we will get a NICK cmd back after a
 551     # successful nick change.
 552     # warning, if misused, this can KILL the user
 553     # with a collision
 554     my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 555         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 556     ircsend(":$srcId ".$tkn{SVSNICK}[$tkn]." $targetId $newnick ".time);
 557 }
 558
 559 sub svsnoop($$$) {
 560     my ($targetserver, $bool, $src) = @_;
 561     $src = $main_conf{local} unless defined($src);
 562     if ($bool > 0) { $bool = '+'; } else { $bool = '-'; }
 563 #this is SVS NO-OP not SVS SNOOP
 564     ircsend(":$main_conf{local} $tkn{SVSNOOP}[$tkn] $targetserver $bool");
 565 }
 566
 567 #START TODO - erry
 568
 569 sub svswatch ($$@) {
 570 # Changes the WATCH list of a user.
 571 # Syntax: SVSWATCH <nick> :<watch parameters>
 572 # Example: SVSWATCH Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
 573 # *** We do not track this info nor care.
 574         my ($src, $target, @watchlist) = @_;
 575         my $base_str = ":$src ".$tkn{SVSWATCH}[$tkn]." $target :";
 576         my $send_str = $base_str;
 577         while (@watchlist) {
 578                 my $watch = shift @watchlist;
 579                 if (length("$send_str $watch") > MAXBUFLEN) {
 580                         ircsend($send_str);
 581                         $send_str = $base_str;
 582                 }
 583                 $send_str = "$send_str $watch";
 584         }
 585         ircsend($send_str);
 586 }
 587
 588 sub svssilence ($$@) {
 589 # Changes the SILENCE list of a user.
 590 # Syntax: SVSSILENCE <nick> :<silence parameters>
 591 # Example: SVSSILENCE Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
 592 # *** We do not track this info nor care.
 593         my ($src, $target, @silencelist) = @_;
 594         my $base_str = ":$src ".$tkn{SVSSILENCE}[$tkn]." $target :";
 595         my $send_str = $base_str;
 596         while (@silencelist) {
 597                 my $silence = shift @silencelist;
 598                 if (length("$send_str $silence") > MAXBUFLEN) {
 599                         ircsend($send_str);
 600                         $send_str = $base_str;
 601                 }
 602                 $send_str = "$send_str $silence";
 603         }
 604         ircsend($send_str);
 605 }
 606
 607 sub svso($$$) {
 608 # Gives nick Operflags like the ones in O:lines.
 609 # SVSO <nick> <+operflags> (Adds the Operflags)
 610 # SVSO <nick> - (Removes all O:Line flags)
 611 # Example: SVSO SomeNick +bBkK
 612 # *** We do not track this info nor care.
 613 # *** We will see any umode changes later.
 614 # *** this cmd does not change any umodes!
 615
 616     my ($src, $target, $oflags) = @_;
 617     $src = $main_conf{local} unless defined($src);
 618     ircsend(":$src $tkn{SVSO}[$tkn] $target $oflags");
 619
 620 }
 621
 622 sub swhois($$$) {
 623 # *** We do not track this info nor care.
 624     my ($src, $target, $swhois) = @_;
 625     $src = $main_conf{local} unless defined($src);
 626     ircsend(":$src $tkn{SWHOIS}[$tkn] $target :$swhois");
 627 }
 628 #END TODO - erry
 629
 630 sub svsjoin($$@) {
 631         my ($src, $target, @chans) = @_;
 632         while(my @chanList = splice(@chans, 0, 10)) {
 633         # split into no more than 10 at a time.
 634                 __svsjoin($src, $target, @chanList);
 635         }
 636 }
 637
 638 sub __svsjoin($$@) {
 639     my ($src, $target, @chans) = @_;
 640     # a note. a JOIN is returned back to us on success
 641     # so no need to process this command.
 642     # similar for svspart.
 643     my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 644         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 645     ircsend(($srcId?":$srcId":'')." $tkn{SVSJOIN}[$tkn] $targetId ".join(',', @chans));
 646 }
 647
 648 sub svspart($$$@) {
 649     my ($src, $target, $reason, @chans) = @_;
 650     my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 651         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 652     ircsend(($srcId ? ":$srcId" : '')." $tkn{SVSPART}[$tkn] $targetId ".join(',', @chans).
 653         ($reason ? " :$reason" : ''));
 654 }
 655
 656 sub sqline ($;$) {
 657 # we need to sqline most/all of our agents.
 658 # tho whether we want to put it in agent_connect
 659 # or leave it to the module to call it...
 660         my ($nickmask, $reason) = @_;
 661         #ircsend("$tkn{S1QLINE}[$tkn] $nickmask".($reason?" :$reason":''));
 662         qline($nickmask, 0, $reason);
 663 }
 664
 665 sub svshold($$$) {
 666         my ($nickmask, $expiry, $reason) = @_;
 667         #:583AAAAAA ADDLINE Q hell3o inspircd.erry.omg 1308295479 600 :Bye Bye
 668         my $line = ':' . $main_conf{numeric} . ' ADDLINE Q '.$nickmask.' '.$main_conf{local}.' '. time() . ' ' . ($expiry ? $expiry : 0 ) . ' :'.$reason;
 669         ircsend($line);
 670         callfuncs('TKL', undef, undef, [parse_addline($line)]);
 671 }
 672
 673 sub svsunhold($) {
 674         my ($nickmask) = @_;
 675         #>> 37 :583AAAAAA DELLINE Q errietta3
 676         my $line = ":" . $main_conf{numeric} . ' DELLINE Q ' . $nickmask . "\n";
 677         ircsend($line);
 678         callfuncs('TKL', undef, undef, [parse_tkl($line)]);
 679 }
 680
 681 sub qline($$$) {
 682         my ($nickmask, $expiry, $reason) = @_;
 683         #:583AAAAAA ADDLINE Q hell3o inspircd.erry.omg 1308295479 600 :Bye Bye
 684
 685         my $line = ':' . $main_conf{numeric} . ' ADDLINE Q '.$nickmask . ' ' . $main_conf{local} . ' '. time() . ' ' . ($expiry ? $expiry : 0).' :'.$reason;
 686         ircsend($line);
 687
 688         # at startup we send these too early,
 689         # before the handlers are initialized
 690         # so they may be lost.
 691         callfuncs('TKL', undef, undef, [parse_tkl($line)]);
 692 }
 693
 694 sub unsqline ($) {
 695 # we need to sqline most/all of our agents.
 696 # tho whether we want to put it in agent_connect
 697 # or leave it to the module to call it...
 698         my ($nickmask) = @_;
 699         unqline($nickmask);
 700 }
 701
 702 sub unqline($) {
 703         my ($nickmask) = @_;
 704 # TKL version
 705 # TKL - Q * test services.SC.net
 706         my $line = 'TKL - Q * '.$nickmask.' '.$main_conf{local};
 707         ircsend($line);
 708         callfuncs('TKL', undef, undef, [parse_tkl($line)]);
 709 }
 710
 711 sub svskill($$$) {
 712         my ($src, $target, $reason) = @_;
 713         # SVSKILL requires a src, it will NOT work w/o one.
 714         # not sure if it'll accept a servername or not.
 715         # consider defaulting to ServServ
 716         die('svskill called w/o $src') unless $src;
 717         ircsend(':'.$src.' '.$tkn{SVSKILL}[$tkn].' '.$target.' :'.$reason);
 718         callfuncs('QUIT', 0, undef, [$target, $reason]);
 719 }
 720
 721 sub version($) {
 722         my ($src) = @_;
 723         #ircsend(":$main_conf{local} 351 $src $main::progname ver $main::version $main_conf{local} ".
 724         #       $main::extraversion);
 725 }
 726
 727 sub userhost($) {
 728         my ($target) = @_;
 729         ircsend($tkn{USERHOST}[$tkn]." $target");
 730 }
 731
 732 sub userip($) {
 733         my ($target) = @_;
 734         die "We're not supposed to use USERIP anymore!" if DEBUG and NICKIP;
 735         ircsend(":$main::rsnick USERIP $target");
 736 }
 737
 738 sub chghost($$$) {
 739         my ($src, $target, $vhost) = @_;
 740     my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 741         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 742         ircsend(($srcId?":$srcId ":'').$tkn{CHGHOST}[$tkn]." $targetId $vhost");
 743         callfuncs('CHGHOST', 0, 1, [$srcId, $targetId, $vhost]);
 744 }
 745
 746 sub chgident($$$) {
 747         my ($src, $target, $ident) = @_;
 748     my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 749         my $targetId = ($target->{ID}?encodeUUID($target->{ID}):$target->{NICK});
 750         ircsend(($src?":$srcId ":'').$tkn{CHGIDENT}[$tkn]." $targetId $ident");
 751         callfuncs('CHGIDENT', 0, 1, [$srcId, $targetId, $ident]);
 752 }
 753
 754 sub jupe_server($$) {
 755         my ($server, $reason) = @_;
 756
 757         # :nascent.surrealchat.net SERVER wyvern.surrealchat.net 2 :SurrealChat
 758         die "You can't jupe $server"
 759                 if ((lc($server) eq lc($remoteserv)) or (lc($server) eq lc($main_conf{local})));
 760         ircsend(':'.$main_conf{local}.' '.$tkn{SQUIT}[$tkn]." $server :");
 761         ircsend(':'.$main_conf{local}.' '.$tkn{SERVER}[$tkn]." $server 2 :$reason");
 762
 763         set_server_juped($server);
 764 }
 765 sub agent_dojoin($$) {
 766         my ($agent, $chan) = @_;
 767         print "DOJOIN " . Dumper ($agent);
 768         my $srcId;
 769         if (ref($agent) ne "HASH") {
 770                 $srcId = getUuid($agent);
 771                 if (!$srcId) {
 772                         $srcId = $agent;
 773                 }
 774                 print "SRCID " . Dumper($srcId);
 775         }
 776         else {
 777                 my $src = $agent;
 778                 $srcId = ($src->{ID}?$src->{ID}:($src->{UUID}?$src->{UUID}:$src->{NICK}));
 779         }
 780         ircsend(":" . $srcId .  " JOIN " . $chan);
 781 }
 782
 783 sub agent_dopart ($$$) {
 784         my ($agent, $chan, $reason) = @_;
 785         my $srcId;
 786         if (ref($agent) ne "HASH") {
 787                 $srcId = getUuid($agent);
 788                 if (!$srcId) {
 789                         $srcId = $agent;
 790                 }
 791         }
 792         else {
 793                 my $src = $agent;
 794                 $srcId = ($src->{ID}?$src->{ID}:($src->{UUID}?$src->{UUID}:$src->{NICK}));
 795         }
 796         ircsend(":$srcId $tkn{PART}[$tkn] $chan :$reason");
 797 }
 798 sub rehash_all_servers(;$) {
 799         my ($type) = @_;
 800
 801         # Validate the type before passing it along.
 802         # Very IRCd specific! May be version specific.
 803         $type = undef() if(defined($type) && !($type =~ /^\-(motd|botmotd|opermotd|garbage)$/i));
 804
 805         foreach my $server (get_online_servers()) {
 806                 ircsend(':'.$main::rsnick.' '.$tkn{REHASH}[$tkn].' '.$server.(defined($type) ? ' '.$type : '') );
 807         }
 808 }
 809
 810 sub unban_nick($$@) {
 811 # This is an Unreal-specific server-protocol HACK.
 812 # It is not expected to be portable to other ircds.
 813 # Similar concepts may exist in other ircd implementations
 814         my ($src, $cn, @nicks) = @_;
 815         my $srcId = ($src->{ID}?$src->{ID}:$src->{NICK});
 816         my $i = 0; my @nicklist = ();
 817         while(my $nick = shift @nicks) {
 818                 push @nicklist, $nick;
 819                 if(++$i >= 10) {
 820                         ircsend(($src ? ":$src " : '' ).$tkn{SVSMODE}[$tkn]." $cn -".'b'x($i).' '.join(' ', @nicklist));
 821                         $i = 0; @nicklist = ();
 822                 }
 823         }
 824
 825         ircsend(($srcId ? ":$srcId " : '' ).$tkn{SVSMODE}[$tkn]." $cn -".'b'x($i).' '.join(' ', @nicklist));
 826         # We don't loopback this, as we'll receive back the list
 827         # of removed bans.
 828 }
 829
 830 sub clear_bans($$) {
 831 # This is an Unreal-specific server-protocol HACK.
 832 # It is not expected to be portable to other ircds.
 833 # Similar concepts may exist in other ircd implementations
 834         my ($src, $cn) = @_;
 835
 836         ircsend(($src ? ":$src " : '' ).$tkn{SVSMODE}[$tkn]." $cn -b");
 837         # We don't loopback this, as we'll receive back the list
 838         # of removed bans.
 839 }
 840
 841 # HostServ OFF would want this.
 842 # resets the vhost to be the cloakhost.
 843 sub reset_cloakhost($$) {
 844         my ($src, $target) = @_;
 845         setumode($src, $target, '-x+x'); # only works in 3.2.6.
 846 }
 847
 848 # removes the cloakhost, so that vhost matches realhost
 849 sub disable_cloakhost($$) {
 850         my ($src, $target) = @_;
 851         setumode($src, $target, '-x'); # only works in 3.2.6.
 852 }
 853
 854 # enables the cloakhost, so that vhost becomes the cloakhost
 855 sub enable_cloakhost($$) {
 856         my ($src, $target) = @_;
 857         setumode($src, $target, '+x'); # only works in 3.2.6.
 858 }
 859
 860 sub agent_doconn ($$$$$) {
 861         my ($nick, $ident, $host, $modes, $gecos) = @_;
 862         my $char = chr($count);
 863         my $uuid = $main_conf{numeric} . "AAAAA" . $char; #FIXME - erry
 864         ircsend(":" . $main_conf{numeric} . " UID" . " $uuid " . time . " $nick $host $host $ident 127.0.0.1 ". (time+5) . " $modes " . ":$gecos" );
 865         setUuid($nick,$uuid);
 866         setRevUuid($uuid, $nick);
 867         $count++;
 868 }
 869
 870 sub nolag($$@) {
 871         my ($src, $sign, @targets) = @_;
 872         $src = $main_conf{local} unless $src;
 873         foreach my $target (@targets) {
 874                 ircsend(':'.$src .' '.$tkn{SVS2NOLAG}[$tkn].' '.$sign.' '.$target);
 875         }
 876 }
 877
 878 1;