[BACK]Return to botnow.pl CVS log [TXT][DIR] Up to [local] / botnow

Annotation of botnow/botnow.pl, Revision 1.1

1.1     ! bountyht    1: #!/usr/bin/perl
        !             2:
        !             3: use strict;
        !             4: no strict 'refs';
        !             5: use warnings;
        !             6: use IO::Socket;
        !             7: use IO::Select;
        !             8: use OpenBSD::Pledge;
        !             9: use OpenBSD::Unveil;
        !            10:
        !            11: my $confpath = "botnow.conf";
        !            12: our %conf;
        !            13: foreach my $line (readarray($confpath)) {
        !            14:        if ($line =~ /^#/ or $line =~ /^\s*$/) { # skip comments and whitespace
        !            15:                next;
        !            16:        } elsif ($line =~ /^([-_a-zA-Z0-9]+)\s*=\s*([[:print:]]+)$/) {
        !            17:                $conf{$1} = $2;
        !            18:        } else {
        !            19:                die "ERROR: botnow.conf format invalid: $line";
        !            20:        }
        !            21: }
        !            22:
        !            23: # Name of local network
        !            24: $conf{localnet} = $conf{localnet} || "ircnow";
        !            25:
        !            26: # Internal IPv4 address and plaintext port
        !            27: $conf{host} = $conf{host} || "127.0.0.1";
        !            28: $conf{port} = $conf{port} || 1337;
        !            29:
        !            30: # Bouncer hostname
        !            31: chomp($conf{hostname} = $conf{hostname} || `hostname`);
        !            32:
        !            33: # External IPv4 address, plaintext and ssl port
        !            34: $conf{ip4} = $conf{ip4} or die "ERROR: botnow.conf: ip4";
        !            35: $conf{plainport} = $conf{plainport} || 1337;
        !            36: $conf{sslport} = $conf{sslport} || 31337;
        !            37:
        !            38: # Nick and password of bot -- Make sure to add to oper block
        !            39: $conf{nick} = $conf{nick} || "botnow";
        !            40: $conf{pass} = $conf{pass} or die "ERROR: botnow.conf: pass";
        !            41:
        !            42: # Comma-separated list of channels for requesting bouncers
        !            43: $conf{chans} = $conf{chans} || "#ircnow";
        !            44:
        !            45: #Join chans on localnet?
        !            46: $conf{localchans} = defined($conf{localchans}) && ($conf{localchans} =~ /^true/i);
        !            47:
        !            48: # Number of words in password
        !            49: $conf{passlength} = $conf{passlength} || 3;
        !            50:
        !            51: # Mail from address
        !            52: if (!defined($conf{mailname})) {
        !            53:        if ($conf{mailfrom} =~ /^([^@]+)@/) {
        !            54:                $conf{mailname} = $1 or die "ERROR: botnow.conf mailname";
        !            55:        }
        !            56: }
        !            57:
        !            58: # rDNS keys from Stallion in BuyVM
        !            59: $conf{key} = $conf{key} or die "ERROR: botnow.conf: key";
        !            60: $conf{hash} = $conf{hash} or die "ERROR: botnow.conf: hash";
        !            61:
        !            62: # ZNC install directory
        !            63: $conf{zncdir} = $conf{zncdir} || "/home/znc/home/znc";
        !            64:
        !            65: # NSD zone dir
        !            66: $conf{zonedir} = $conf{zonedir} || "/var/nsd/zones/master/";
        !            67:
        !            68: # Network Interface Config File
        !            69: $conf{hostnameif} = $conf{hostnameif} || "/etc/hostname.vio0";
        !            70:
        !            71: # Verbosity: 0 (no errors), 1 (errors), 2 (warnings), 3 (diagnostic)
        !            72: use constant {
        !            73:        NONE => 0,
        !            74:        ERRORS => 1,
        !            75:        WARNINGS => 2,
        !            76:        ALL => 3,
        !            77: };
        !            78: $conf{verbose} = $conf{verbose} || ERRORS;
        !            79:
        !            80: # Terms of Service; don't edit lines with the word EOF
        !            81: $conf{terms} = $conf{terms} || "IRCNow: Of the User, By the User, For the User. Rules: no profanity, no porn, no illegal drugs, no gambling, no slander, no warez, no promoting violence, no spam, illegal cracking, or DDoS. Only one account per person. Don't share passwords. Full terms: https://ircnow.org/terms.php";
        !            82:
        !            83: $conf{ipv6path} = "ipv6s"; # ipv6 file path
        !            84: $conf{netpath} = "networks"; # networks file path
        !            85: $conf{expires} = $conf{expires} || 1800; # time before captcha expires
        !            86:
        !            87: if(defined($conf{die})) { die $conf{die}; }
        !            88:
        !            89: my @modules;
        !            90: if (defined($conf{modules})) {
        !            91:        @modules = split(/\s+/, $conf{modules});
        !            92: }
        !            93: use lib './';
        !            94: foreach my $mod (@modules) {
        !            95:        require "$mod.pm";
        !            96: }
        !            97: foreach my $mod (@modules) {
        !            98:        my $init = "${mod}::init";
        !            99:        $init->();
        !           100: }
        !           101:
        !           102: our @networks;
        !           103: my @bots;
        !           104: my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
        !           105: my @days = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
        !           106: my @chans = split /[,\s]+/m, $conf{chans};
        !           107: my @teamchans;
        !           108: if (defined($conf{teamchans})) { @teamchans = split /[,\s]+/m, $conf{teamchans}; }
        !           109: my $call;
        !           110: my $botnick = $conf{nick};
        !           111: my $host = $conf{host};
        !           112: my $port = $conf{port};
        !           113: my $pass = $conf{pass};
        !           114: my $localnet = $conf{localnet};
        !           115: my $staff = $conf{staff};
        !           116: my @stafflist = split(/ /,$staff);
        !           117: my $verbose = $conf{verbose};
        !           118: my $ipv6path = $conf{ipv6path};
        !           119: my $netpath = $conf{netpath};
        !           120: my $expires = $conf{expires};
        !           121: my $localchans = $conf{localchans};
        !           122:
        !           123: unveil("./", "r") or die "Unable to unveil $!";
        !           124: unveil("$confpath", "r") or die "Unable to unveil $!";
        !           125: unveil("$netpath", "r") or die "Unable to unveil $!";
        !           126: unveil("$ipv6path", "rwc") or die "Unable to unveil $!";
        !           127: unveil() or die "Unable to lock unveil $!";
        !           128:
        !           129: #dns and inet for sockets, proc and exec for figlet
        !           130: #rpath for reading file, wpath for writing file, cpath for creating path
        !           131: #flock, fattr for sqlite
        !           132: pledge( qw(stdio rpath wpath cpath inet dns proc exec flock fattr) ) or die "Unable to pledge: $!";
        !           133:
        !           134: # Read from filename and return array of lines without trailing newlines
        !           135: sub readarray {
        !           136:        my ($filename) = @_;
        !           137:        open(my $fh, '<', $filename) or die "Could not read file '$filename' $!";
        !           138:        chomp(my @lines = <$fh>);
        !           139:        close $fh;
        !           140:        return @lines;
        !           141: }
        !           142:
        !           143: # Read from filename and return as string
        !           144: sub readstr {
        !           145:        my ($filename) = @_;
        !           146:        open my $fh, '<', $filename or die "Could not read file '$filename' $!";
        !           147:        my $str = do { local $/; <$fh> };
        !           148:        close $fh;
        !           149:        return $str;
        !           150: }
        !           151:
        !           152: # Write str to filename
        !           153: sub writefile {
        !           154:        my ($filename, $str) = @_;
        !           155:        open(my $fh, '>', "$filename") or die "Could not write to $filename";
        !           156:        print $fh $str;
        !           157:        close $fh;
        !           158: }
        !           159:
        !           160: # Append str to filename
        !           161: sub appendfile {
        !           162:        my ($filename, $str) = @_;
        !           163:        open(my $fh, '>>', "$filename") or die "Could not append to $filename";
        !           164:        print $fh $str;
        !           165:        close $fh;
        !           166: }
        !           167:
        !           168: # Return list of networks from filename
        !           169: # To add multiple servers for a single network, simply create a new entry with
        !           170: # the same net name; znc ignores addnetwork commands when a network already exists
        !           171: sub readnetworks {
        !           172:        my ($filename) = @_;
        !           173:        my @lines = readarray($filename);
        !           174:        my @networks;
        !           175:        foreach my $line (@lines) {
        !           176:                if ($line =~ /^#/ or $line =~ /^\s*$/) { # skip comments and whitespace
        !           177:                        next;
        !           178:                } elsif ($line =~ /^\s*([-a-zA-Z0-9]+)\s*([-_.:a-zA-Z0-9]+)\s*(~|\+)?([0-9]+)\s*$/) {
        !           179:                        my ($name, $server, $port) = ($1, $2, $4);
        !           180:                        my $trustcerts;
        !           181:                        if (!defined($3)) {
        !           182:                                $trustcerts = 0;
        !           183:                        } elsif ($3 eq "~") { # Use SSL but trust all certs
        !           184:                                $port = "+".$port;
        !           185:                                $trustcerts = 1;
        !           186:                        } else { # Use SSL and verify certs
        !           187:                                $port = "+".$port;
        !           188:                                $trustcerts = 0;
        !           189:                        }
        !           190:                        push(@networks, {"name" => $name, "server" => $server, "port" => $port, "trustcerts" => $trustcerts });
        !           191:                } else {
        !           192:                        die "network format invalid: $line\n";
        !           193:                }
        !           194:        }
        !           195:        return @networks;
        !           196: }
        !           197:
        !           198: @networks = readnetworks($netpath);
        !           199:
        !           200: # networks must be sorted to avoid multiple connections
        !           201: @networks = sort @networks;
        !           202:
        !           203: # create sockets
        !           204: my $sel = IO::Select->new( );
        !           205: my $lastnet = "";
        !           206: foreach my $network (@networks) {
        !           207:        # avoid duplicate connections
        !           208:        if ($lastnet eq $network->{name}) { next; }
        !           209:        $lastnet = $network->{name};
        !           210:        my $socket = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port, Proto=>'tcp', Timeout=>'300') || print "Failed to establish connection\n";
        !           211:        $sel->add($socket);
        !           212:        my $bot = {("sock" => $socket), %$network};
        !           213:        push(@bots, $bot);
        !           214:        putserv($bot, "NICK $botnick");
        !           215:        putserv($bot, "USER $botnick * * :$botnick");
        !           216: }
        !           217:
        !           218: while(my @ready = $sel->can_read) {
        !           219:        my ($bot, $response);
        !           220:        my ($sender, $val);
        !           221:        foreach my $socket (@ready) {
        !           222:                foreach my $b (@bots) {
        !           223:                        if($socket == $b->{sock}) {
        !           224:                                $bot = $b;
        !           225:                                last;
        !           226:                        }
        !           227:                }
        !           228:                if (!defined($response = <$socket>)) {
        !           229:                        debug(ERRORS, "ERROR ".$bot->{name}." has no response:");
        !           230:                        next;
        !           231:                }
        !           232:                if ($response =~ /^PING :(.*)\r\n$/i) {
        !           233:                        putserv($bot, "PONG :$1");
        !           234:                } elsif ($response =~ /^:irc.znc.in (.*) (.*) :(.*)\r\n$/) {
        !           235:                        my ($type, $target, $text) = ($1, $2, $3);
        !           236:                        if ($type eq "001" && $target =~ /^$botnick.?$/ && $text eq "Welcome to ZNC") {
        !           237:                        } elsif ($type eq "NOTICE" && $target =~ /^$botnick.?$/ && $text eq "*** To connect now, you can use /quote PASS <username>:<password>, or /quote PASS <username>/<network>:<password> to connect to a specific network.") {
        !           238:                        } elsif ($type eq "NOTICE" && $target =~ /^$botnick.?$/ && $text eq "*** You need to send your password. Configure your client to send a server password.") {
        !           239:                        } elsif ($type eq "464" && $target =~ /^$botnick.?$/ && $text eq "Password required") {
        !           240:                                putserv($bot, "PASS $botnick/$bot->{name}:$pass");
        !           241:                                if ($bot->{name} =~ /^$localnet$/i) {
        !           242:                                        putserv($bot, "OPER $botnick $pass");
        !           243:                                        putserv($bot, "PRIVMSG *status :LoadMod --type=user controlpanel");
        !           244:                                        putserv($bot, "PRIVMSG *controlpanel :get Admin $botnick");
        !           245:                                        putserv($bot, "PRIVMSG *controlpanel :get Nick cloneuser");
        !           246:                                        foreach my $chan (@teamchans) {
        !           247:                                                putserv($bot, "JOIN $chan");
        !           248:                                        }
        !           249:                                }
        !           250:                                if ($bot->{name} !~ /^$localnet$/i or $localchans) {
        !           251:                                        foreach my $chan (@chans) {
        !           252:                                                putserv($bot, "JOIN $chan");
        !           253:                                        }
        !           254:                                }
        !           255:                        } elsif ($type eq "464" && $target =~ /^$botnick.?$/ && $text eq "Invalid Password") {
        !           256:                                die "ERROR: Wrong Username/Password: $bot->{name}";
        !           257:                        } else {
        !           258:                                debug(ERRORS, "Unexpected bncnow.pl 257: type: $type, target: $target, text: $text");
        !           259:                        }
        !           260:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) PRIVMSG ([^ ]+) :(.*)\r\n$/i) {
        !           261:                        my ($hostmask, $nick, $host, $target, $text) = ($1, $2, $3, $4, $5);
        !           262:                        if ($hostmask eq '*status!znc@znc.in' && $target =~ /^$botnick.?$/) {
        !           263:                                if ($text =~ /Network ([[:ascii:]]+) doesn't exist./) {
        !           264:                                        debug(ERRORS, "nonexistent: $1");
        !           265:                                } elsif ($text eq "You are currently disconnected from IRC. Use 'connect' to reconnect.") {
        !           266:                                        debug(ERRORS, "disconnected: $bot->{name}");
        !           267:                                } elsif ($text =~ /Unable to load module (.*): Module (.*) already loaded./) {
        !           268:                                        debug(ALL, "Module $1 already loaded\n");
        !           269:                                } elsif ($text =~ /^Disconnected from IRC.*$/) {
        !           270:                                        debug(ERRORS, "$bot->{name}: $text");
        !           271:                                } elsif ($text =~ /^|/) {
        !           272:                                        debug(ERRORS, "$bot->{name}: $text");
        !           273:                                } else {
        !           274:                                        debug(ERRORS, "Unexpected bncnow.pl 273: $response");
        !           275:                                }
        !           276:                        } elsif ($text =~ /^!([[:graph:]]+)\s*(.*)/) {
        !           277:                                my ($cmd, $text) = ($1, $2);
        !           278:                                my $hand = $staff; # TODO fix later
        !           279:                                if ($target =~ /^#/) {
        !           280:                                        foreach my $c (@{$call->{pub}}) {
        !           281:                                                if ($cmd eq $c->{cmd}) {
        !           282:                                                        my $proc = $c->{proc};
        !           283:                                                        $proc->($bot, $nick, $host, $hand, $target, $text);
        !           284:                                                }
        !           285:                                        }
        !           286:                                } else {
        !           287:                                        foreach my $c (@{$call->{msg}}) {
        !           288:                                                if ($cmd eq $c->{cmd}) {
        !           289:                                                        my $proc = $c->{proc};
        !           290:                                                        $proc->($bot, $nick, $host, $hand, $text);
        !           291:                                                }
        !           292:                                        }
        !           293:                                }
        !           294:                        } else {
        !           295:                                my $hand = $staff; # TODO fix later
        !           296:                                if ($target =~ /^#/) {
        !           297:                                        foreach my $c (@{$call->{pubm}}) {
        !           298:                                                my $proc = $c->{proc};
        !           299:                                                $proc->($bot, $nick, $host, $hand, $target, $text);
        !           300:                                        }
        !           301:                                } else {
        !           302:                                        foreach my $c (@{$call->{msgm}}) {
        !           303:                                                my $proc = $c->{proc};
        !           304:                                                $proc->($bot, $nick, $host, $hand, $text);
        !           305:                                        }
        !           306:                                }
        !           307:                        }
        !           308:                        debug(ALL, "$hostmask $target $text");
        !           309:                } elsif($response =~ /^:([^ ]+) NOTICE ([^ ]+) :(.*)\r\n$/i) {
        !           310:                        my ($hostmask, $target, $text) = ($1, $2, $3);
        !           311:                        if ($hostmask =~ /([^!]+)!([^@]+@[^@ ]+)/) {
        !           312:                                my ($nick, $host) = ($1, $2);
        !           313:                                my $hand = $staff; # TODO fix later
        !           314:                                foreach my $c (@{$call->{notc}}) {
        !           315:                                        #       if ($text eq $c->{mask}) { # TODO fix later
        !           316:                                        my $proc = $c->{proc};
        !           317:                                        $proc->($bot, $nick, $host, $hand, $text, $target);
        !           318:                                        #       }
        !           319:                                }
        !           320:                                # TODO use CTCR
        !           321:                                # CTCP replies
        !           322:                                if ($hostmask ne '*status!znc@znc.in') {
        !           323:                                        if ($text =~ /^&(PING|VERSION|TIME|USERINFO) (.*)&$/i) {
        !           324:                                                my ($key, $val) = ($1, $2);
        !           325:                                                my $id = SQLite::id("irc", "nick", $nick, $expires);
        !           326:                                                SQLite::set("irc", "id", $id, "ctcp".lc($key), $val);
        !           327:                                                SQLite::set("irc", "id", $id, "localtime", time());
        !           328:                                        }
        !           329:                                }
        !           330:                        }
        !           331:                        debug(ALL, "$hostmask NOTICE $target $text");
        !           332: #:portlane.se.quakenet.org NOTICE guava :Highest connection count: 1541 (1540 clients)
        !           333: #:portlane.se.quakenet.org NOTICE guava :on 2 ca 2(4) ft 20(20) tr
        !           334:                } elsif($response =~ /^:([^ ]+) MODE ([^ ]+) ([^ ]+)\s*(.*)\r\n$/i) {
        !           335:                        my ($hostmask, $chan, $change, $targets) = ($1, $2, $3, $4);
        !           336:                        if ($hostmask =~ /([^!]+)!([^@]+@[^@ ]+)/) {
        !           337:                                my ($nick, $host) = ($1, $2);
        !           338:                                my $hand = $staff; # TODO fix later
        !           339:                                foreach my $c (@{$call->{mode}}) {
        !           340:                                        # TODO filter by mask
        !           341:                                        my $proc = $c->{proc};
        !           342:                                        $proc->($bot, $nick, $host, $hand, $chan, $change, $targets);
        !           343:                                }
        !           344:                        }
        !           345:                        debug(ALL, "$hostmask MODE $chan $change $targets");
        !           346: #:guava!guava@guava.guava.ircnow.org MODE guava :+Ci
        !           347: #:ChanServ!services@services.irc.ircnow.org MODE #testing +q jrmu
        !           348: #:jrmu!jrmu@jrmu.staff.ircnow.org MODE #testing +o jrmu
        !           349: #Unexpected bncnow.pl 460: :irc.guava.ircnow.org MODE guava :+o
        !           350:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) JOIN :?(.*)\r\n$/i) {
        !           351:                        my ($hostmask, $nick, $host, $chan) = ($1, $2, $3, $4);
        !           352:                        my $hand = $staff; # TODO fix later
        !           353:                        foreach my $c (@{$call->{join}}) {
        !           354:                                my $proc = $c->{proc};
        !           355:                                $proc->($bot, $nick, $host, $hand, $chan);
        !           356:                        }
        !           357:                        debug(ALL, "$hostmask JOIN $chan");
        !           358: #:jrmu!jrmu@jrmu.staff.ircnow.org JOIN :#testing
        !           359:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) PART ([^ ]+) :(.*)\r\n$/i) {
        !           360:                        my ($hostmask, $nick, $host, $chan, $text) = ($1, $2, $3, $4, $5);
        !           361:                        my $hand = $staff; # TODO fix later
        !           362:                        foreach my $c (@{$call->{part}}) {
        !           363:                                #       if ($text eq $c->{mask}) { # TODO fix later
        !           364:                                my $proc = $c->{proc};
        !           365:                                $proc->($bot, $nick, $host, $hand, $chan, $text);
        !           366:                                #       }
        !           367:                        }
        !           368:                        debug(ALL, "$hostmask PART $chan :$text");
        !           369: #:jrmu!jrmu@jrmu.staff.ircnow.org PART #testing :
        !           370:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) KICK (#[^ ]+) ([^ ]+) :(.*)\r\n$/i) {
        !           371:                        my ($hostmask, $nick, $host, $chan, $kicked, $text) = ($1, $2, $3, $4, $5, $6);
        !           372:                        my $hand = $staff; # TODO fix later
        !           373:                        foreach my $c (@{$call->{kick}}) {
        !           374:                                #       if ($text eq $c->{mask}) { # TODO fix later
        !           375:                                my $proc = $c->{proc};
        !           376:                                $proc->($bot, $nick, $host, $hand, $chan, $text);
        !           377:                                #       }
        !           378:                        }
        !           379:                        debug(ALL, "$hostmask KICK $chan $kicked :$text");
        !           380: #jrmu!jrmu@jrmu.users.undernet.org KICK #ircnow guava :this is a test
        !           381:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) NICK :?(.*)\r\n$/i) {
        !           382:                        my ($hostmask, $nick, $host, $text) = ($1, $2, $3, $4);
        !           383:                        debug(ALL, "$hostmask NICK $text");
        !           384: #:Fly0nDaWaLL|dal!psybnc@do.not.h4ck.me NICK :nec|dal
        !           385:                } elsif($response =~ /^:(([^!]+)!([^@]+@[^@ ]+)) QUIT :(.*)\r\n$/i) {
        !           386:                        my ($hostmask, $nick, $host, $text) = ($1, $2, $3, $4);
        !           387:                        debug(ALL, "$hostmask QUIT :$text");
        !           388: #:Testah!~sid268081@aa38a510 QUIT :Client closed connection
        !           389:                } elsif($response =~ /^NOTICE AUTH :(.*)\r\n$/i) {
        !           390:                        my ($text) = ($1);
        !           391:                        debug(ALL, "NOTICE AUTH: $text");
        !           392: #NOTICE AUTH :*** Looking up your hostname
        !           393: #NOTICE AUTH: *** Looking up your hostname
        !           394: #NOTICE AUTH: *** Checking Ident
        !           395: #NOTICE AUTH: *** Got ident response
        !           396: #NOTICE AUTH: *** Found your hostname
        !           397:                } elsif ($response =~ /^:([[:graph:]]+) (\d\d\d) $botnick.? :?(.*)\r?\n?\r$/i) {
        !           398:                        my ($server, $code, $text) = ($1, $2, $3);
        !           399:                        if ($code =~ /^001$/) { # Server Info
        !           400:                                debug(ERRORS, "connected: $bot->{name}");
        !           401:                        } elsif ($code =~ /^0\d\d$/) { # Server Info
        !           402:                                debug(ALL, "$server $code $text");
        !           403:                        } elsif ($code =~ /^2\d\d$/) { # Server Stats
        !           404:                                debug(ALL, "$server $code $text");
        !           405:                        } elsif ($code == 301 && $text =~ /^([-_\|`a-zA-Z0-9]+) :([[:graph:]]+)/) {
        !           406:                                debug(ALL, "$text");
        !           407:                        } elsif ($code == 307 && $text =~ /^([-_\|`a-zA-Z0-9]+) (.*)/) {
        !           408:                                my ($sender, $key) = ($1, "registered");
        !           409:                                $val = $2 eq ":is a registered nick" ? "True" : "$2";
        !           410:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           411:                                SQLite::set("irc", "id", $id, "identified", $val);
        !           412:                                debug(ALL, "$key: $val");
        !           413:                        } elsif ($code == 311 && $text =~ /^([-_\|`a-zA-Z0-9]+) ([^:]+)\s+([^:]+) \* :([^:]*)/) {
        !           414:                                my ($sender, $key, $val) = ($1, "hostmask", "$1\!$2\@$3");
        !           415:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           416:                                SQLite::set("irc", "id", $id, $key, $val);
        !           417:                                debug(ALL, "$key: $val");
        !           418:                        } elsif ($code == 312 && $text =~ /^([-_\|`a-zA-Z0-9]+) ([^:]+) :([^:]+)/) {
        !           419:                                my ($sender, $key, $val) = ($1, "server", $2);
        !           420:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           421:                                SQLite::set("irc", "id", $id, $key, $val);
        !           422:                                debug(ALL, "$key: $val");
        !           423:                        } elsif ($code == 313 && $text =~ /^([-_\|`a-zA-Z0-9]+) :?(.*)/) {
        !           424:                                my ($sender, $key, $val) = ($1, "oper", ($2 eq "is an IRC operator" ? "True" : "$2"));
        !           425:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           426:                                SQLite::set("irc", "id", $id, $key, $val);
        !           427:                                debug(ALL, "$key: $val");
        !           428:                        } elsif ($code == 315 && $text =~ /^([-_\|`a-zA-Z0-9]+) :End of \/?WHO(IS)? list/) {
        !           429:                                debug(ALL, "End of WHOIS");
        !           430:                        } elsif ($code == 317 && $text =~ /^([-_\|`a-zA-Z0-9]+) (\d+) (\d+) :?(.*)/) {
        !           431:                                ($sender, my $idle, my $epochtime) = ($1, $2, $3);
        !           432:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           433:                                SQLite::set("irc", "id", $id, "idle", $idle);
        !           434: #                              SQLite::set("irc", "id", $id, "epochtime", time());
        !           435:                                debug(ALL, "idle: $idle, epochtime: $epochtime");
        !           436:                        } elsif ($code == 318 && $text =~ /^([-_\|`a-zA-Z0-9]+) :End of \/?WHOIS list/) {
        !           437:                                debug(ALL, "End of WHOIS");
        !           438:                        } elsif ($code == 319 && $text =~ /^([-_\|`a-zA-Z0-9]+) :(.*)/) {
        !           439:                                my ($sender, $key, $val) = ($1, "chans", $2);
        !           440:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           441:                                SQLite::set("irc", "id", $id, $key, $val);
        !           442:                                debug(ALL, "$key: $val");
        !           443:                        } elsif ($code == 330 && $text =~ /^([-_\|`a-zA-Z0-9]+) ([-_\|`a-zA-Z0-9]+) :?(.*)/) {
        !           444:                                my ($sender, $key, $val) = ($1, "identified", ($3 eq "is logged in as" ? "True" : $2));
        !           445:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           446:                                SQLite::set("irc", "id", $id, $key, $val);
        !           447:                                debug(ALL, "$key: $val");
        !           448:                        } elsif ($code == 338 && $text =~ /^([-_\|`a-zA-Z0-9]+) ([0-9a-fA-F:.]+) :actually using host/) {
        !           449:                                my ($sender, $key, $val) = ($1, "ip", $2);
        !           450:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           451:                                SQLite::set("irc", "id", $id, $key, $val);
        !           452:                                debug(ALL, "$key: $val");
        !           453:        #Unexpected: efnet.port80.se 338 jrmu 206.253.167.44 :actually using host
        !           454:                        } elsif ($code == 378 && $text =~ /^([-_\|`a-zA-Z0-9]+) :is connecting from ([^ ]+)\s*([0-9a-fA-F:.]+)?/) {
        !           455:                                my ($sender, $key, $val) = ($1, "ip", $3);
        !           456:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           457:                                SQLite::set("irc", "id", $id, $key, $val);
        !           458:                                debug(ALL, "$key: $val");
        !           459:                        } elsif ($code == 671 && $text =~ /^([-_\|`a-zA-Z0-9]+) :is using a secure connection/) {
        !           460:                                my ($sender, $key, $val) = ($1, "ssl", "True");
        !           461:                                my $id = SQLite::id("irc", "nick", $sender, $expires);
        !           462:                                SQLite::set("irc", "id", $id, $key, $val);
        !           463:                                debug(ALL, "$key: $val");
        !           464:                        } elsif ($code =~ /^332$/) { # Topic
        !           465:                #               print "$text\r\n";
        !           466:                        } elsif ($code =~ /^333$/) { #
        !           467:                #               print "$server $text\r\n";
        !           468:                #karatkievich.freenode.net 333 #ircnow jrmu!znc@206.253.167.44 1579277253
        !           469:                        } elsif ($code =~ /^352$/) { # Hostmask
        !           470: #:datapacket.hk.quakenet.org 352 * znc guava.guava.ircnow.org *.quakenet.org guava H :0 guava
        !           471:                #               print "$server $code $text\r\n";
        !           472:                        } elsif ($code =~ /^353$/) { # Names
        !           473:                #               print "$server $code $text\r\n";
        !           474:                        } elsif ($code =~ /^366$/) { # End of names
        !           475:                #               print "$server $code $text\r\n";
        !           476:                        } elsif ($code =~ /^37\d$/) { # MOTD
        !           477:                #               print "$server $code $text\r\n";
        !           478:                        } elsif ($code =~ /^381$/) { # IRC Operator Verified
        !           479:                #               print "IRC Oper Verified\r\n";
        !           480:                        } elsif ($code =~ /^401$/) { # IRC Operator Verified
        !           481:                #               print "IRC Oper Verified\r\n";
        !           482:                        } elsif ($code =~ /^403$/) { # No such channel
        !           483:                #               debug(ERRORS, "$text");
        !           484:                        } elsif ($code =~ /^422$/) { # MOTD missing
        !           485:                #               print "$server $code $text\r\n";
        !           486:                        } elsif ($code =~ /^396$/) { # Display hostname
        !           487:                #               print "$server $code $text\r\n";
        !           488: #Unexpected bncnow.pl 454: irc.guava.ircnow.org 396 guava.guava.ircnow.org :is your displayed hostname now
        !           489:                        } elsif ($code =~ /^464$/) { # Invalid password for oper
        !           490:                                foreach my $chan (@teamchans) {
        !           491:                                        putserv($bot, "PRIVMSG $chan :$botnick oper password failed; the bot will be unable to view uncloaked IP addresses");
        !           492:                                }
        !           493:                        } elsif ($code =~ /^477$/) { # Can't join channel
        !           494:                                foreach my $chan (@teamchans) {
        !           495:                                        putserv($bot, "PRIVMSG $chan :ERROR: $botnick on $server: $text");
        !           496:                                }
        !           497:                        } elsif ($code == 716 && $text =~ /^([-_\|`a-zA-Z0-9]+) :is in \+g mode \(server-side ignore.\)/) {
        !           498:                                debug(ALL, "$text");
        !           499:                        } else {
        !           500:                                debug(ERRORS, "Unexpected bncnow.pl 454: $server $code $text");
        !           501:                        }
        !           502:                } else {
        !           503:                        debug(ERRORS, "Unexpected bncnow.pl 460: $response");
        !           504:                }
        !           505:        }
        !           506: }
        !           507:
        !           508: sub putserv {
        !           509:        my( $bot, $text )=@_;
        !           510:        my $socket = $bot->{sock};
        !           511:        if ($text =~ /^([^:]+):([[:ascii:]]*)$/m) {
        !           512:                my ($cmd, $line) = ($1, $2);
        !           513:                my @lines = split /\r?\n/m, $line;
        !           514:                foreach my $l (@lines) {
        !           515:                        print $socket "$cmd:$l\r\n";
        !           516:                }
        !           517:        } else {
        !           518:                print $socket "$text\r\n";
        !           519:        }
        !           520: }
        !           521:
        !           522: sub putserv {
        !           523:        my( $bot, $text )=@_;
        !           524:        my $socket = $bot->{sock};
        !           525:        if ($text =~ /^([^:]+):([[:ascii:]]*)$/m) {
        !           526:                my ($cmd, $line) = ($1, $2);
        !           527:                my @lines = split /\r?\n/m, $line;
        !           528:                foreach my $l (@lines) {
        !           529:                        print $socket "$cmd:$l\r\n";
        !           530:                }
        !           531:        } else {
        !           532:                print $socket "$text\r\n";
        !           533:        }
        !           534: }
        !           535:
        !           536: sub putservlocalnet {
        !           537:        my( $bot, $text )=@_;
        !           538:        my $botlocalnet;
        !           539:        foreach my $b (@bots) {
        !           540:                if($b->{name} =~ /^$localnet$/i) {
        !           541:                        $botlocalnet = $b;
        !           542:                        last;
        !           543:                }
        !           544:        }
        !           545:        putserv($botlocalnet, $text);
        !           546: }
        !           547:
        !           548:
        !           549: sub date {
        !           550:        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
        !           551:        my $localtime = sprintf("%04d%02d%02d", $year+1900, $mon+1, $mday);
        !           552:        return $localtime;
        !           553: }
        !           554: sub gettime {
        !           555:        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
        !           556:        my $localtime = sprintf("%s %s %d %02d:%02d:%02d", $days[$wday], $months[$mon], $mday, $hour, $min, $sec);
        !           557:        return $localtime;
        !           558: }
        !           559:
        !           560: sub whois {
        !           561:        my( $socket, $target )=@_;
        !           562:        print $socket "WHOIS $target $target\r\n";
        !           563: }
        !           564:
        !           565: sub ctcp {
        !           566:        my( $socket, $target )=@_;
        !           567: #      print $socket "PRIVMSG $target :".chr(01)."CLIENTINFO".chr(01)."\r\n";
        !           568: #      print $socket "PRIVMSG $target :".chr(01)."FINGER".chr(01)."\r\n";
        !           569: #      print $socket "PRIVMSG $target :".chr(01)."SOURCE".chr(01)."\r\n";
        !           570:        print $socket "PRIVMSG $target :".chr(01)."TIME".chr(01)."\r\n";
        !           571: #      print $socket "PRIVMSG $target :".chr(01)."USERINFO".chr(01)."\r\n";
        !           572:        print $socket "PRIVMSG $target :".chr(01)."VERSION".chr(01)."\r\n";
        !           573: #      print $socket "PRIVMSG $target :".chr(01)."PING".chr(01)."\r\n";
        !           574: }
        !           575:
        !           576: sub cbind {
        !           577:        my ($type, $flags, $cmd, $proc) = @_;
        !           578:        if ($type eq "pub") {
        !           579:                push(@{$call->{pub}}, {cmd => $cmd, proc => $proc});
        !           580:        } elsif ($type eq "msg") {
        !           581:                push(@{$call->{msg}}, {cmd => $cmd, proc => $proc});
        !           582:        } elsif ($type eq "notc") {
        !           583:                push(@{$call->{notc}}, {mask => $cmd, proc => $proc});
        !           584:        } elsif ($type eq "mode") {
        !           585:                push(@{$call->{mode}}, {mask => $cmd, proc => $proc});
        !           586:        } elsif ($type eq "join") {
        !           587:                push(@{$call->{join}}, {mask => $cmd, proc => $proc});
        !           588:        } elsif ($type eq "partcall") {
        !           589:                push(@{$call->{part}}, {mask => $cmd, proc => $proc});
        !           590:        } elsif ($type eq "pubm") {
        !           591:                push(@{$call->{pubm}}, {mask => $cmd, proc => $proc});
        !           592:        } elsif ($type eq "msgm") {
        !           593:                push(@{$call->{msgm}}, {mask => $cmd, proc => $proc});
        !           594:        }
        !           595: }
        !           596:
        !           597: sub debug {
        !           598:        my ($level, $msg) = @_;
        !           599:        if ($verbose >= $level) { print "$msg\n"; }
        !           600: }
        !           601:
        !           602: sub isstaff {
        !           603:        my( $bot, $nick ) = @_;
        !           604:        if( !( $bot->{name} =~ /^$localnet$/i ) )
        !           605:        {
        !           606:                return 0;
        !           607:        }
        !           608:        my $lnick = lc $nick;
        !           609:        foreach( @stafflist ) {
        !           610:                if( $lnick eq $_ ) {
        !           611:                        return 1;
        !           612:                }
        !           613:        }
        !           614:        return 0;
        !           615: }

CVSweb