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';
28 use Exporter
'import';
29 our @EXPORT = qw
(agent_doconn getAgentRevUuid getAgentUuid setAgentRevUuid setAgentUuid
);
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 !@
42 CHANNELLEN
=> 32, # From 005 reply. hyperion is 30.
50 PREFIXAQ_DISABLE
=> 0,
52 die "NICKIP must be enabled if CLK is\n" if CLK
&& !NICKIP
;
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);
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);
63 use SrSv
::Text
::Format
qw( wordwrap );
67 use SrSv
::Process
::InParent
qw(update_userkill getAgentRevUuid getAgentUuid setAgentRevUuid setAgentUuid);
70 our %preconnect_defer_mode;
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);
82 if (ref ($user) ne "HASH") {
83 Carp
::confess
("encodeUUID_ called on non-hash " . $user);
86 if (defined ($user->{e_ID
})) {
89 if (!defined($user->{ID
})) {
90 Carp
::confess
("encodeUUID_ called on a user w/o id " , Dumper
($user));
93 my $nick = $user->{NICK
};
94 if (!defined ($nick)) {
95 $nick = get_user_nick
($user);
97 if (is_agent
($nick)) {
98 return $user->{e_ID
} = $user->{ID
};
100 return $user->{e_ID
} = encodeUUID
($user->{ID
});
102 sub getAgentRevUuid
($) {
104 my $nick = $reverse_uuids{$id};
105 $uuids{lc $nick} = $id;
108 sub getAgentUuid
($) {
110 my $id = $uuids{$nick};
113 sub setAgentRevUuid
($$) {
114 my ($id, $nick) = @_;
115 $reverse_uuids{$id} = lc $nick;
117 sub setAgentUuid
($$) {
118 my ($nick, $id) = @_;
119 $uuids{lc $nick} = $id;
122 my $remote = $main_conf{remote
};
123 my $port = $main_conf{port
};
124 ircd_connect
($remote, $port);
125 ircsendimm
( 'PASS :'.$main_conf{pass
},
126 'SERVER '.$main_conf{local}.' ' . $main_conf{pass
} . ' 0 ' .$main_conf{numeric
} . ' ' .$main_conf{info
} );
127 ircsendimm
('BURST ' .time);
128 %preconnect_defer_mode = %defer_mode;
134 sub handle_server
($$$$;$$$) {
135 # This is mostly a stub function, but we may need the $unreal_protocol_version
136 # at a later date. Plus we may want to maintain a server tree in another module.
137 my ($src_server, $server_name, $num_hops, $info_line, $server_numeric, $protocol_version, $build_flags) = @_;
138 $unreal_protocol_version = $protocol_version if defined $protocol_version;
145 my ($src, $cookie, $dst) = @_;
146 # This will only make sense if you remember that
147 # $src is where it came from, $dst is where it went (us)
148 # we're basically bouncing it back, but changing from PING to PONG.
149 if (defined($dst) and defined($cookie)) {
150 # $dst is always $main_conf{local} anyway...
151 # this is only valid b/c we never have messages routed THROUGH us
152 # we are always an end point.
153 ircsendimm
(":$dst PONG $src :$cookie");
156 ircsendimm
("PONG :$src");
161 flushmodes
(\
%preconnect_defer_mode);
165 ircsendimm
("ENDBURST");
171 #foreach my $k (keys %servers) {
172 # print "Server: $k ircline: ",$servers{$k}[0], " state: ", $servers{$k}[1], "\n";
174 #print "Synced: ", synced(), "\n\n";
177 ircsendimm
(':'.$main_conf{local}.' EOS VERSION');
180 flushmodes
(\
%preconnect_defer_mode);
186 sub netinfo
($$$$$$$$) {
187 ircsendimm
('NETINFO 0 '.time." $_[2] $_[3] 0 0 0 :$_[7]");
188 $main_conf{network
} = $_[7];
192 ircsendimm
((SJB64
? '@'.itob64
($main_conf{numeric
}) : ':'.$main_conf{local})." TSCTL SVSTIME ".time);
195 sub parse_sjoin
($$$$) {
196 my ($server, $ts, $cn, $parms) = @_;
197 my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
199 $server = '' unless $server;
201 if($parms =~ /^:(.*)/) {
204 ($chmodes, $blobs) = split(/ :/, $parms, 2);
205 ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
207 @blobs = split(/ /, $blobs);
209 foreach my $x (@blobs) {
210 if($x =~ /^(\&|\"|\')(.*)$/) {
212 push @bans, $2 if $1 eq '&';
213 push @excepts, $2 if $1 eq '"';
214 push @invex, $2 if $1 eq "\'";
216 $x =~ /^([*~@%+]*)(.*)$/;
217 my ($prefixes, $nick) = ($1, $2);
218 my @prefixes = split(//, $prefixes);
220 foreach my $prefix (@prefixes) {
221 $op |= $opmodes{q
} if ($prefix eq '*');
222 $op |= $opmodes{a
} if ($prefix eq '~');
223 $op |= $opmodes{o
} if ($prefix eq '@');
224 $op |= $opmodes{h
} if ($prefix eq '%');
225 $op |= $opmodes{v
} if ($prefix eq '+');
228 push @users, { NICK
=> $nick, __OP
=> $op };
232 return ($server, $cn, $ts, $chmodes, $chmodeparms, \
@users, \
@bans, \
@excepts, \
@invex);
238 my ($src, $chan, $target, $reason) = @_;
239 $src = $main_conf{numeric
} unless initial_synced
();
241 if (ref($src) eq "HASH") {
242 $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
247 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
248 ircsend
(":$srcId KICK $chan $targetId :$reason");
249 callfuncs
('KICK', 0, 2, [$srcId, $chan, $targetId, $reason]);
253 my ($src, $chan, $target) = @_;
254 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
255 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
256 ircsend
(":$srcId INVITE $targetId $chan 0");
261 ircsend
(':'.$main_conf{local}.' PING :'.$main_conf{local});
263 # ircsend(':'.$_[2].' '.$tkn{PONG}[$tkn].' '.$_[0].' :'.$_[1]);
268 my ($src, $dst, @msgs) = @_;
270 foreach my $buf (@msgs) {
271 # 3 spaces, two colons, PRIVMSG=7
272 # Length restrictions are for CLIENT Protocol
273 # hence the (MASKLEN - (NICKLEN + 1))
274 # Technically optimizable if we use $agent{lc $src}'s ident and host
275 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
276 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
278 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
280 # submit a list of messages as a single packet to the server
281 ircsend
(":$srcId PRIVMSG $dst :".join("\r\n".":$src PRIVMSG $dst :", @bufs));
282 callfuncs
('LOOP_PRIVMSG', 0, 1, [$src, $dst, \
@bufs]);
287 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
288 write_log
('diag', '<'.$main_conf{local}.'>', @msgs);
293 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
296 sub debug_privmsg
($$@) {
297 my ($src, $dst, @msgs) = @_;
300 foreach my $buf (@msgs) {
301 # 3 spaces, two colons, PRIVMSG=7
302 # Length restrictions are for CLIENT Protocol
303 # hence the (MASKLEN - (NICKLEN + 1))
304 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
305 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
308 # submit a list of messages as a single packet to the server
309 ircsendimm
(":$src PRIVMSG $dst :".join("\r\n".":$src PRIVMSG $dst :", @bufs));
310 callfuncs
('LOOP_PRIVMSG', 0, 1, [$src, $dst, \
@bufs]);
314 my ($src, $dst, @msgs) = @_;
315 my $target = $dst; #lazy erry
317 foreach my $buf (@msgs) {
318 # 3 spaces, two colons, NOTICE=6
319 # Length restrictions are for CLIENT Protocol
320 # hence the (MASKLEN - (NICKLEN + 1))
321 my $buflen = length($src) + length($dst) + 12 + (MASKLEN
- (NICKLEN
+ 1));
322 push @bufs, wordwrap
($buf, (MAXBUFLEN
- $buflen));
324 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
326 if (ref ($dst) eq "HASH") { #User Object
327 $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
329 else { # /notice #channel This probably sucks. Blame erry :(
332 ircsend
(":$srcId NOTICE $targetId :".join("\r\n".":$srcId NOTICE $targetId :", @bufs));
333 callfuncs
('LOOP_NOTICE', 0, 1, [$srcId, $targetId, \
@bufs]);
337 my ($src, $dst, $cmd, @toks) = @_;
338 my $target = $dst; #lazy erry
339 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
340 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
341 privmsg
($srcId, $targetId, "\x01".join(' ', ($cmd, @toks))."\x01");
344 sub ctcp_reply
($$@) {
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 notice
($srcId, $targetId, "\x01".join(' ', ($cmd, @toks))."\x01");
353 my ($src, $dst, $modes) = @_;
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 ircsend
(":$srcId SVSMODE $targetId $modes");
358 callfuncs
('UMODE', 0, undef, [$dst, $modes]);
361 sub setsvsstamp
($$$) {
362 my ($src, $dst, $stamp) = @_;
364 ircsend
(":$src SVS2MODE $dst +d $stamp");
365 # This function basically set the svsstamp to
366 # be the same as the userid. Not all ircd will
367 # support this function.
369 # We obviously already know the userid, so don't
370 # use a callback here.
371 #callfuncs('UMODE', 0, undef, [$dst, $modes]);
374 sub setagent_umode
($$) {
375 my ($src, $modes) = @_;
376 ircsend
(":$src UMODE2 $modes");
380 my ($src, $dst, @modelist) = @_;
381 #debug(" --", "-- ircd::setmode2: ".$_[0], split(/\n/, Carp::longmess($@)), " --");
382 foreach my $modetuple (@modelist) {
383 my $target = $modetuple->[1];
384 setmode
($src, $dst, $modetuple->[0], $modetuple->[1]);
387 sub ban_list
($$$$@) {
388 # Convenience function for lots of bans or excepts.
389 my ($src, $cn, $sign, $mode, @parms) = @_;
391 foreach my $mask (@parms) {
392 push @masklist, [( ($sign >= 1) ? '+' : '-').$mode, $mask];
394 ircd
::setmode2
($src, $cn, @masklist);
398 my ($src, $dst, $modes, $target) = @_;
400 if (initial_synced
()) {
401 if (ref($src) eq "HASH") {
402 if ($src->{NICK
} && !$src->{ID
}) {
405 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
412 $src = $main_conf{numeric
};
416 if (ref ($target) eq "HASH") {
417 $targetId = ($target->{UID
}?$target->{UID
}:($target->{ID
}?encodeUUID_
($target):$target->{NICK
}));
422 callfuncs
('MODE', undef, 1, [$srcId, $dst, $modes, $targetId, $target]);
423 print "$ircline -- setmode($srcId, $dst, $modes, $targetId)\n" if DEBUG
;
424 ircsend
(":$srcId MODE $dst $modes $targetId");
427 sub setmode_many
($$$;@) {
428 my ($src, $dst, $modes, @targets) = @_;
430 if (initial_synced
()) {
431 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
434 $src = $main_conf{local};
438 foreach my $target (@targets) {
439 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
440 $parms .= ($parms eq ""?"":" ") . $targetId;
442 callfuncs
('MODE', undef, 1, [$srcId, $dst, $modes, $parms, @targets]);
443 print "$ircline -- setmode($srcId, $dst, $modes, $parms)\n" if DEBUG
;
444 ircsend
(":$srcId MODE $dst $modes $parms");
449 my $dm = (shift or \
%defer_mode);
450 my @k = keys(%$dm); my @v = values(%$dm);
451 for(my $i; $i<@k; $i++) {
452 my ($src, $dst) = split(/ /, $k[$i]);
455 my ($modes, $parms) = split(/ /, $m, 2);
456 setmode_real
($src, $dst, $modes, $parms);
462 sub setmode_real
($$$;$) {
463 my ($src, $dst, $modes, $parms) = @_;
464 print "$ircline -- setmode_real($src, $dst, $modes, $parms)\n" if DEBUG
;
465 # for server sources, there must be a timestamp. but you can put 0 for unspecified.
466 $parms =~ s/\s+$//; #trim any trailing whitespace, as it might break the simple parser in the ircd.
468 ircsend
(":$src MODE $dst $modes".($parms?" $parms":'').($src =~ /\./ ? ' 0' : ''));
471 sub settopic
($$$$$) {
472 my ($src, $chan, $setter, $time, $topic) = @_;
473 $src = $main_conf{numeric
} unless initial_synced
();
474 #>> 38 :583AAAAAF TOPIC #erry :Welcome to erry(world|net). Have a cookie.
475 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
476 ircsend
(":$srcId TOPIC $chan :$topic");
477 callfuncs
('TOPIC', undef, undef, [$srcId, $chan, $setter, $time, $topic]);
481 my ($src, $message) = @_;
482 ircsend
(":$src WALLOPS :$message");
486 my ($src, $message) = @_;
487 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
488 ircsend
(":$srcId GLOBOPS :$message");
492 my ($setter, $ident, $host, $expiry, $reason) = @_;
493 $setter = $main_conf{local} unless defined($setter);
494 $ident = '*' unless defined($ident);
495 # you need to use ADDLINE for this. GLINE is a user command
497 #>> 47 :583AAAAAA ADDLINE G test@testie inspircd.erry.omg 1308118489 0 :hi
498 #NOTE FOR ALL ADDLINES:
499 #note that you need to provide expiry alone, not expiry +time
500 #otherwise you will end up with insanely long bans
502 if (ref ($setter) eq "HASH") {
503 $setId = $setter->{ID
};
508 my $line = ":$setId ADDLINE G $ident\@$host " . $main_conf{local} . " ". time() . " " . ($expiry)." :$reason";
510 #return ($type, +1, $ident, $host, $setter, $expire, $time, $reason);
511 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
515 my ($setter, $ident, $host) = @_;
516 my $line = "TKL - G $ident $host $setter";
517 my $setId = getAgentUuid
($setter);
518 if ($setId) { $setter = $setId; }
519 #:583AAAAAE DELLINE G test@test.com
520 my $line = ":$setter DELLINE G $ident\@$host";
522 callfuncs
('TKL', undef, undef, [parse_delline
($line)]);
526 my ($setter, $host, $expiry, $reason) = @_;
527 $setter=$main_conf{local} unless defined($setter);
528 my $setId = getAgentUuid
($setter);
529 if ($setId) { $setter = $setId; }
530 #:583AAAAAE ADDLINE Z test.com inspircd.erry.omg 1308216407 0 :go away
531 my $line = ":$setter ADDLINE Z $host " . $main_conf{local} . " ". time() . " " . ($expiry)." :$reason";
533 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
537 my ($setter, $host) = @_;
538 my $setId = getAgentUuid
($setter);
539 if ($setId) { $setter = $setId; }
540 my $line = ":$setter DELLINE Z $host";
542 callfuncs
('TKL', undef, undef, [parse_delline
($line)]);
545 sub spamfilter
($$$$$$$) {
546 # Note the hardcoded zero (0).
547 # Looks like theoretically one can have expirable spamfilters.
548 # This is untested however.
549 my ($sign, $tkl_target, $tkl_action, $setter, $bantime, $reason, $regex) = @_;
550 my $tkl = "TKL ".($sign ? '+' : '-' )." F $tkl_target $tkl_action $setter 0 ".time()." $bantime $reason :$regex";
552 callfuncs
('TKL', undef, undef, [parse_tkl
($tkl)]);
555 sub update_userkill
($) {
558 # This is a simple way to do it, that _could_ be defeated
559 # with enough users getting killed at once.
560 # The alternative would require a timer to expire the old entries.
561 return undef if (time() == $userkill[1] and $target eq $userkill[0]);
562 @userkill = ($target, time());
568 my ($src, $target, $reason) = @_;
569 $src = $main_conf{local} unless initial_synced
();
570 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
571 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
572 my $srcNick = $target->{NICK
};
573 return 0 unless update_userkill
($targetId);
574 ircsendimm
(":$srcId KILL $targetId :($reason)");
575 callfuncs
('KILL', 0, 1, [$src, $target, $srcNick, $reason]);
579 my ($src, $target, $snomasks) = @_;
580 $src=$main_conf{local} unless defined($src);
582 # None, this doesn't affect us.
584 # SVSSNO is not in tokens.txt nor msg.h
585 ircsend
(":$src ".'SVS2SNO'." $target $snomasks ".time);
589 my ($src, $target, $newnick) = @_;
590 $src=$main_conf{local} unless defined($src);
591 # note: we will get a NICK cmd back after a
592 # successful nick change.
593 # warning, if misused, this can KILL the user
595 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
596 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
597 ircsend
(":$srcId SVSNICK $targetId $newnick ".time);
601 my ($targetserver, $bool, $src) = @_;
602 $src = $main_conf{local} unless defined($src);
603 if ($bool > 0) { $bool = '+'; } else { $bool = '-'; }
604 #this is SVS NO-OP not SVS SNOOP
605 ircsend
(":$main_conf{local} SVSNOOP $targetserver $bool");
610 my ($src, $target, @watchlist) = @_;
611 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
612 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
613 my $base_str = ":$srcId SVSWATCH $targetId ";
614 my $send_str = $base_str;
616 my $watch = shift @watchlist;
617 if (length("$send_str $watch") > MAXBUFLEN
) {
619 $send_str = $base_str;
621 $send_str = "$send_str $watch";
626 sub svssilence
($$@) {
627 # Changes the SILENCE list of a user.
628 # Syntax: SVSSILENCE <nick> :<silence parameters>
629 # Example: SVSSILENCE Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
630 # *** We do not track this info nor care.
631 my ($src, $target, @silencelist) = @_;
632 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
633 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
634 my $base_str = ":$srcId SVSSILENCE $targetId ";
635 my $send_str = $base_str;
636 while (@silencelist) {
637 my $silence = shift @silencelist;
638 if (length("$send_str $silence") > MAXBUFLEN
) {
640 $send_str = $base_str;
642 $send_str = "$send_str $silence";
648 # Gives nick Operflags like the ones in O:lines.
649 # SVSO <nick> <+operflags> (Adds the Operflags)
650 # SVSO <nick> - (Removes all O:Line flags)
651 # Example: SVSO SomeNick +bBkK
652 # *** We do not track this info nor care.
653 # *** We will see any umode changes later.
654 # *** this cmd does not change any umodes!
656 my ($src, $target, $oflags) = @_;
657 $src = $main_conf{local} unless defined($src);
658 ircsend
(":$src SVSO $target $oflags");
663 # *** We do not track this info nor care.
664 my ($src, $target, $swhois) = @_;
665 $src = $main_conf{local} unless defined($src);
666 ircsend
(":$src SWHOIS $target :$swhois");
670 my ($src, $target, @chans) = @_;
671 foreach my $chan (@chans) {
672 # insp only allows one at the time.
673 __svsjoin
($src, $target, $chan);
678 my ($src, $target, $chan) = @_;
679 # a note. a JOIN is returned back to us on success
680 # so no need to process this command.
681 # similar for svspart.
682 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
683 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
684 ircsend
(($srcId?":$srcId":'')." SVSJOIN $targetId $chan");
688 my ($src, $target, $reason, @chans) = @_;
689 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
690 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
691 ircsend
(($srcId ? ":$srcId" : '')." SVSPART $targetId ".join(',', @chans).
692 ($reason ? " :$reason" : ''));
696 # we need to sqline most/all of our agents.
697 # tho whether we want to put it in agent_connect
698 # or leave it to the module to call it...
699 my ($nickmask, $reason) = @_;
700 #ircsend("$tkn{S1QLINE}[$tkn] $nickmask".($reason?" :$reason":''));
701 qline
($nickmask, 0, $reason);
705 my ($nickmask, $expiry, $reason) = @_;
706 #:583AAAAAA ADDLINE Q hell3o inspircd.erry.omg 1308295479 600 :Bye Bye
707 my $line = ':' . $main_conf{numeric
} . ' ADDLINE Q '.$nickmask.' '.$main_conf{local}.' '. time() . ' ' . ($expiry ? $expiry : 0 ) . ' :'.$reason;
709 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
714 #>> 37 :583AAAAAA DELLINE Q errietta3
715 my $line = ":" . $main_conf{numeric
} . ' DELLINE Q ' . $nickmask . "\n";
717 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
721 my ($nickmask, $expiry, $reason) = @_;
722 #:583AAAAAA ADDLINE Q hell3o inspircd.erry.omg 1308295479 600 :Bye Bye
723 my $line = ':' . $main_conf{numeric
} . ' ADDLINE Q '.$nickmask . ' ' . $main_conf{local} . ' '. time() . ' ' . ($expiry ? $expiry : 0).' :'.$reason;
726 # at startup we send these too early,
727 # before the handlers are initialized
728 # so they may be lost.
729 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
733 # we need to sqline most/all of our agents.
734 # tho whether we want to put it in agent_connect
735 # or leave it to the module to call it...
742 #>> 37 :583AAAAAA DELLINE Q errietta3
743 my $line = ':' . $main_conf{numeric
} . ' DELLINE Q '.$nickmask;
745 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
749 my ($src, $target, $reason) = @_;
750 # SVSKILL requires a src, it will NOT work w/o one.
751 # not sure if it'll accept a servername or not.
752 # consider defaulting to ServServ
753 die('svskill called w/o $src') unless $src;
754 ircsend
(':'.$src.' SVSKILL '.$target.' :'.$reason);
755 callfuncs
('QUIT', 0, undef, [$target, $reason]);
760 #ircsend(":$main_conf{local} 351 $src $main::progname ver $main::version $main_conf{local} ".
761 # $main::extraversion);
766 ircsend
("USERHOST $target");
771 die "We're not supposed to use USERIP anymore!" if DEBUG
and NICKIP
;
772 ircsend
(":$main::rsnick USERIP $target");
776 my ($src, $target, $vhost) = @_;
777 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
778 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
779 ircsend
(($srcId?":$srcId ":'')." CHGHOST $targetId $vhost");
780 callfuncs
('CHGHOST', 0, 1, [$srcId, $targetId, $vhost]);
784 my ($src, $target, $ident) = @_;
785 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
786 my $targetId = ($target->{ID
}?encodeUUID_
($target):$target->{NICK
});
787 ircsend
(($src?":$srcId ":'')." CHGIDENT $targetId $ident");
788 callfuncs
('CHGIDENT', 0, 1, [$srcId, $targetId, $ident]);
791 sub jupe_server
($$) {
792 my ($server, $reason) = @_;
794 # :nascent.surrealchat.net SERVER wyvern.surrealchat.net 2 :SurrealChat
795 die "You can't jupe $server"
796 if ((lc($server) eq lc($remoteserv)) or (lc($server) eq lc($main_conf{local})));
797 ircsend
(':'.$main_conf{local}." SQUIT $server :");
798 ircsend
(':'.$main_conf{local}." SERVER $server 2 :$reason");
800 set_server_juped
($server);
802 sub agent_dojoin
($$) {
803 my ($agent, $chan) = @_;
805 if (ref($agent) ne "HASH") {
806 $srcId = getAgentUuid
($agent);
813 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
815 ircsend
(":" . $srcId . " JOIN " . $chan);
818 sub agent_dopart
($$$) {
819 my ($agent, $chan, $reason) = @_;
821 if (ref($agent) ne "HASH") {
822 $srcId = getAgentUuid
($agent);
829 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
831 ircsend
(":$srcId PART $chan :$reason");
833 sub rehash_all_servers
(;$) {
836 # Validate the type before passing it along.
837 # Very IRCd specific! May be version specific.
838 $type = undef() if(defined($type) && !($type =~ /^\-(motd|botmotd|opermotd|garbage)$/i));
840 foreach my $server (get_online_servers
()) {
841 ircsend
(':'.$main::rsnick
.' REHASH '.$server.(defined($type) ? ' '.$type : '') );
845 sub unban_nick
($$@) {
846 # This is an Unreal-specific server-protocol HACK.
847 # It is not expected to be portable to other ircds.
848 # Similar concepts may exist in other ircd implementations
849 my ($src, $cn, @nicks) = @_;
850 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
851 my $i = 0; my @nicklist = ();
852 while(my $nick = shift @nicks) {
853 push @nicklist, $nick;
855 ircsend
(($src ? ":$src" : '' )." SVSMODE $cn -".'b'x
($i).' '.join(' ', @nicklist));
856 $i = 0; @nicklist = ();
860 ircsend
(($srcId ? ":$srcId " : "SVSMODE $cn -".'b'x
($i).' '.join(' ', @nicklist)));
861 # We don't loopback this, as we'll receive back the list
866 # This is an Unreal-specific server-protocol HACK.
867 # It is not expected to be portable to other ircds.
868 # Similar concepts may exist in other ircd implementations
871 ircsend
(($src ? ":$src " : '' ). "SVSMODE $cn -b");
872 # We don't loopback this, as we'll receive back the list
876 # HostServ OFF would want this.
877 # resets the vhost to be the cloakhost.
878 sub reset_cloakhost
($$) {
879 my ($src, $target) = @_;
880 setumode
($src, $target, '-x+x'); # only works in 3.2.6.
883 # removes the cloakhost, so that vhost matches realhost
884 sub disable_cloakhost
($$) {
885 my ($src, $target) = @_;
886 setumode
($src, $target, '-x'); # only works in 3.2.6.
889 # enables the cloakhost, so that vhost becomes the cloakhost
890 sub enable_cloakhost
($$) {
891 my ($src, $target) = @_;
892 setumode
($src, $target, '+x'); # only works in 3.2.6.
895 sub agent_doconn
($$$$$) {
896 my ($nick, $ident, $host, $modes, $gecos) = @_;
899 if ($startInt == -1) {
900 $uuid = $main_conf{numeric
} . "AAAAAA";
901 $startInt = decodeUUID
($uuid);
904 $uuid = encodeUUID
($startInt);
906 ircsend
(":" . $main_conf{numeric
} . " UID" . " $uuid " . time . " $nick $host $host $ident 127.0.0.1 ". (time+5) . " $modes " . ":$gecos" );
907 setAgentUuid
($nick,$uuid);
908 setAgentRevUuid
($uuid, $nick);
913 my ($src, $sign, @targets) = @_;
914 $src = $main_conf{local} unless $src;
915 foreach my $target (@targets) {
916 ircsend
(':'.$src .' SVSNOLAG '.$sign.' '.$target);