# akickban.pl
# "shitlist" script for sirc - like the autoop list, but instead of
# opping users on the list, bans and kicks them
#
# Mark Cornick, aka Gnudist (mark@evol.resnet.jmu.edu)
# Based on avoice.pl by orabidoo (roger.espel.llima@ens.fr)
# $Id: akickban.pl,v 1.1 1996/03/17 21:11:22 mark Exp $
#
# (C) 1996 Mark Cornick
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with sirc; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

$add_ons.="+akickban.pl" if $add_ons !~ /kickban/;

$autokickban=1;
@autokickban=();
$akbfile=$ENV{"HOME"}."/.akickban-pl.sve";

# default kickban msg.
$kickbanmsg = "\cbYou are not welcome here\cb";

sub akb_hostpat {
  if ($_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
    return "${1}.${2}.${3}.*";
  } elsif ($_[0] =~ /^([^. \t]+)\.([^. \t]+)\.(.*)$/) {
    return "*.${2}.${3}";
  } else {
    return $_[0];
  }
}

sub autokbanned {
  local($nuh)=@_;
  local($p);
  foreach $p (@autokickban) {
    return 1 if $nuh =~ /^${p}$/;
  }
  return '';
}

sub addtokickban {
  if (&autokbanned($who."!".$user."\@".$host)) {
    &tell("*\cba\cb* $who is already on your auto-kickban list");
  } else {
    $host=&akb_hostpat($host);
    $user =~ s/^\~//;
    local($pat)=("*!*".$user."\@".$host);
    &tell("*\cba\cb* Adding $who as $pat to your auto-kickban list");
    $pat =~ s/([^\\])\./$1\\./g;
    $pat =~ s/\*/\.\*/g;
    $pat =~ s/([^\.\*\\\w])/\\$1/g;
    push(@autokickban, $pat);
  }
}

sub cmd_addkickban {
  &getarg;
  &tell("*\cba\cb* Must specify a nick or pattern"), return unless $newarg;
  if ($newarg =~ /\!.*\@/) {
    &tell("*\cba\cb* Adding $newarg to your auto-kickban list");
    $newarg =~ s/([^\\])\./$1\\./g;
    $newarg =~ s/\*/\.\*/g;
    $newarg =~ s/([^\.\*\\\w])/\\$1/g;
    push(@autokickban, $newarg);
  } else {
    &userhost($newarg, "&addtokickban;");
  }
}
&addcmd("addkickban");

sub hook_akbjoined {
  local($c)=($_[0]);
  $c =~ tr/A-Z/a-z/;
  &sl("MODE $c +b *!$user*\@$host")
    if ($autokickban && $haveops{$c} && &autokbanned($who."!".$user."\@".$host));

# the following really should be done with &sl but if it is, the kick message
# will only be the first word of $kickbanmsg, not the whole string.
# &docommand works a little better here. Don't know why.

  &sl("KICK $c $who :$kickbanmsg")
    if ($autokickban && $haveops{$c} && &autokbanned($who."!".$user."\@".$host));

}
&addhook("join", "akbjoined");

sub cmd_autokickban {
  &getarg;
  if ($newarg =~ /^on$/) {
    $autokickban=1;
  } elsif ($newarg =~ /^off$/) {
    $autokickban='';
  }
  &tell("*\cba\cb* Auto-kickban is ".($autokickban?"on":"off"));
}
&addcmd("autokickban");

sub cmd_listkickban {
  local($n, $p, $q)=(0);
  &tell("*\cba\cb* That's the people in your auto-kickban list:");
  foreach $p (@autokickban) {
    $n++;
    $q=$p;
    $q =~ s/\\//g;
    $q =~ s/\.\*/*/g;
    &tell("*\cba\cb* $q");
  }
  &tell("*\cba\cb* which makes.. uhm... $n people, I think");
}
&addcmd("listkickban");

sub remkickban {
  local($nuh)=($who."!".$user."\@".$host);
  @autokickban=grep(($nuh !~ /^${_}$/), @autokickban);
}

sub cmd_remkickban {
  &getarg;
  if (!$newarg) {
    &tell("*\cba\cb* Must specify a nick or address");
  } elsif ($newarg =~ /\@/) {
    $newarg='*!'.$newarg if ($newarg !~ /\!/);
    &tell("*\cba\cb* Time to remove $newarg from the auto-kickban list");
    @autokickban=grep(($newarg !~ /^${_}$/), @autokickban);
  } else {
    &tell("*\cba\cb* Time to remove $newarg from the auto-kickban list");
    &userhost($newarg, "&remkickban;");
  }
}
&addcmd("remkickban");

sub cmd_clearkickban {
  @autokickban=();
  &tell("*\cba\cb* Auto-kickban list cleared!");
}
&addcmd("clearkickban");

# saving the settings

sub cmd_svekickban {
  local($p);
  if (!open(SVE, "> ".$akbfile)) {
    &tell("*\cbE\cb* can't write to save file");
    return;
  }
  print SVE ($autokickban ? "1" : "0"), "\n";
  print SVE $kickbanmsg, "\n";
  print SVE join(" ", @autokickban), "\n";
  close SVE;
  &tell("*\cba\cb* save completed!");
}
&addcmd("svekickban");

sub cmd_setkickbanmsg {
    $kickbanmsg=$args if $args;
    &tell("*\cb0\cb* Your kickbanmsg reply is: $kickbanmsg");
}
&addcmd("setkickbanmsg");

# some online help

&addhelp("kickban", "This is \cbakickban.pl\cb for sirc, by \cbGnudist\cb
[based on avoice.pl by orabidoo]
 
/autokickban [on|off]        toggles auto-kickban
/addkickban <nick>|<pattrn>  adds user to your auto-kickban list
/remkickban <nick>|<address> removes user from your auto-kickban list
/clearkickban                clears your auto-kickban list
/listkickban                 lists your auto-kickban list
/setkickbanmsg [<message>]   set or see the message users see when kicked
/svekickban                  saves your kickban list, message and toggle");

# reading the saved settings

if (open(AKB, "< ".$akbfile)) {
  local($n, $l);
  chop($autokickban=<AKB>);
  chop($kickbanmsg=<AKB>);
  chop($l=<AKB>);
  @autokickban=split(' ', $l);
  close(AKB);
}

&print("*\cba\cb* \cbGnudist\cb's *\cvakickban.pl\cv* loaded, type /help kickban  for help");