#!/usr/bin/perl
#IP BL Bot v1.0 by seraphim, mit freundlicher Unterstützung der Supporter
#von de.perl.org und unter mithilfe von Talustus
#Support gibts nirgends, also seht wie ihr klar kommt :D
use strict;
use IO::Socket::INET;
use English;
use warnings;
use Data::Dumper;

#Pfadangabe zur Blacklistdatei!!!
my $srcpath = 'H:\perl\result.txt';
#Login Daten
my $operacc = "seraphim"; #Oper Account
my $operpw = "seraphim"; #Oper Passwort
my $nick = "P"; #Nick des Bots
my $ident = "Ident"; #Ident des Bots
my $rname = "Realname"; #Realname des Bots
my $chan = "#main"; #Channel, in den geloggt werden soll
my $bantime = "3600"; #Banzeit der GZLine in Sekunden
my $banreason = "Your IP is blacklisted at our local Database.";

#Operatoren des Bots, nimmt Befehle nur via PM an!
#Format: qw(nick nick nick nick nick);
my @opers = qw(seraphim);

#Socket öffnen
my $sock = IO::Socket::INET->new(
    PeerAddr => '127.0.0.1', #Adresse des IRCd´s
    PeerPort => 6667, #Port
    Proto    => 'tcp',
) or die $!;
#Introduction senden
print $sock "NICK $nick\r\n";
print "<NICK $nick\n";
print $sock "USER $ident localhost.de testserv.de :$rname\r\n";
print "<USER $ident localhost.de testserv.de $rname\n";
print $sock "JOIN :$chan\r\n";
print "JOINE :$chan\n";

my $oldnick = $nick;
my $idlemode = "0";

