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 getRevUuid getUuid setRevUuid setUuid
);
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 getRevUuid getUuid setRevUuid SetUUid);
70 our %preconnect_defer_mode;
72 our $unreal_protocol_version;
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);
83 my $nick = $reverse_uuids{$id};
84 $uuids{lc $nick} = $id;
89 my $id = $uuids{$nick};
90 print "getUuid $nick $id\n";
95 $reverse_uuids{$id} = lc $nick;
99 $uuids{lc $nick} = $id;
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' : ''),
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;
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;
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");
142 ircsendimm
("$tkn{PONG}[$tkn] :$src");
146 print "GOT ENDBURST\n\n";
148 ircsendimm
("ENDBURST");
154 #foreach my $k (keys %servers) {
155 # print "Server: $k ircline: ",$servers{$k}[0], " state: ", $servers{$k}[1], "\n";
157 #print "Synced: ", synced(), "\n\n";
160 ircsendimm
(':'.$main_conf{local}.' '.$tkn{EOS
}[$tkn], 'VERSION');
163 flushmodes
(\
%preconnect_defer_mode);
169 sub netinfo
($$$$$$$$) {
170 ircsendimm
($tkn{NETINFO
}[$tkn].' 0 '.time." $_[2] $_[3] 0 0 0 :$_[7]");
171 $main_conf{network
} = $_[7];
175 ircsendimm
((SJB64
? '@'.itob64
($main_conf{numeric
}) : ':'.$main_conf{local})." $tkn{TSCTL}[$tkn] SVSTIME ".time);
178 sub parse_sjoin
($$$$) {
179 my ($server, $ts, $cn, $parms) = @_;
180 my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
182 $server = '' unless $server;
184 if($parms =~ /^:(.*)/) {
187 ($chmodes, $blobs) = split(/ :/, $parms, 2);
188 ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
190 @blobs = split(/ /, $blobs);
192 foreach my $x (@blobs) {
193 if($x =~ /^(\&|\"|\')(.*)$/) {
195 push @bans, $2 if $1 eq '&';
196 push @excepts, $2 if $1 eq '"';
197 push @invex, $2 if $1 eq "\'";
199 $x =~ /^([*~@%+]*)(.*)$/;
200 my ($prefixes, $nick) = ($1, $2);
201 my @prefixes = split(//, $prefixes);
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 '+');
211 push @users, { NICK
=> $nick, __OP
=> $op };
215 return ($server, $cn, $ts, $chmodes, $chmodeparms, \
@users, \
@bans, \
@excepts, \
@invex);
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]);
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");
238 ircsend
(':'.$main_conf{local}.' '.$tkn{PING
}[$tkn].' :'.$main_conf{local});
240 # ircsend(':'.$_[2].' '.$tkn{PONG}[$tkn].' '.$_[0].' :'.$_[1]);
245 my ($src, $dst, @msgs) = @_;
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));
255 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
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]);
264 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
265 write_log
('diag', '<'.$main_conf{local}.'>', @msgs);
270 debug_privmsg
($main_conf{local}, $main_conf{diag
}, @msgs);
273 sub debug_privmsg
($$@) {
274 my ($src, $dst, @msgs) = @_;
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));
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]);
291 my ($src, $dst, @msgs) = @_;
292 my $target = $dst; #lazy erry
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));
301 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
303 if (ref ($dst) eq "HASH") { #User Object
304 $targetId = ($target->{ID
}?encodeUUID
($target->{ID
}):$target->{NICK
});
306 else { # /notice #channel This probably sucks. Blame erry :(
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]);
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");
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");
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]);
339 sub setsvsstamp
($$$) {
340 my ($src, $dst, $stamp) = @_;
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]);
351 sub setagent_umode
($$) {
352 my ($src, $modes) = @_;
353 ircsend
(":$src $tkn{UMODE2}[$tkn] $modes");
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]);
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
});
369 foreach my $mask (@parms) {
370 push @masklist, [( ($sign >= 1) ? '+' : '-').$mode, $mask];
372 ircd
::setmode2
($srcId, $cn, @masklist);
376 my ($src, $dst, $modes, $target) = @_;
378 if (initial_synced
()) {
379 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
382 $src = $main_conf{numeric
};
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");
391 sub setmode_many
($$$;@) {
392 my ($src, $dst, $modes, @targets) = @_;
394 if (initial_synced
()) {
395 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
398 $src = $main_conf{local};
402 foreach my $target (@targets) {
403 my $targetId = ($target->{ID
}?encodeUUID
($target->{ID
}):$target->{NICK
});
404 $parms .= ($parms == ""?"":" ") . $targetId;
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");
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]);
419 my ($modes, $parms) = split(/ /, $m, 2);
420 setmode_real
($src, $dst, $modes, $parms);
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.
432 ircsend
(":$src ".$tkn{MODE
}[$tkn]." $dst $modes".($parms?" $parms":'').($src =~ /\./ ? ' 0' : ''));
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]);
445 my ($src, $message) = @_;
446 ircsend
(":$src $tkn{WALLOPS}[$tkn] :$message");
450 my ($src, $message) = @_;
451 my $srcId = ($src->{ID
}?$src->{ID
}:$src->{NICK
});
452 ircsend
(":$srcId $tkn{GLOBOPS}[$tkn] :$message");
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
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";
469 #return ($type, +1, $ident, $host, $setter, $expire, $time, $reason);
470 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
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";
481 callfuncs
('TKL', undef, undef, [parse_delline
($line)]);
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";
492 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
496 my ($setter, $host) = @_;
497 my $setId = getUuid
($setter);
498 if ($setId) { $setter = $setId; }
499 my $line = ":$setter DELLINE Z $host";
501 callfuncs
('TKL', undef, undef, [parse_delline
($line)]);
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";
511 callfuncs
('TKL', undef, undef, [parse_tkl
($tkl)]);
514 sub update_userkill
($) {
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());
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]);
538 my ($src, $target, $snomasks) = @_;
539 $src=$main_conf{local} unless defined($src);
541 # None, this doesn't affect us.
543 # SVSSNO is not in tokens.txt nor msg.h
544 ircsend
(":$src ".'SVS2SNO'." $target $snomasks ".time);
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
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);
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");
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;
578 my $watch = shift @watchlist;
579 if (length("$send_str $watch") > MAXBUFLEN
) {
581 $send_str = $base_str;
583 $send_str = "$send_str $watch";
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
) {
600 $send_str = $base_str;
602 $send_str = "$send_str $silence";
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!
616 my ($src, $target, $oflags) = @_;
617 $src = $main_conf{local} unless defined($src);
618 ircsend
(":$src $tkn{SVSO}[$tkn] $target $oflags");
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");
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);
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));
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" : ''));
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);
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;
670 callfuncs
('TKL', undef, undef, [parse_addline
($line)]);
675 #>> 37 :583AAAAAA DELLINE Q errietta3
676 my $line = ":" . $main_conf{numeric
} . ' DELLINE Q ' . $nickmask . "\n";
678 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
682 my ($nickmask, $expiry, $reason) = @_;
683 #:583AAAAAA ADDLINE Q hell3o inspircd.erry.omg 1308295479 600 :Bye Bye
685 my $line = ':' . $main_conf{numeric
} . ' ADDLINE Q '.$nickmask . ' ' . $main_conf{local} . ' '. time() . ' ' . ($expiry ? $expiry : 0).' :'.$reason;
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)]);
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...
705 # TKL - Q * test services.SC.net
706 my $line = 'TKL - Q * '.$nickmask.' '.$main_conf{local};
708 callfuncs
('TKL', undef, undef, [parse_tkl
($line)]);
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]);
723 #ircsend(":$main_conf{local} 351 $src $main::progname ver $main::version $main_conf{local} ".
724 # $main::extraversion);
729 ircsend
($tkn{USERHOST
}[$tkn]." $target");
734 die "We're not supposed to use USERIP anymore!" if DEBUG
and NICKIP
;
735 ircsend
(":$main::rsnick USERIP $target");
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]);
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]);
754 sub jupe_server
($$) {
755 my ($server, $reason) = @_;
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");
763 set_server_juped
($server);
765 sub agent_dojoin
($$) {
766 my ($agent, $chan) = @_;
767 print "DOJOIN " . Dumper
($agent);
769 if (ref($agent) ne "HASH") {
770 $srcId = getUuid
($agent);
774 print "SRCID " . Dumper
($srcId);
778 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
780 ircsend
(":" . $srcId . " JOIN " . $chan);
783 sub agent_dopart
($$$) {
784 my ($agent, $chan, $reason) = @_;
786 if (ref($agent) ne "HASH") {
787 $srcId = getUuid
($agent);
794 $srcId = ($src->{ID
}?$src->{ID
}:($src->{UUID
}?$src->{UUID
}:$src->{NICK
}));
796 ircsend
(":$srcId $tkn{PART}[$tkn] $chan :$reason");
798 sub rehash_all_servers
(;$) {
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));
805 foreach my $server (get_online_servers
()) {
806 ircsend
(':'.$main::rsnick
.' '.$tkn{REHASH
}[$tkn].' '.$server.(defined($type) ? ' '.$type : '') );
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;
820 ircsend
(($src ? ":$src " : '' ).$tkn{SVSMODE
}[$tkn]." $cn -".'b'x
($i).' '.join(' ', @nicklist));
821 $i = 0; @nicklist = ();
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
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
836 ircsend
(($src ? ":$src " : '' ).$tkn{SVSMODE
}[$tkn]." $cn -b");
837 # We don't loopback this, as we'll receive back the list
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.
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.
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.
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);
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);