# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
#
-if (&IsParam("useStrict")) { use strict; }
+use strict;
+
+use vars qw(%file %mask %param %cmdstats %myModules);
+use vars qw($msgType $who $bot_pid $nuh $shm $force_public_reply
+ $no_timehires $bot_data_dir $addrchar);
sub help {
my $topic = shift;
- my $file = $bot_misc_dir."/blootbot.help";
+ my $file = $bot_data_dir."/blootbot.help";
my %help = ();
- # crude hack for pSReply() to work as expected.
+ # crude hack for performStrictReply() to work as expected.
$msgType = "private" if ($msgType eq "public");
if (!open(FILE, $file)) {
- &ERROR("FAILED loadHelp ($file): $!");
+ &ERROR("Failed reading help file ($file): $!");
return;
}
&performStrictReply($_);
}
} else {
- &pSReply("no help on $topic. Use 'help' without arguments.");
+ &performStrictReply("no help on $topic. Use 'help' without arguments.");
}
return '';
} else { # the real thing.
return [gettimeofday()];
}
-}
+}
sub timedelta {
my($start_time) = shift;
sub formListReply {
my($rand, $prefix, @list) = @_;
my $total = scalar @list;
- my $maxshow = $param{'maxListReplyCount'} || 10;
- my $maxlen = $param{'maxListReplyLength'} || 400;
+ my $maxshow = &getChanConfDefault('maxListReplyCount', 15, $chan);
+ my $maxlen = &getChanConfDefault('maxListReplyLength', 400, $chan);
my $reply;
+ # remove irc overhead
+ $maxlen -= 30;
+
# no results.
return $prefix ."returned no results." unless ($total);
push(@rand, $list[$_]);
last if (scalar @rand == $maxshow);
}
- @list = @rand;
+ if ($total > $maxshow) {
+ @list = sort @rand;
+ } else {
+ @list = @rand;
+ }
} elsif ($total > $maxshow) {
&status("formListReply: truncating list.");
}
# form the reply.
+ # FIXME: should grow and exit when full, not discard any that are oversize
while () {
- $reply = $prefix ."(\002". scalar(@list). "\002 shown";
- $reply .= "; \002$total\002 total" if ($total != scalar @list);
- $reply .= "): ". join(" \002;;\002 ",@list) .".";
+ $reply = $prefix ."(\002". scalar(@list). "\002";
+ $reply .= " of \002$total\002" if ($total != scalar @list);
+ $reply .= "): " . join(" \002;;\002 ", @list) .".";
last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
last if (scalar(@list) == 1);
#####
# Usage: &Time2String(seconds);
sub Time2String {
- my $time = shift;
- my $retval;
+ my ($time) = @_;
+ my $prefix = "";
+ my (@s, @t);
+
+ return "NULL" if (!defined $time);
+ return $time if ($time !~ /\d+/);
- return("0s")
- if (!defined $time or $time !~ /\d+/ or $time <= 0);
+ if ($time < 0) {
+ $time = - $time;
+ $prefix = "- ";
+ }
- my $s = int($time) % 60;
- my $m = int($time / 60) % 60;
- my $h = int($time / 3600) % 24;
- my $d = int($time / 86400);
+ $t[0] = int($time) % 60;
+ $t[1] = int($time / 60) % 60;
+ $t[2] = int($time / 3600) % 24;
+ $t[3] = int($time / 86400);
- $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
- $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
- $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
- $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
+ push(@s, "$t[3]d") if ($t[3] != 0);
+ push(@s, "$t[2]h") if ($t[2] != 0);
+ push(@s, "$t[1]m") if ($t[1] != 0);
+ push(@s, "$t[0]s") if ($t[0] != 0 or !@s);
- return substr($retval, 1);
+ my $retval = $prefix.join(' ', @s);
+ $retval =~ s/(\d+)/\002$1\002/g;
+ return $retval;
}
###
# generate a hash list.
foreach (@files) {
- if (/^(.*\/)(.*?)$/) {
- $files{$1}{$2} = 1;
- }
+ next unless /^(.*\/)(.*?)$/;
+
+ $files{$1}{$2} = 1;
}
@files = (); # reuse the array.
# sort the hash list appropriately.
foreach (sort keys %files) {
my $file = $_;
- my @keys = sort keys %{$files{$file}};
+ my @keys = sort keys %{ $files{$file} };
my $i = scalar(@keys);
+ if (scalar @keys > 3) {
+ pop @keys while (scalar @keys > 3);
+ push(@keys, "...");
+ }
+
if ($i > 1) {
$file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
} else {
return $str;
}
-
-
##########
### get commands.
###
sub getRandomLineFromFile {
my($file) = @_;
- if (! -f $file) {
- &WARN("gRLfF: file '$file' does not exist.");
+ if (!open(IN, $file)) {
+ &WARN("gRLfF: could not open ($file): $!");
return;
}
- if (open(IN,$file)) {
- my @lines = <IN>;
+ my @lines = <IN>;
+ close IN;
- if (!scalar @lines) {
- &ERROR("GRLF: nothing loaded?");
- return;
- }
+ if (!scalar @lines) {
+ &ERROR("GRLF: nothing loaded?");
+ return;
+ }
- while (my $line = &getRandom(@lines)) {
- chop $line;
+ # could we use the filehandler instead and put it through getRandom?
+ while (my $line = &getRandom(@lines)) {
+ chop $line;
- next if ($line =~ /^\#/);
- next if ($line =~ /^\s*$/);
+ next if ($line =~ /^\#/);
+ next if ($line =~ /^\s*$/);
- return $line;
- }
- } else {
- &WARN("gRLfF: could not open file '$file'.");
- return;
+ return $line;
}
}
chop $line;
return $line;
} else {
- &ERROR("getLineFromFile: could not open file '$file'.");
+ &ERROR("gLFF: Could not open file ($file): $!");
return 0;
}
}
my $i = $1;
my $fuzzy = int(rand 5);
if ($i < 10) {
- return $i*60;
+ return $i;
}
if (rand > 0.5) {
return ($i - $fuzzy)*60;
$local{'host'} = &makeHostMask(lc $3);
}
- if ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
+ if (!defined $thisnuh) {
+ &WARN("IHM: thisnuh == NULL.");
+ return 0;
+ } elsif ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
$this{'nick'} = lc $1;
$this{'user'} = lc $2;
$this{'host'} = &makeHostMask(lc $3);
return 1;
}
+ if (!defined $file) {
+ &WARN("isStale: file == NULL.");
+ return 1;
+ }
+
+ &DEBUG("!exist $file") if (! -f $file);
+
return 1 unless ( -f $file);
- return 1 if (time() - (stat($file))[9] > $age*60*60*24);
+ if ($file =~ /idx/) {
+ my $age2 = time() - (stat($file))[9];
+ &VERB("stale: $age2. (". &Time2String($age2) .")",2);
+ }
+ $age *= 60*60*24 if ($age >= 0 and $age < 30);
+
+ return 1 if (time() - (stat($file))[9] > $age);
return 0;
}
+sub isFileUpdated {
+ my ($file, $time) = @_;
+
+ if (! -f $file) {
+ return 1;
+ }
+
+ my $time_file = (stat $file)[9];
+
+ if ($time <= $time_file) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
##########
### make commands.
###
# Usage: &makeHostMask($host);
sub makeHostMask {
- my ($host) = @_;
+ my ($host) = @_;
+ my $nu = "";
+
+ if ($host =~ s/^(\S+!\S+\@)//) {
+ &DEBUG("mHM: detected nick!user\@ for host arg; fixing");
+ &DEBUG("nu => $nu");
+ $nu = $1;
+ }
if ($host =~ /^$mask{ip}$/) {
- return "$1.$2.$3.*";
+ return $nu."$1.$2.$3.*";
}
my @array = split(/\./, $host);
- return $host if (scalar @array <= 3);
- return "*.".join('.',@{array}[1..$#array]);
+ return $nu.$host if (scalar @array <= 3);
+ return $nu."*.".join('.',@{array}[1..$#array]);
}
# Usage: &makeRandom(int);
sub validExec {
my ($str) = @_;
- if ($str =~ /[\'\"\|]/) { # invalid.
+ if ($str =~ /[\`\'\"\|]/) { # invalid.
return 0;
} else { # valid.
return 1;
}
}
-# Usage: &validFactoid($lhs,$rhs);
-sub validFactoid {
- my ($lhs,$rhs) = @_;
- my $valid = 0;
-
- for (lc $lhs) {
- # allow the following only if they have been made on purpose.
- if ($rhs ne "" and $rhs !~ /^</) {
- / \Q$ident$/i and last; # someone said i'm something.
- /^i('m)? / and last;
- /^(it|that|there|what)('s)?(\s+|$)/ and last;
- /^you('re)?(\s+|$)/ and last;
-
- /^(where|who|why|when|how)(\s+|$)/ and last;
- /^(this|that|these|those|they)(\s+|$)/ and last;
- /^(every(one|body)|we) / and last;
-
- /^say / and last;
- }
-
- # uncaught commands.
- /^add topic / and last; # topic management.
- /( add$| add |^add )/ and last; # borked teach statement.
- /^learn / and last; # teach. damn morons.
- /^tell (\S+) about / and last; # tell.
- /\=\~/ and last; # substituition.
- /^\S+ to \S+ \S+/ and last; # babelfish.
-
- /^\=/ and last; # botnick = heh is.
- /wants you to know/ and last;
-
- # symbols.
- /(\"\*)/ and last;
- /, / and last;
- /^\'/ and last;
-
- # delimiters.
- /\=\>/ and last; # '=>'.
- /\;\;/ and last; # ';;'.
- /\|\|/ and last; # '||'.
-
- /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
- /^[\-\, ]/ and last;
- /\\$/ and last; # forgot shift for '?'.
- /^all / and last;
- /^also / and last;
- / also$/ and last;
- / and$/ and last;
- /^because / and last;
- /^gives / and last;
- /^h(is|er) / and last;
- /^if / and last;
- / is,/ and last;
- / it$/ and last;
- / says$/ and last;
- /^should / and last;
- /^so / and last;
- /^supposedly/ and last;
- /^to / and last;
- /^was / and last;
- / which$/ and last;
-
- # nasty bug I introduced _somehow_, probably by fixMySQLBug().
- /\\\%/ and last;
- /\\\_/ and last;
-
- # weird/special stuff. also old blootbot or stock infobot bugs.
- $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
-
- # duplication.
- $rhs =~ /^\Q$lhs /i and last;
- last if ($rhs =~ /^is /i and / is$/);
-
- $valid++;
- }
-
- return $valid;
-}
-
# Usage: &hasProfanity($string);
sub hasProfanity {
my ($string) = @_;
for (lc $string) {
/fuck/ and last;
/dick|dildo/ and last;
- /shit|turd|crap/ and last;
+ /shit/ and last;
/pussy|[ck]unt/ and last;
/wh[0o]re|bitch|slut/ and last;
return $profanity;
}
-### rename to hasChanConf() ?
-sub hasParam {
+sub IsChanConfOrWarn {
my ($param) = @_;
- if (&IsChanConf($param) or &IsParam($param)) {
+ if (&IsChanConf($param) > 0) {
return 1;
} else {
### TODO: specific reason why it failed.
select(undef, undef, undef, 0.2);
# &status("fork starting for '$label', PID == $$.");
- &status("--- fork starting for '$label', PID == $$ ---");
+ &status("--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---");
&shmWrite($shm,"SET FORKPID $label $$");
sleep 1;
### TODO: use AUTOLOAD
### very lame hack.
- if ($label !~ /-/ and !&loadMyModule($myModules{$label})) {
+ if ($label !~ /-/ and !&loadMyModule($label)) {
&DEBUG("Forker: failed?");
&delForked($label);
}
return 0 if ( -f $file{PID});
}
+sub mkcrypt {
+ my($str) = @_;
+ my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
+
+ return crypt($str, $salt);
+}
+
+sub closeStats {
+ return unless (&getChanConfList("ircTextCounters"));
+
+ foreach (keys %cmdstats) {
+ my $type = $_;
+ my $i = &sqlSelect("stats", "counter", {
+ nick => $type,
+ type => "cmdstats",
+ } );
+ my $z = 0;
+ $z++ unless ($i);
+
+ $i += $cmdstats{$type};
+
+
+ &sqlReplace("stats", {
+ nick => $type,
+ type => "cmdstats",
+ 'time' => time(),
+ counter => $i,
+ } );
+ }
+}
+
1;