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