You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
tdenetwork/ksirc/ksirc.pl

782 lines
19 KiB

#
# $$Id$$
#
&addhelp("server",
"\cbAdded by KSirc.pl\cb
Usage: server server [port] [password]
Connects to a new server opening it in a new window.
If server name is prefixed with a + then an ssl connection
is used. Port and password are optional.");
&addhelp("Ban",
"\cbAdded by KSirc.pl\cb
Usage: BAN <nickname>
bans the specified user on the current channel. Only channel operators
can use this command. Bans the user in the form *!*user\@hostmask.
hostmask is xxx.xxx.xxx.* if the hostname is in dotted quad form, otherwise
it is *.domain.com
See Also: UNBAN, CLRBAN, BANLIST");
&addhelp("UnBan",
"\cbAdded by KSirc.pl\cb
Usage: UNBAN <nickname>
Unbans the specified user on the given channel. Only channel operators
can use this command.
See Also: BAN, CLRBAN, BANLIST");
&addhelp("ClrBan",
"\cbAdded by KSirc.pl\cb
Usage: CLRBAN [<#channel>]
Removes ALL bans from the given channel. Only channel operators can use
this command. The channel defaults to your current one.
See Also: MODE [-b], BAN, UNBAN, CLRBAN, BANLIST");
&addhelp("BanList",
"\cbAdded by KSirc.pl\cb
Usage: BANLIST [<#channel>]
Shows all bans on the given channel. The channel defaults to your current one.
See Also: BAN, UNBAN, CLRBAN");
&addhelp("FC",
"\cbAdded by KSirc.pl\cb
Usage: FC [<#channel>] <Filter> <command>
Does /names on the given channel. Uses the current channel if none
specified. Does a userhost on each person received. if their name
(in form nick!user\@host) matches your filter (in perl regex form)
then command is executed, in command $1 is expanded to the nick of
the matchee.
Examples:
/fc #dragonrealm *!*\@*.com msg $1 you are on a host that ends in .com
/fc *!*\@((\\d+)\\.){3}\\.(\\d+) say $1 has a numeric host.");
&addhelp("Pig",
"\cbAdded by KSirc.pl\cb
Usage: PIG <message>
Translates your message into piglatin and says it on the current channel.");
&addhelp("WallOP",
"\cbAdded by KSirc.pl\cb
Usage: WALLOP [<#channel>] <message>
Sends a message to all of the channel operators on the given channel.
Defaults the the current channel.");
&addhelp("Amarok",
"\cbAdded by KSirc.pl\cb
Usage: AMAROK
Sends a message to the current channel saying what are you playing in amarok.");
sub cmd_wallop {
&getarg;
unless ($newarg =~ /^#/) {
$args = $newarg." ".$args;
$newarg = $talkchannel;
}
&notice("\@$newarg","[KSirc-Wall/$newarg]: $args");
}
&addcmd("wallop");
sub modeb {
($which) = @_;
$user =~ s/^~//;
if (length($user) > 8) {
$user = substr($user,0, 7);
$user .= "*";
}
@quad = split(/\./, $host);
if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
pop @quad;
$toban = join('.', @quad);
$toban .= ".*";
} else {
$toban = "*".$quad[@quad-2].".".$quad[@quad-1];
}
&docommand("mode $talkchannel ${which}b *!*$user*\@$toban");
}
sub cmd_ban {
&getarg;
if ($newarg) {
&userhost($newarg, "&modeb(\"+\");");
} else {
&tell("*\cbE\cb* Usage: /ban <nick>.");
}
}
&addcmd("ban");
sub cmd_unban {
&getarg;
if ($newarg) {
&userhost($newarg, "&modeb(\"-\");");
} else {
&tell("*\cbE\cb* Usage: /unban <nick>.");
}
}
&addcmd("unban");
sub cmd_banlist {
&getarg;
$newarg = $talkchannel unless $newarg;
&docommand("mode $newarg b");
&addhook("367", "banlist");
&addhook("368","rmbanlist");
}
&addcmd("banlist");
sub hook_banlist {
$silent = 1;
my (undef, $channel, $mask, $banner, $time) = split(/ +/, $_[0]);
&print("~!default~*** \cb$mask\cb banned from \cb$channel\cb by \cb$banner\cb on \cb" . localtime($time). "\cb");
}
sub hook_rmbanlist {
&remhook("367","banlist");
&remhook("368","rmbanlist");
}
sub cmd_k {
&getarg;
$args = "You have been kicked by a KSirc user." unless $args;
if ($newarg) {
&docommand("kick $talkchannel $newarg $args");
} else {
&tell("*\cbE\cb* Usage: /k <nick> [reason]");
}
}
&addcmd("k");
sub cmd_kb {
&getarg;
if ($newarg) {
&docommand("ban $newarg");
&docommand("k $newarg $args");
} else {
&tell("*\cbE\cb* Usage: /kb <nick> [reason]");
}
}
&addcmd("kb");
sub cmd_clrban {
&getarg;
$newarg = $talkchannel unless $newarg;
&addhook("367", "tban");
&addhook("368","rm367");
&docommand("mode $newarg b");
}
&addcmd("clrban");
sub hook_tban {
$silent = 1;
my ($shit, $channel, $mask, $banner, $time) = split(/ +/, $_[0]);
push @bans, $mask;
if (@bans == 6) {
&print("mode $channel -bbbbbb @bans");
@bans = ();
}
}
sub hook_rm367 {
@bans = ();
&remhook("367","tban");
&remhook("368","rm367");
}
sub hook_disconnectd {
&docommand("server 1");
}
&addhook("disconnect","disconnectd");
#sub hook_kickd {
# &docommand("join $_[1]") if $_[0] eq $nick;
#}
#&addhook("kick","kickd");
sub cmd_fcmd {
($names,$mask,$command) = split(/ /, $args,3);
$mask =~ s/\!/\!/;
$mask =~ s/\@/\@/;
$mask =~ s/\./\\./g;
$mask =~ s/\*/.*/g;
&addhook("353","filtercommand");
&addhook("366","removefiltercommand");
&tell("\t\cb~4Matching /$mask/i on $names...");
&docommand("names $names");
}
&addcmd("fcmd");
sub hook_filtercommand {
($shit, $_[0]) = split(/:/, $_[0]);
my @names = split(/ /, $_[0]);
for (@names) {
$_ =~ s/^\@//;
&userhost($_, "&dofilter");
}
$silent=1;
}
sub dofilter {
$s = "$who\!$user\@$host";
#&tell("$s =~ /$mask/");
if ($s =~ /$mask/i) {
$d = $command;
$d =~ s/\$1/$who/;
&docommand($d);
}
}
sub hook_removefiltercommand {
&remhook("353","filtercommand");
&remhook("366","removefiltercommand");
&tell("*\cbI\cb* Filter on $names, /$mask/i, Done.");
}
sub cmd_fc {
my ($mask, $cmd) = split(/ /, $args, 2);
&docommand("fcmd $talkchannel $mask $cmd");
}
&addcmd("fc");
sub cmd_pig {
$_[0] =~ s/^pig //i;
&say(&topiglatin($_[0]));
}
&addcmd("pig");
sub topiglatin {
@words = split(/ /, $_[0]);
for (@words) {
if ($_ =~ /^([bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ])([aeiouAEIOU])/) {
$_ .= substr($_,0,1)."ay";
$_ = substr($_,1);
} elsif ($_ =~ /^([bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ])([bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ])/) {
$_ .= $1.$2."ay";
$_ = substr($_,2);
} elsif ($_ =~ /^[aeiouAEIOU]/) {
$_ .= "way";
} else {
print "shouldn't print me\n";
}
}
return "@words";
}
&addhelp("follow",
"\cbAdded by KSirc.pl\cb
Usage: follow <nick>
Highlight <nick> in colour when ever they say anything");
&addhelp("unfollow",
"\cbAdded by KSirc.pl\cb
Usage: unfollow <nick>
Stop highlighting the nick");
&addhelp("showfollows",
"\cbAdded by KSirc.pl\cb
Usage: showfollows
Shows who you are currently following");
#### Start follow script from caracas
&addcmd ('follow');
&addcmd ('unfollow');
&addcmd ('showfollows');
@follow_colors = ( '~1', '~2', '~3', '~4', '~5', '~6', '~7', '~8', '~9', '~10', '~11', '~12', '~13', '~14', '~15' );
undef %following;
sub cmd_follow
{
my ($fnick) = shift;
my ($color);
$fnick =~ s/^follow\s+//;
$fnick =~ tr/A-Z/a-z/;
if (defined ($following{$fnick}))
{
&tell ("*\cbI\cb* Already following " . $following{$fnick});
}
else
{
$color = $follow_colors [int (rand scalar (@follow_colors))];
&docommand ("^ksircappendrule DESC==Follow $fnick !!! " .
"SEARCH==<\\S*$fnick\\S*> !!! FROM==<\\S*($fnick)\\S*> !!! TO==\"<$color\$1~c>\"");
$following{$fnick} = "${color}${fnick}~c";
&tell ("*\cbI\cb* Following ${color}$fnick~c ...");
}
}
sub cmd_unfollow
{
my ($fnick) = shift;
my ($filter);
$fnick =~ s/^unfollow\s+//;
$fnick =~ tr/A-Z/a-z/;
for ($filter = 0; $filter <= $#KSIRC_FILTER; $filter++)
{
if ($KSIRC_FILTER [$filter]{'DESC'} =~ /Follow $fnick/i)
{
&docommand ("^ksircdelrule $filter");
delete ($following{$fnick});
&tell ("*\cbI\cb* $fnick no longer followed");
return;
}
}
&tell ("*\cbI\cb* Wasn't following $fnick");
}
sub cmd_showfollows
{
my ($fnick);
if (scalar (keys %following) > 0)
{
foreach $fnick (sort keys %following)
{
&tell ("*\cbI\cb* Following " . $following {$fnick});
}
}
else
{
&tell ("\*cbI\cb* Not currently following anyone");
}
}
#### End follow
sub cmd_refresh
{
&tell("*** Refresh nick list");
&docommand("^extnames_forget $dest_chan");
&docommand("extnames $dest_chan");
}
&addcmd("refresh");
sub hook_url_who_list {
my @info = split(/\s+/, $_[0]);
&print("*I* URL: http://$info[3]:<port>/");
$silent = 1;
}
sub hook_url_end_who {
&remhook("352", "url_who_list");
&remhook("315", "url_end_who");
$args = "";
}
&addhelp("url",
"\cbAdded by KSirc.pl\cb
Usage: URL
Prints out your url");
sub cmd_url
{
&addhook("352", "url_who_list");
&addhook("315", "url_end_who");
&sl("who :$nick");
}
&addcmd("url");
%WHO_IGNORE = "";
sub cmd_extnames
{
&dosplat;
&getarg;
$newarg =~ tr/A-Z/a-z/;
return if $WHO_IGNORE{$newarg} == 1;
if($who_active == 0){
&addhook("352", "ksirc_who_list");
&addhook("315", "ksirc_who_end");
}
&sl("who :$newarg");
$who_active++;
$WHO_INFO{$newarg} = "";
$WHO_TIME{$newarg} = 0;
$WHO_COUNT{$newarg} = 0;
}
&addcmd("extnames");
sub hook_ksirc_who_end {
$who_active--;
if($who_active == 0){
&remhook("352", "ksirc_who_list");
&remhook("315", "ksirc_who_end");
}
my @info = split(/\s+/, $_[0]);
# 0: our nick
# 1: channel
# 2 Onwards: misc info
$info[1] =~ tr/A-Z/a-z/;
chop($WHO_INFO{$info[1]}); # Remove trailing space
my $c = ($WHO_TIME{$info[1]} == 0) ? "C" : "!";
if(length($WHO_INFO{$info[1]}) > 0){
&print("~$info[1]~*$c* Users on $info[1]: $WHO_INFO{$info[1]}");
$WHO_COUNT{$info[1]}++;
}
&print("~$info[1]~*c* Done Parsing Who");
# print "*I* Parsing: extnames done, $info[1], count: " . $WHO_COUNT{$info[1]} . "\n";
if($WHO_COUNT{$info[1]} > 25){
if($WHO_IGNORE{$info[1]} != 1){
$WHO_IGNORE{$info[1]} = 1;
&print('*$*' . " Extended nick list info turned off for $info[1], too many people in channel\n");
&print("*I* Extended nick list info turned off for $info[1], too many people in channel\n");
}
}
else {
$WHO_IGNORE{$info[1]} = 0;
}
delete($WHO_COUNT{$info[1]});
delete($WHO_INFO{$info[1]});
delete($WHO_TIME{$info[1]});
$args = "";
}
sub hook_ksirc_who_list {
my @info = split(/\s+/, $_[0]);
# 0: our nick
# 1: channel
# 2: ident
# 3: one server
# 4: another server
# 5: nick
# 6: status
# 7: rest is useless
$silent = 1;
my $who_nick = $info[5];
# print "*I* Parsing: $_[0], info6: $info[6]\n";
if($info[6] =~ /G/){
$who_nick = "#" . $who_nick;
}
if($info[6] =~ /\+/){
$who_nick = "+" . $who_nick;
}
if($info[6] =~ /\@/){
$who_nick = "@" . $who_nick;
}
if($info[6] =~ /\*/){
$who_nick = "*" . $who_nick;
}
$info[1] =~ tr/A-Z/a-z/;
$WHO_COUNT{$info[1]}++;
$WHO_INFO{$info[1]} .= $who_nick . " ";
if(length($WHO_INFO{$info[1]}) > 350){
my $c = ($WHO_TIME{$info[1]} == 0) ? "C" : "!";
&print("~$info[1]~*$c* Users on $info[1]: $WHO_INFO{$info[1]}");
$WHO_INFO{$info[1]} = "";
$WHO_TIME{$info[1]}++;
}
}
sub cmd_extnames_forget
{
&dosplat;
&getarg;
$newarg =~ tr/A-Z/a-z/;
$WHO_IGNORE{$newarg} = 0;
}
&addcmd("extnames_forget");
sub hook_nicks_on_join {
my $channel = shift;
if(&eq($who, $nick)){
&docommand("^extnames_forget $channel");
}
&docommand("^extnames $channel");
}
addhook("join", "nicks_on_join");
&tell("*** \0032,4\cbLoaded KSirc.pl\003");
&tell("*** \00313,3\cbWith: Super Willy Enhancements, LotR's exec\003");
sub cmd_exec {
my $how, $to;
&getarg;
$how = "x";
if (&eq($newarg, "-OUT")) { $how = 'c'; }
if (&eq($newarg, "-MSG")) { $how = 'm'; &getarg; $to = $newarg; }
if (&eq($newarg, "-NOTICE")) { $how = 'n'; &getarg; $to = $newarg; }
if ($how eq "x") { $args = $newarg . " " . $args; }
open (CMD, "$args|");
while (<CMD>) {
chomp;
if ($how eq 'c') {
&say(" $_");
} elsif ($how eq 'm') {
&msg($to, $_);
} elsif ($how eq 'n') {
&notice($to, $_);
} else {
print "$_\n";
}
}
close CMD;
}
&addcmd("exec");
&addhelp("exec", "Usage: EXEC <shell commands>\n" .
"EXEC -OUT <shell commands]\n" .
"EXEC -MSG <nickname> <shell commands>]\n" .
"EXEC -NOTICE <nickname> <shell commands>]\n" );
$k_highlight = 1;
if(open(FH, "<$HOME/.ksirc_highlight")){
chomp($k_highlight = <FH>);
close(FH);
}
sub hook_fixcolours {
if($k_highlight == 1){
$_[1] =~ s/(^|\s)\*([^*]+?)\*($|\s)/$1\002$2\002$3/g;
$_[1] =~ s/(^|\s)_([^_]+?)_($|\s)/$1\037$2\037$3/g;
$_[1] =~ s/(^|\s)#([^#]+?)#($|\s)/$1\026$2\026$3/g;
}
}
&addhook("send_text", "fixcolours");
sub cmd_dishighlight {
print "*I* Highlight parsing: ";
if($k_highlight == 0) {
$k_highlight = 1;
print "Enabled\n";
}
else {
$k_highlight = 0;
print "Disabled\n";
}
if(open(FH, ">$ENV{HOME}/.ksirc_highlight")){
print FH "$k_highlight\n";
close(FH);
}
else {
print "*E* Can't save highlight state $!\n";
}
}
&addcmd("dishighlight");
&addhelp("dishighlight", "Usage: dishighlight\n" .
"Toggles the convertion of *bold* into \cbbold\cb\n" .
"and _underline_ into \c_underline\c_ and #reverse#\n" .
"into \cvreverse\cv. It saves the state into\n" .
"~/.ksirc_highlight for convenience");
sub cmd_help {
&tell("*\cbH\cb* Help not available"), return unless @help;
my $found ='';
&getarg;
if($newarg =~ /^\s*$/){
my $line = '';
my %once;
foreach (@help) {
if (/^\@/) {
if (&eq($_, "\@main")) {
$found=1;
&tell("*\cbH\cb* Help on $newarg") if $newarg ne 'main'; # KSIRC MOD
}
else {
$found=0;
}
}
else {
&tell("*\cbH\cb* $_") if $found;
}
}
foreach (@help) {
if(/^\@/){
if(!&eq($_, "\@main")){
$found = 0;
my $cmd = /\@(\S+)/;
next if $once{$1};
$once{$1} = 1;
$line .= "$1 " . " "x(15-length("$1 ")); # KSIRC MOD
if(length($line) > 50){
&tell("*\cbH\cb* $line");
$line = "";
}
}
}
}
&tell("*\cbH\cb* $line");
$found=1;
}
else{
$newarg =~ s/ *$//;
foreach (@help) {
if (/^\@/) {
last if $found;
if (&eq($_, "\@$newarg")) {
$found=1;
&tell("*\cbH\cb* Help on $newarg") if $newarg ne 'main';
}
} else {
&tell("*\cbH\cb* $_") if $found;
}
}
} # KSIRC MOD
&tell("*\cbH\cb* Unknown help topic; try /help") unless $found;
}
&addcmd("help");
# New DCC resume/get features
my %A_RESUME_WAIT = ();
sub hook_ctcp_resume_reply {
my $towho = shift;
my $what = shift;
my $args = shift;
if($what eq 'DCC'){
my ($which, $file, $port, $pos) = split(/ +/, $args);
&tell("Got which: $which");
if($which eq 'ACCEPT'){
# &print("Got resume from $who port $port file: $file pos: $pos args: $args");
if($A_RESUME_WAIT{$port}){
&print("*\cbI\cb* DCC Resume with $who accepted");
&tell("~!dcc~DCC GET resumed who: $who file: " . $dgresume{$port}{"file"});
&tell("~!dcc~DCC GET read: " . $dgresume{$port}{"file"} . " bytes: " . $dgresume{$port}{"pos"}); # KSIRC MOD FOR 971217
$dgresume{$port}{"GotReply"} = 1;
delete $A_RESUME_WAIT{$port};
$skip = 1;
if($A_AUTOSTART{$port}){
&docommand($A_AUTOSTART{$port});
delete $A_AUTOSTART{$port};
}
}
}
elsif($which eq 'RESUME'){
my($lfh, $myport);
while(($lfh, $myport) = each %dsport){
if($port == $myport){
$skip = 1;
my $size = (-s $dfile{$dswait{$lfh}});
if($pos < $size){
seek($dswait{$lfh}, $pos, SEEK_SET);
$dsoffset{$lfh} = $pos;
&docommand("ctcp $who DCC ACCEPT $file $port $pos");
&tell("~!dcc~DCC SEND resumed who: $who file: " . $dfile{$dswait{$lfh}});
&tell("~!dcc~DCC SEND write: " . $dfile{$dswait{$lfh}} . " bytes: " . $pos); # KSIRC MOD FOR 971217
}
else {
&tell("*\cbE\cb* Got DCC resume with invalid size from $who for " . $dfile{$dswait{$lfh}});
}
}
}
}
}
}
&addhook("ctcp", "ctcp_resume_reply");
sub hook_ctcp_reject_reply {
my $towho = shift;
my $what = shift;
my $args = shift;
if($what eq 'DCC'){
my ($which, $type, $file) = split(/ +/, $args);
if($which eq 'REJECT'){
&tell("Got reject");
if($type eq 'CHAT'){
$no_reject = 1;
&tell("*\cbI\cb* DCC CHAT with $who rejected");
&docommand("/dcc close chat $who");
$skip = 1;
}
elsif($type eq 'GET'){
$no_reject = 1;
&tell("*\cbI\cb* DCC GET rejected by $who for $file");
&docommand("/dcc close get $who $file");
$skip = 1;
}
elsif($type eq 'SEND'){
$no_reject = 1;
&tell("*\cbI\cb* DCC SEND rejected by $who file $file");
&docommand("/dcc close send $who $file");
$skip = 1;
}
}
}
}
&addhook("ctcp_reply", "ctcp_reject_reply");
sub cmd_resume {
&getarg;
my $who = $newarg;
&getarg;
my $file = $newarg;
foreach $i (keys(%dgoffered)) {
my($h, $p, $f) = split(/ /, $i);
if (&eq($f, $file) && &eq($dgoffered{$i}, $who)) {
if(my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($file)){
&print("*\cbI\cb* Doing resume for $f with $who ($p)");
&docommand("ctcp $who DCC RESUME $f $p $size");
$dgresume{$p}{"pos"} = $size;
$dgresume{$p}{"file"} = $f;
$dgresume{$p}{"who"} = $who;
$A_RESUME_WAIT{$p} = 1;
}
else {
&print("*\cbE\cb* Error getting file ($file) size: $!");
}
}
}
}
&addcmd("resume");
sub cmd_amarok
{
$dcop=`dcop amarok`;
if(! ($dcop =~ /player/) ) {
&print("Error: Amarok is *not* running");
return;
}
$dcop=`dcop amarok player isPlaying`;
if(! ($dcop =~ /true/) ) {
&print("Amarok is not playing anything");
return
}
$output='is playing "$dcop" with Amarok';
$dcop= `dcop amarok player nowPlaying` ;
$dcop =~ s/^\s+//;
$dcop =~ s/\s+$//;
$output=~ s/(\$\w+)/$1/eeg;
&me( $output );
}
&addcmd("amarok");