1 # This file is part of SurrealServices.
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.
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.
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
24 use SrSv
::Conf
'main';
26 use SrSv
::Conf2Consts
qw( main );
29 use Exporter
'import';
30 our @EXPORT = qw
(agent_doconn getUuid getRevUuid setUuid setRevUuid
);
35 # These appear to match the implementations I've seen, but are unspecified in the RFCs.
36 # They may vary by implementation.
37 NICKLEN
=> 30, # some ircds are different. hyperion is 16.
38 IDENTLEN
=> 10, # Sometimes 8 or 9.
39 # hyperion may break this due to it's ident format: [ni]=identhere, like this n=northman
40 HOSTLEN
=> 63, # I think I've seen 64 here before.
41 MASKLEN
=> 30 + 10 + 63 + 2, # 105, or maybe 106. the 2 constant is for !@
43 CHANNELLEN
=> 32, # From 005 reply. hyperion is 30.
51 PREFIXAQ_DISABLE
=> 0,
53 die "NICKIP must be enabled if CLK is\n" if CLK
&& !NICKIP
;
55 use SrSv
::IRCd
::IO
qw(ircd_connect ircsend ircsendimm ircd_flush_queue);
56 use SrSv
::IRCd
::Event
qw(addhandler callfuncs);
57 use SrSv
::IRCd
::State
qw($ircline $remoteserv $ircd_ready synced initial_synced set_server_state set_server_juped get_server_state get_online_servers);
59 use SrSv
::Unreal
::Modes
qw(@opmodes %opmodes $scm $ocm $acm);
60 use SrSv
::Unreal
::Tokens
;
61 use SrSv
::IRCd
::Parse
qw(parse_tkl parse_addline);
62 use SrSv
::Unreal
::Base64
qw(itob64 b64toi);
64 use SrSv
::Text
::Format
qw( wordwrap );
68 use SrSv
::Process
::InParent
qw(update_userkill);
71 our %preconnect_defer_mode;
73 our $unreal_protocol_version;
75 our %uuids; #NickServ -> AAAAAA
76 our %reverse_uuids; #AAAAA -> NickServ
77 addhandler
('SEOS', undef(), undef(), 'ircd::eos', 1);
78 addhandler
('NETINFO', undef(), undef(), 'ircd::netinfo', 1);
79 addhandler
('VERSION', undef(), undef(), 'ircd::version', 1);
80 addhandler
('SERVER', undef(), undef(), 'ircd::handle_server', 1);
81 sub getAgentRevUuid
($) {
87 sub setAgentRevUuid
($$) {
89 sub setAgentUuid
($$) {
93 my $remote = main_conf_remote
;
94 my $port = main_conf_port
;
96 ircd_connect
($remote, $port);
98 ircsendimm
('PROTOCTL '.(main_conf_tokens
? 'TOKEN ' : '').'NICKv2 UMODE2 TKLEXT'.
99 (CLK
? ' CLK' : ' VHP'). # CLK obsoletes VHP. Plus if you leave VHP on, CLK doesn't work.
100 (NOQUIT
? ' NOQUIT' : '').(SJ3
? ' SJOIN SJOIN2 SJ3' : '').
101 (NICKIP
? ' NICKIP' : '').
102 (SJB64
? ' SJB64 NS VL' : ''),
103 'PASS :'.main_conf_pass
,
104 'SERVER '.main_conf_local
.' 1 '.main_conf_numeric
.(SJB64
? ( ':U*-*-'.main_conf_numeric
.' ') : ' :').main_conf_info
);
106 %preconnect_defer_mode = %defer_mode;
113 sub handle_server
($$$$;$$$) {
114 # This is mostly a stub function, but we may need the $unreal_protocol_version
115 # at a later date. Plus we may want to maintain a server tree in another module.
116 my ($src_server, $server_name, $num_hops, $info_line, $server_numeric, $protocol_version, $build_flags) = @_;
117 $unreal_protocol_version = $protocol_version if defined $protocol_version;
124 my ($src, $cookie, $dst) = @_;
125 # This will only make sense if you remember that
126 # $src is where it came from, $dst is where it went (us)
127 # we're basically bouncing it back, but changing from PING to PONG.
128 if (defined($dst) and defined($cookie)) {
129 # $dst is always $main_conf{local} anyway...
130 # this is only valid b/c we never have messages routed THROUGH us
131 # we are always an end point.
132 ircsendimm
(":$dst PONG $src :$cookie");
135 ircsendimm
("PONG :$src");
141 #foreach my $k (keys %servers) {
142 # print "Server: $k ircline: ",$servers{$k}[0], " state: ", $servers{$k}[1], "\n";
144 #print "Synced: ", synced(), "\n\n";
147 ircsendimm
(':'.$main_conf{local}.' EOS');
148 ircsendimm
(':'.$main_conf{local}.' VERSION');
150 flushmodes
(\
%preconnect_defer_mode);
156 sub netinfo
($$$$$$$$) {
157 ircsendimm
('NETINFO 0 '.time." $_[2] $_[3] 0 0 0 :$_[7]");
158 $main_conf{network
} = $_[7];
162 ircsendimm
((SJB64
? '@'.itob64
($main_conf{numeric
}) : ':'.$main_conf{local})." TSCTL SVSTIME ".time);
165 sub parse_sjoin
($$$$) {
166 my ($server, $ts, $cn, $parms) = @_;
167 my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
169 $server = '' unless $server;
171 if($parms =~ /^:(.*)/) {
174 ($chmodes, $blobs) = split(/ :/, $parms, 2);
175 ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
177 @blobs = split(/ /, $blobs);
179 foreach my $x (@blobs) {
180 if($x =~ /^(\&|\"|\')(.*)$/) {
182 push @bans, $2 if $1 eq '&';
183 push @excepts, $2 if $1 eq '"';
184 push @invex, $2 if $1 eq "\'";
186 $x =~ /^([*~@%+]*)(.*)$/;
187 my ($prefixes, $nick) = ($1, $2);
188 my @prefixes = split(//, $prefixes);
190 foreach my $prefix (@prefixes) {
191 $op |= $opmodes{q
} if ($prefix eq '*');
192 $op |= $opmodes{a
} if ($prefix eq '~');
193 $op |= $opmodes{o
} if ($prefix eq '@');
194 $op |= $opmodes{h
} if ($prefix eq '%');
195 $op |= $opmodes{v
} if ($prefix eq '+');
198 push @users, { NICK
=> $nick, __OP
=> $op };
202 return ($server, $cn, $ts, $chmodes, $chmodeparms, \
@users, \
@bans, \
@excepts, \
@invex);
208 my ($src, $chan, $target, $reason) = @_;
209 $src = $main_conf{local} unless initial_synced
();
210 my $srcN = $src->{NICK
};
211 my $targetN = $target->{NICK
};
212 ircsend
(":$srcN KICK $chan $targetN :$reason");
213 callfuncs
('KICK', 0, 2, [$srcN, $chan, $targetN, $reason]);
217 my ($src, $chan, $target) = @_;
218 my $srcN = $src->{NICK
};
219 my $targetN = $target->{NICK
};
220 ircsend
(":$srcN INVITE $targetN $chan 0");
225 ircsend
(':'.$main_conf{local}.' PING :'.$main_conf{local});
227 # ircsend(':'.$_[2].' '.$tkn{PONG}[$tkn].' '.$_[0].' :'.$_[1]);
232 my ($src, $dst, @msgs) = @_;
234 foreach my $buf (@msgs) {
235 # 3 spaces, two colons, PRIVMSG=7
236 # Length restrictions are for CLIENT Protocol
237 # hence the (MASKLEN - (NICKLEN + 1))
238 # Technically optimizable if we use $agent{lc $src}'s ident and host
239 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
240 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
242 my $srcN = $src->{NICK
};
243 # submit a list of messages as a single packet to the server
244 ircsend
(":$srcN PRIVMSG $dst :".join("\r\n".":$src PRIVMSG $dst :", @bufs));
245 callfuncs
('LOOP_PRIVMSG', 0, 1, [$src, $dst, \
@bufs]);
250 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
251 write_log
('diag', '<'.$main_conf{local}.'>', @msgs);
256 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
259 sub debug_privmsg
($$@) {
260 my ($src, $dst, @msgs) = @_;
263 foreach my $buf (@msgs) {
264 # 3 spaces, two colons, PRIVMSG=7
265 # Length restrictions are for CLIENT Protocol
266 # hence the (MASKLEN - (NICKLEN + 1))
267 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
268 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
271 # submit a list of messages as a single packet to the server
272 ircsendimm
(":$src PRIVMSG $dst :".join("\r\n".":$src PRIVMSG $dst :", @bufs));
273 callfuncs
('LOOP_PRIVMSG', 0, 1, [$src, $dst, \
@bufs]);
277 my ($src, $dst, @msgs) = @_;
278 my $target = $dst; #lazy erry
280 foreach my $buf (@msgs) {
281 # 3 spaces, two colons, NOTICE=6
282 # Length restrictions are for CLIENT Protocol
283 # hence the (MASKLEN - (NICKLEN + 1))
284 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
285 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
287 my $srcN = $src->{NICK
};
289 if (ref ($dst) eq "HASH") { #User Object
290 $targetN = $target->{NICK
};
292 else { # /notice #channel This probably sucks. Blame erry :(
295 ircsend
(":$srcN NOTICE $targetN :".join("\r\n".":$srcN NOTICE $targetN :", @bufs));
296 callfuncs
('LOOP_NOTICE', 0, 1, [$srcN, $targetN, \
@bufs]);
300 my ($src, $dst, $cmd, @toks) = @_;
301 my $target = $dst; #lazy erry
302 my $srcN = $src->{NICK
};
303 my $targetN = ($target->{NICK
});
304 privmsg
($srcN, $targetN, "\x01".join(' ', ($cmd, @toks))."\x01");
307 sub ctcp_reply
($$@) {
308 my ($src, $dst, $cmd, @toks) = @_;
309 my $target = $dst; #lazy erry
310 my $srcN = $src->{NICK
};
311 my $targetN = $target->{NICK
};
312 notice
($srcN, $targetN, "\x01".join(' ', ($cmd, @toks))."\x01");
316 my ($src, $dst, $modes) = @_;
317 my $target = $dst; #lazy erry
318 my $srcN = $src->{NICK
};
319 my $targetN = $target->{NICK
};
320 ircsend
(":$srcN SVSMODE $targetN $modes");
321 callfuncs
('UMODE', 0, undef, [$dst, $modes]);
324 sub setsvsstamp
($$$) {
325 my ($src, $dst, $stamp) = @_;
326 my $srcN = $src->{NICK
};
327 my $dstN = $dst->{NICK
};
328 ircsend
(":$srcN SVS2MODE $dstN +d $stamp");
329 # This function basically set the svsstamp to
330 # be the same as the userid. Not all ircd will
331 # support this function.
333 # We obviously already know the userid, so don't
334 # use a callback here.
335 #callfuncs('UMODE', 0, undef, [$dst, $modes]);
338 sub setagent_umode
($$) {
339 my ($src, $modes) = @_;
340 ircsend
(":$src UMODE2 $modes");
344 my ($src, $dst, @modelist) = @_;
345 #debug(" --", "-- ircd::setmode2: ".$_[0], split(/\n/, Carp::longmess($@)), " --");
346 foreach my $modetuple (@modelist) {
347 my $target = $modetuple->[1];
348 setmode
($src, $dst, $modetuple->[0], $modetuple->[1]);
351 sub ban_list
($$$$@) {
352 # Convenience function for lots of bans or excepts.
353 my ($src, $cn, $sign, $mode, @parms) = @_;
355 foreach my $mask (@parms) {
356 push @masklist, [( ($sign >= 1) ? '+' : '-').$mode, $mask];
358 ircd
::setmode2
($src, $cn, @masklist);
362 my ($src, $dst, $modes, $target) = @_;
364 if (initial_synced
()) {
365 if (ref($src) eq "HASH") {
366 $srcN = $src->{NICK
};
373 $src = $main_conf{local};
377 if (ref ($target) eq "HASH") {
378 $targetN = $target->{NICK
};
383 callfuncs
('MODE', undef, 1, [$srcN, $dst, $modes, $targetN]);
384 #print "$ircline -- setmode($srcId, $dst, $modes, $targetId)\n" ;
385 ircsend
(":$srcN MODE $dst $modes $targetN");
388 sub setmode_many
($$$;@) {
389 my ($src, $dst, $modes, @targets) = @_;
391 if (initial_synced
()) {
392 $srcN = $src->{NICK
};
395 $srcN = $main_conf{local};
399 foreach my $target (@targets) {
400 my $targetN = $target->{NICK
};
401 $parms .= ($parms eq ""?"":" ") . $targetN;
402 print "parms" . $parms . "\n";
404 callfuncs
('MODE', undef, 1, [$srcN, $dst, $modes, $parms]);
405 print "$ircline -- setmode($srcN, $dst, $modes, $parms)\n" ;
406 ircsend
(":$srcN MODE $dst $modes $parms");
411 my $dm = (shift or \
%defer_mode);
412 my @k = keys(%$dm); my @v = values(%$dm);
413 for(my $i; $i<@k; $i++) {
414 my ($src, $dst) = split(/ /, $k[$i]);
417 my ($modes, $parms) = split(/ /, $m, 2);
418 setmode_real
($src, $dst, $modes, $parms);
424 sub setmode_real
($$$;$) {
425 my ($src, $dst, $modes, $parms) = @_;
426 print "$ircline -- setmode_real($src, $dst, $modes, $parms)\n";
427 # for server sources, there must be a timestamp. but you can put 0 for unspecified.
428 $parms =~ s/\s+$//; #trim any trailing whitespace, as it might break the simple parser in the ircd.
430 ircsend
(":$src MODE $dst $modes".($parms?" $parms":'').($src =~ /\./ ? ' 0' : ''));
433 sub settopic
($$$$$) {
434 my ($src, $chan, $setter, $time, $topic) = @_;
436 $srcN = $main_conf{local} unless initial_synced
();
438 $srcN = $src->{NICK
};
440 ircsend
(":$srcN TOPIC $chan :$topic");
441 callfuncs
('TOPIC', undef, undef, [$srcN, $chan, $setter, $time, $topic]);
445 my ($src, $message) = @_;
446 ircsend
(":$src WALLOPS :$message");
450 my ($src, $message) = @_;
451 my $srcN = $src->{NICK
};
452 ircsend
(":$srcN GLOBOPS :$message");
456 my ($setter, $ident, $host, $expiry, $reason) = @_;
457 $setter = "srsv.erry.omg" unless defined($setter); #FIXME
458 $ident = '*' unless defined($ident);
460 if (ref ($setter) eq "HASH") {
461 $setN = $setter->{NICK
};
463 else { $setN = $setter; }
464 #:nascent.surrealchat.net TKL + G * *.testing.only tabris!northman@netadmin.SCnet.ops 1089168439 1089168434 :This is just a test.
465 my $line = "TKL + G $ident $host $setN ".($expiry + time()).' '.time()." :$reason";
468 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
471 my ($setter, $ident, $host) = @_;
472 # TKL - G ident host setter
473 # TKL - G ident *.test.dom tabris!northman@netadmin.SCnet.ops
475 if (ref ($setter) eq "HASH") {
476 $setN = $setter->{NICK
};
478 else { $setN = $setter; }
479 my $line = "TKL - G $ident $host $setN";
481 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
485 my ($setter, $host, $expiry, $reason) = @_;
487 #foreach my $ex (@except) { return 1 if $mask =~ /\Q$ex\E/i; }
490 # TKL +/- type ident host setter expiretime settime :reason
492 if (ref ($setter) eq "HASH") {
493 $setN = $setter->{NICK
};
495 else { $setN = $setter; }
496 my $line = "TKL + Z * $host $setN ".($expiry + time).' '.time." :$reason";
498 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
502 my ($setter, $host) = @_;
503 # TKL - G ident host setter
504 # TKL - G ident *.test.dom tabris!northman@netadmin.SCnet.ops
506 if (ref ($setter) eq "HASH") {
507 $setN = $setter->{NICK
};
509 else { $setN = $setter; }
510 my $line = "TKL - Z * $host $setN";
512 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
515 sub spamfilter
($$$$$$$) {
516 # Note the hardcoded zero (0).
517 # Looks like theoretically one can have expirable spamfilters.
518 # This is untested however.
519 my ($sign, $tkl_target, $tkl_action, $setter, $bantime, $reason, $regex) = @_;
520 my $tkl = "TKL ".($sign ? '+' : '-' )." F $tkl_target $tkl_action $setter 0 ".time()." $bantime $reason :$regex";
522 callfuncs
('TKL', undef, undef, [parse_tkl
($tkl)]);
525 sub update_userkill
($) {
528 # This is a simple way to do it, that _could_ be defeated
529 # with enough users getting killed at once.
530 # The alternative would require a timer to expire the old entries.
531 return undef if (time() == $userkill[1] and $target eq $userkill[0]);
532 @userkill = ($target, time());
538 my ($src, $target, $reason) = @_;
539 $src = $main_conf{local} unless initial_synced
();
540 my $srcN = $src->{NICK
};
541 my $targetN = $target->{NICK
};
542 return 0 unless update_userkill
($targetN);
543 ircsendimm
(":$srcN KILL $targetN ($reason)");
544 callfuncs
('KILL', 0, 1, [$srcN, $targetN, $srcN, $reason]);
548 my ($src, $target, $snomasks) = @_;
549 $src=$main_conf{local} unless defined($src);
551 # None, this doesn't affect us.
553 # SVSSNO is not in tokens.txt nor msg.h
554 ircsend
(":$src ".'SVS2SNO'." $target $snomasks ".time);
558 my ($src, $target, $newnick) = @_;
559 $src=$main_conf{local} unless defined($src);
560 # note: we will get a NICK cmd back after a
561 # successful nick change.
562 # warning, if misused, this can KILL the user
564 my $srcN = $src->{NICK
};
565 my $targetN = $target->{NICK
};
566 ircsend
(":$srcN SVSNICK $targetN $newnick ".time);
570 my ($targetserver, $bool, $src) = @_;
571 $src = $main_conf{local} unless defined($src);
572 if ($bool > 0) { $bool = '+'; } else { $bool = '-'; }
573 #this is SVS NO-OP not SVS SNOOP
574 ircsend
(":$main_conf{local} SVSNOOP $targetserver $bool");
580 # Changes the WATCH list of a user.
581 # Syntax: SVSWATCH <nick> :<watch parameters>
582 # Example: SVSWATCH Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
583 # *** We do not track this info nor care.
584 my ($src, $target, @watchlist) = @_;
585 my $srcId = ($src->{NICK
});
586 my $targetId = $target->{NICK
};
587 my $base_str = ":$srcId SVSWATCH $targetId :";
588 my $send_str = $base_str;
590 my $watch = shift @watchlist;
591 if (length("$send_str $watch") > MAXBUFLEN
) {
593 $send_str = $base_str;
595 $send_str = "$send_str $watch";
600 sub svssilence
($$@) {
601 # Changes the SILENCE list of a user.
602 # Syntax: SVSSILENCE <nick> :<silence parameters>
603 # Example: SVSSILENCE Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
604 # *** We do not track this info nor care.
605 my ($src, $target, @silencelist) = @_;
606 my $srcId = ($src->{NICK
});
607 my $targetId = ($target->{NICK
});
608 my $base_str = ":$srcId SVSSILENCE $targetId :";
609 my $send_str = $base_str;
610 while (@silencelist) {
611 my $silence = shift @silencelist;
612 if (length("$send_str $silence") > MAXBUFLEN
) {
614 $send_str = $base_str;
616 $send_str = "$send_str $silence";
618 print "SENDING $send_str\n";
623 # Gives nick Operflags like the ones in O:lines.
624 # SVSO <nick> <+operflags> (Adds the Operflags)
625 # SVSO <nick> - (Removes all O:Line flags)
626 # Example: SVSO SomeNick +bBkK
627 # *** We do not track this info nor care.
628 # *** We will see any umode changes later.
629 # *** this cmd does not change any umodes!
630 my ($src, $target, $oflags) = @_;
631 $src = $main_conf{local} unless defined($src);
632 ircsend
(":$src SVSO $target $oflags");
636 # *** We do not track this info nor care.
637 my ($src, $target, $swhois) = @_;
638 $src = $main_conf{local} unless defined($src);
639 ircsend
(":$src SWHOIS $target :$swhois");
644 my ($src, $target, @chans) = @_;
645 while(my @chanList = splice(@chans, 0, 10)) {
646 # split into no more than 10 at a time.
647 __svsjoin
($src, $target, @chanList);
652 my ($src, $target, @chans) = @_;
653 # a note. a JOIN is returned back to us on success
654 # so no need to process this command.
655 # similar for svspart.
656 my $srcN = $src->{NICK
};
657 my $targetN = $target->{NICK
};
658 ircsend
(($srcN?":$srcN":'')." SVSJOIN $targetN ".join(',', @chans));
662 my ($src, $target, $reason, @chans) = @_;
663 my $srcN = $src->{NICK
};
664 my $targetN = $target->{NICK
};
665 ircsend
(($srcN ? ":$srcN" : '')." SVSPART $targetN ".join(',', @chans).
666 ($reason ? " :$reason" : ''));
670 # we need to sqline most/all of our agents.
671 # tho whether we want to put it in agent_connect
672 # or leave it to the module to call it...
673 my ($nickmask, $reason) = @_;
674 #ircsend("$tkn{S1QLINE}[$tkn] $nickmask".($reason?" :$reason":''));
675 qline
($nickmask, 0, $reason);
679 # Not all IRCd will support this command, as such the calling module must check the IRCd capabilities first.
680 my ($nickmask, $expiry, $reason) = @_;
681 # TKL version - Allows timed qlines.
682 # TKL + Q * test services.SC.net 0 1092179497 :test
683 my $line = 'TKL + Q H '.$nickmask.' '.main_conf_local
.' '.($expiry ? $expiry+time() : 0).' '.time().' :'.$reason;
685 # at startup we send these too early,
686 # before the handlers are initialized
687 # so they may be lost.
688 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
694 # TKL - Q * test services.SC.net
695 my $line = 'TKL - Q H '.$nickmask.' '.main_conf_local
;
697 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
701 my ($nickmask, $expiry, $reason) = @_;
702 # TKL version - Allows timed qlines.
703 # TKL + Q * test services.SC.net 0 1092179497 :test
704 my $line = 'TKL + Q * '.$nickmask.' '.main_conf_local
.' '.($expiry ? $expiry+time() : 0).' '.time().' :'.$reason;
707 # at startup we send these too early,
708 # before the handlers are initialized
709 # so they may be lost.
710 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
714 # we need to sqline most/all of our agents.
715 # tho whether we want to put it in agent_connect
716 # or leave it to the module to call it...
724 # TKL - Q * test services.SC.net
725 my $line = 'TKL - Q * '.$nickmask.' '.main_conf_local
;
727 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
731 my ($src, $target, $reason) = @_;
732 # SVSKILL requires a src, it will NOT work w/o one.
733 # not sure if it'll accept a servername or not.
734 # consider defaulting to ServServ
735 die('svskill called w/o $src') unless $src;
736 ircsend
(':'.$src.' SVSKILL '.$target.' :'.$reason);
737 callfuncs
('QUIT', 0, undef, [$target, $reason]);
742 #ircsend(":$main_conf{local} 351 $src $main::progname ver $main::version $main_conf{local} ".
743 # $main::extraversion);
748 ircsend
("USERHOST $target");
753 die "We're not supposed to use USERIP anymore!" if DEBUG
and NICKIP
;
754 ircsend
(":$main::rsnick USERIP $target");
758 my ($src, $target, $vhost) = @_;
759 my $srcN = $src->{NICK
};
760 my $targetN = $target->{NICK
};
761 ircsend
(($srcN?":$srcN ":'')." CHGHOST $targetN $vhost");
762 callfuncs
('CHGHOST', 0, 1, [$srcN, $targetN, $vhost]);
766 my ($src, $target, $ident) = @_;
767 my $srcN = $src->{NICK
};
768 my $targetN = $target->{NICK
};
769 ircsend
(($src?":$srcN ":'')." CHGIDENT $targetN $ident");
770 callfuncs
('CHGIDENT', 0, 1, [$srcN, $targetN, $ident]);
773 sub jupe_server
($$) {
774 my ($server, $reason) = @_;
776 # :nascent.surrealchat.net SERVER wyvern.surrealchat.net 2 :SurrealChat
777 die "You can't jupe $server"
778 if ((lc($server) eq lc($remoteserv)) or (lc($server) eq lc($main_conf{local})));
779 ircsend
(':'.$main_conf{local}." SQUIT $server :");
780 ircsend
(':'.$main_conf{local}." SERVER $server 2 :$reason");
782 set_server_juped
($server);
784 sub agent_dojoin
($$) {
785 my ($agent, $chan) = @_;
787 if (ref($agent) ne "HASH") {
792 $srcN = $src->{NICK
};
794 ircsend
(":" . $srcN . " JOIN " . $chan);
797 sub agent_dopart
($$$) {
798 my ($agent, $chan, $reason) = @_;
800 if (ref($agent) ne "HASH") {
805 $srcN = $src->{NICK
};
807 ircsend
(":$srcN PART $chan :$reason");
809 sub rehash_all_servers
(;$) {
812 # Validate the type before passing it along.
813 # Very IRCd specific! May be version specific.
814 $type = undef() if(defined($type) && !($type =~ /^\-(motd|botmotd|opermotd|garbage)$/i));
816 foreach my $server (get_online_servers
()) {
817 ircsend
(':'.$main::rsnick
.' REHASH '.$server.(defined($type) ? ' '.$type : '') );
821 sub unban_nick
($$@) {
822 # This is an Unreal-specific server-protocol HACK.
823 # It is not expected to be portable to other ircds.
824 # Similar concepts may exist in other ircd implementations
825 my ($src, $cn, @nicks) = @_;
826 my $srcN = $src->{NICK
};
827 my $i = 0; my @nicklist = ();
828 while(my $nick = shift @nicks) {
829 push @nicklist, $nick;
831 ircsend
(($src ? ":$src" : '' )." SVSMODE $cn -".'b'x
($i).' '.join(' ', @nicklist));
832 $i = 0; @nicklist = ();
835 ircsend
(($srcN ? ":$srcN " : "SVSMODE $cn -".'b'x
($i).' '.join(' ', @nicklist)));
836 # We don't loopback this, as we'll receive back the list
841 # This is an Unreal-specific server-protocol HACK.
842 # It is not expected to be portable to other ircds.
843 # Similar concepts may exist in other ircd implementations
846 ircsend
(($src ? ":$src " : '' ). "SVSMODE $cn -b");
847 # We don't loopback this, as we'll receive back the list
851 # HostServ OFF would want this.
852 # resets the vhost to be the cloakhost.
853 sub reset_cloakhost
($$) {
854 my ($src, $target) = @_;
855 setumode
($src, $target, '-x+x'); # only works in 3.2.6.
858 # removes the cloakhost, so that vhost matches realhost
859 sub disable_cloakhost
($$) {
860 my ($src, $target) = @_;
861 setumode
($src, $target, '-x'); # only works in 3.2.6.
864 # enables the cloakhost, so that vhost becomes the cloakhost
865 sub enable_cloakhost
($$) {
866 my ($src, $target) = @_;
867 setumode
($src, $target, '+x'); # only works in 3.2.6.
870 sub agent_doconn
($$$$$) {
871 my ($nick, $ident, $host, $modes, $gecos) = @_;
872 ircsend
("NICK $nick 1 " . time . " $ident $host ".
873 (SJB64
? itob64
(main_conf_numeric
) : main_conf_local
).
874 " 1 $modes * :$gecos");
878 my ($src, $sign, @targets) = @_;
879 $src = $main_conf{local} unless $src;
880 foreach my $target (@targets) {
881 ircsend
(':'.$src .' SVSNOLAG '.$sign.' '.$target);