while (<$sock>) { #so lange $sock aktiv ist (also für alles was übertragen wird)
    chomp($_);
    if ($_ =~ /^PING(.*)$/i) {
        print $sock "PONG $1\r\n"; #ping-pong
    }else {
        #print ">$_\n"; #Debug Print
    };
    my @line = split ' ', $_; #aufteilen von $_ getrennt an chr32 zu $line[x]             local $/ = "\n";
    chomp @line;
    local $/ = "\r";
    chomp @line;
    if ($line[1] eq "376") { #bei Ende von /lusers Antwort
          print $sock "OPER $operacc $operpw\r\n";
          print "<OPER $operacc $operpw\n";
          print $sock "MODE $nick +Hpis +cFG\r\n";
          print "<MODE $nick +Hpis +cFG\n";
    };
    if ($idlemode == 0) {
            if ((defined $line[6]) && (defined $line[10])) {
               if (($line[6] eq "Client") && ($line[7] eq "connecting")) {
                  if ($line[8] eq "at") {
                     print $sock "USERIP $line[10]\r\n";
                     print "<USERIP $line[10]\n";
                  };
                  if (($line[8] eq "on")&& (defined $line[11])) {
                        print $sock "USERIP $line[11]\r\n";
                        print "<USERIP $line[11]\n";
                  };
               };
            };
    };
    #antwort auf /userip, Abgleich mit Liste
    if ($line[1] =~ /^\d+$/) {
       if ($line[1] == 340) {
          #print "$_\n";
          my @i = split /\@/, $_; #auftrennen von $_ an @
          my $ip = $i[1]; #definieren von $ip an $i[1], ist die IP von $_ hinter @
          if (defined $ip) { #Prüfung ob es überhaupt $ip gibt, für den fall dass User bei Userip nicht mehr online ist
             my @ipt = split /\./, $ip; #auftrennen von $ip (zb 127.0.0.1) an . in vier Blöcke
             $ipt[3] =~ s/\s{4}\z//; #entfernen der 4 Leerzeichen hinter dem letztem IP Block
             my $ipx = "$ipt[0].$ipt[1].$ipt[2].$ipt[3]"; #Zusammensetzen der editierten Strings zu einer reinen IP
             local $/ = "\n";
             chomp $ipx;
             #Blacklistdatei öffnen
             open my $handle, '<', $srcpath or die "Cant open File: $!";
             while (my $line = <$handle>) { #Durchlauf von @ipbl, der IP Blacklist
                   chomp $line;
                   if ($line eq $ipx) {
                      print $sock "GZLINE *\@$line $bantime :$banreason\r\n";
                      print $sock "PRIVMSG $chan :GEFUNDEN! $line war in Blacklist!\r\n";
                      #print "<GZLINE *\@$line $bantime :$banreason\n\r";
                      #print "<PRIVMSG $chan :GEFUNDEN! $line war in Blacklist!\n\r";
                      last;
                   };
             };
             close($handle);
          };
       };
    };
    if ($line[1] eq "PRIVMSG") {
        if ($line[2] eq $nick) {
                print "$_\n";
                my $snick = &getnick($line[0]);
                if (&ifop($snick,@opers) == 1) {
                        #Idle Mode - Scans auf IP werden nicht durchgeführt
                        if ($line[3] eq ":idlemode") {
                                if (($line[4] eq "on") && ($idlemode == 0)) {
                                        $idlemode = 1;
                                        my $n = $nick . "-idlemode";
                                        print $sock "NICK :$n\r\n";
                                        print "NICK :$n\n";
                                        $nick = $n;
                                        print $sock "PRIVMSG $chan :$snick aktivierte IDLE-MODE, Scans werden ausgesetzt.\r\n";
                                        #print "PRIVMSG $chan :$snick aktivierte IDLE-MODE, Scans werden ausgesetzt.\n";
                                };
                                if (($line[4] eq "off") && ($idlemode == 1)) {
                                        $idlemode = 0;
                                        print $sock "NICK :$oldnick\r\n";
                                        print "NICK :$oldnick\n";
                                        $nick = $oldnick;
                                        print $sock "PRIVMSG $chan :$snick deaktivierte IDLE-MODE, Scans werden wieder aufgenommen.\r\n";
                                        #print "PRIVMSG $chan :$snick deaktivierte IDLE-MODE, Scans werden wieder aufgenommen..\n";
                                };
                        };
                        #shutdown Befehl - Fährt Bot herunter
                        if ($line[3] eq ":shutdown") {
                                if (defined $line[4]) {
                                        my $x = scalar @line;
                                        $x = $x - 1;
                                        print $sock "PRIVMSG $chan :$snick befahl Shutdown des Bots: @line[4..$x]\r\n";
                                        print $sock "QUIT :$snick SHUTDOWN: @line[4..$x]\r\n";
                                        close($sock);
                                        die;
                                } else {
                                        my $x = scalar @line;
                                        print $sock "PRIVMSG $chan :$snick befahl Shutdown des Bots.\r\n";
                                        print $sock "QUIT :$snick SHUTDOWN: no reason\r\n";
                                        close($sock);
                                        die;
                                };
                        };
                        #löschen eines Eintrages aus der Liste
                        if (($line[3] eq ":remove") && (defined $line[4])) {
                                open my $handle1, '<', $srcpath or die "Cant open File: $!";
                                my @list;
                                my $search = "$line[4]";
                                print Dumper($search);
                                while (my $x = <$handle1>) {
                                        chomp $x;
                                        if ($x ne $search) {
                                                push @list, $x;
                                                print "$x";
                                        };
                                };
                                print "AAAA @list";
                                close ($handle1);
                                open my $handle2, '>', $srcpath or die "Cant open File: $!";
                                foreach my $o (@list) {
                                        print $handle2 "$o\n";
                                };
                                close($handle2);
                        };

                };
        };
    };
};
#Subroutine zum Rausfischen von Nick aus :Nick!ident@host
sub getnick {
        my @x = split /!/, $_;
        my @y = split /:/, $x[0];
        return $y[1];
};
#Subroutine zur Prüfung ob der Nick ein Operator ist (&ifop(nick,@opers))
sub ifop {
        my $x = $_[0];
        my @o = @_;
        my $z = scalar @o;
        $z = $z - 1;
        foreach (@o[1..$z]) {
                if ($_ eq $x) {
                        return 1;
                };
        };
};