X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FMisc.pl;h=e580fa0ece969f578dec4a5059007aebb514727f;hb=0a03234c837cefef8cd59c3f078e8a1732ae35c9;hp=b75fd7e89b80476fc37fcc5cb8825962c3c6550b;hpb=1e6f9b30799e2285dac32b2ce4b8b913f2501081;p=infobot.git diff --git a/src/Misc.pl b/src/Misc.pl index b75fd7e..e580fa0 100644 --- a/src/Misc.pl +++ b/src/Misc.pl @@ -5,15 +5,22 @@ # 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 = $_[0]; - my $file = $bot_misc_dir."/blootbot.help"; + my $topic = shift; + my $file = $bot_data_dir."/infobot.help"; my %help = (); + # 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; } @@ -32,12 +39,12 @@ sub help { $val =~ s/__/\037/g; $val =~ s/==/ /; - $help{$key} = "" if (!exists $help{$key}); + $help{$key} = '' if (!exists $help{$key}); $help{$key} .= $val."\n"; } close FILE; - if (!defined $topic) { + if (!defined $topic or $topic eq '') { &msg($who, $help{'main'}); my $i = 0; @@ -63,10 +70,10 @@ sub help { if (exists $help{$topic}) { foreach (split /\n/, $help{$topic}) { - &msg($who,$_); + &performStrictReply($_); } } else { - &msg($who, "no help on $topic. Use 'help' without arguments."); + &performStrictReply("no help on $topic. Use 'help' without arguments."); } return ''; @@ -83,16 +90,21 @@ sub getPath { } } -sub gettimeofday { - if ($no_syscall) { # fallback. +sub timeget { + if ($no_timehires) { # fallback. return time(); } else { # the real thing. - my $time = pack("LL", 0); + return [gettimeofday()]; + } +} - syscall(&SYS_gettimeofday, $time, 0); - my @time = unpack("LL",$time); +sub timedelta { + my($start_time) = shift; - return sprintf("%d.%d", @time); + if ($no_timehires) { # fallback. + return time() - $start_time; + } else { # the real thing. + return tv_interval ($start_time); } } @@ -105,10 +117,13 @@ sub gettimeofday { 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); @@ -119,7 +134,11 @@ sub formListReply { 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."); @@ -127,10 +146,11 @@ sub formListReply { } # 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); @@ -145,7 +165,7 @@ sub formListReply { # Usage: &IJoin(@array); sub IJoin { if (!scalar @_) { - return "NULL"; + return 'NULL'; } elsif (scalar @_ == 1) { return $_[0]; } else { @@ -156,22 +176,31 @@ sub IJoin { ##### # Usage: &Time2String(seconds); sub Time2String { - my $time = shift; - my $retval; + my ($time) = @_; + my $prefix = ''; + my (@s, @t); - return("0s") if ($time !~ /\d+/ or $time <= 0); + return 'NULL' if (!defined $time); + return $time if ($time !~ /\d+/); - my $s = int($time) % 60; - my $m = int($time / 60) % 60; - my $h = int($time / 3600) % 24; - my $d = int($time / 86400); + if ($time < 0) { + $time = - $time; + $prefix = "- "; + } - $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); + $t[0] = int($time) % 60; + $t[1] = int($time / 60) % 60; + $t[2] = int($time / 3600) % 24; + $t[3] = int($time / 86400); - return substr($retval, 1); + 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); + + my $retval = $prefix.join(' ', @s); + $retval =~ s/(\d+)/\002$1\002/g; + return $retval; } ### @@ -185,18 +214,23 @@ sub fixFileList { # 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 { @@ -223,7 +257,9 @@ sub fixString { s/\s+/ /g; # remove excessive whitespaces. next unless (defined $level); - s/[\cA-\c_]//ig # remove control characters. + if (s/[\cA-\c_]//ig) { # remove control characters. + &DEBUG("stripped control chars"); + } } return $str; @@ -233,31 +269,39 @@ sub fixString { sub fixPlural { my ($str,$int) = @_; - if ($str eq "has") { - $str = "have" if ($int > 1); - } elsif ($str eq "is") { - $str = "are" if ($int > 1); - } elsif ($str eq "was") { - $str = "were" if ($int > 1); - } elsif ($str eq "this") { - $str = "these" if ($int > 1); + if (!defined $str) { + &WARN("fixPlural: str == NULL."); + return; + } + + if (!defined $int or $int =~ /^\D+$/) { + &WARN("fixPlural: int != defined or int"); + return $str; + } + + if ($str eq 'has') { + $str = 'have' if ($int > 1); + } elsif ($str eq 'is') { + $str = 'are' if ($int > 1); + } elsif ($str eq 'was') { + $str = 'were' if ($int > 1); + } elsif ($str eq 'this') { + $str = 'these' if ($int > 1); } elsif ($str =~ /y$/) { if ($int > 1) { if ($str =~ /ey$/) { - $str .= "s"; # eg: "money" => "moneys". + $str .= 's'; # eg: 'money' => 'moneys'. } else { $str =~ s/y$/ies/; } } } else { - $str .= "s" if ($int != 1); + $str .= 's' if ($int != 1); } return $str; } - - ########## ### get commands. ### @@ -265,30 +309,27 @@ sub fixPlural { 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 = ; + my @lines = ; + 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; } } @@ -313,7 +354,7 @@ sub getLineFromFile { chop $line; return $line; } else { - &ERROR("getLineFromFile: could not open file '$file'."); + &ERROR("gLFF: Could not open file ($file): $!"); return 0; } } @@ -330,13 +371,18 @@ sub getRandom { sub getRandomInt { my $str = $_[0]; + if (!defined $str) { + &WARN("gRI: str == NULL."); + return; + } + srand(); - if ($str =~ /^(\d+)$/) { + if ($str =~ /^(\d+(\.\d+)?)$/) { my $i = $1; my $fuzzy = int(rand 5); if ($i < 10) { - return $i*60; + return $i; } if (rand > 0.5) { return ($i - $fuzzy)*60; @@ -381,20 +427,23 @@ sub IsHostMatch { $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); } else { &WARN("IHM: thisnuh is invalid '$thisnuh'."); - return 1 if ($thisnuh eq ""); + return 1 if ($thisnuh eq ''); return 0; } # auth if 1) user and host match 2) user and nick match. # this may change in the future. - if ($this{'user'} =~ /^\Q$local{'user'}$/i) { + if ($this{'user'} =~ /^\Q$local{'user'}\E$/i) { return 2 if ($this{'host'} eq $local{'host'}); return 1 if ($this{'nick'} eq $local{'nick'}); } @@ -406,30 +455,67 @@ sub IsHostMatch { sub isStale { my ($file, $age) = @_; - &DEBUG("isStale: $file does not exist") unless ( -f $file); + if (!defined $age) { + &WARN("isStale: age == NULL."); + 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); - my $delta = time() - (stat($file))[9]; - my $hage = $age*60*60*24; - &DEBUG("isStale: not stale! $delta < $hage"); + 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); @@ -462,7 +548,7 @@ sub makeRandom { sub checkMsgType { my ($reply) = @_; - return unless (&IsParam("minLengthBeforePrivate")); + return unless (&IsParam('minLengthBeforePrivate')); return if ($force_public_reply); if (length $reply > $param{'minLengthBeforePrivate'}) { @@ -479,89 +565,13 @@ sub checkMsgType { 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 !~ /^/ 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) = @_; @@ -570,7 +580,7 @@ sub hasProfanity { 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; @@ -580,12 +590,13 @@ sub hasProfanity { return $profanity; } -sub hasParam { +sub IsChanConfOrWarn { my ($param) = @_; - if (&IsParam($param)) { + if (&IsChanConf($param) > 0) { return 1; } else { + ### TODO: specific reason why it failed. &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar); return 0; } @@ -598,17 +609,26 @@ sub Forker { &shmFlush(); &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid); - if (&IsParam("forking") and $$ == $bot_pid) { - return $noreply unless (&addForked($label)); + if (&IsParam('forking') and $$ == $bot_pid) { + return unless &addForked($label); + $SIG{CHLD} = 'IGNORE'; - $pid = eval { fork() }; # catch non-forking OSes and other errors - return $noreply if $pid; # parent does nothing - &status("fork starting for '$label', PID == $$."); + $pid = eval { fork() }; + return if $pid; # parent does nothing + + select(undef, undef, undef, 0.2); +# &status("fork starting for '$label', PID == $$."); + &status("--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---"); + &shmWrite($shm,"SET FORKPID $label $$"); + + sleep 1; } - if (!&loadMyModule($myModules{$label})) { + ### TODO: use AUTOLOAD + ### very lame hack. + if ($label !~ /-/ and !&loadMyModule($label)) { &DEBUG("Forker: failed?"); - return; + &delForked($label); } if (defined $code) { @@ -617,11 +637,7 @@ sub Forker { &WARN("Forker: code not defined!"); } - if (defined $pid) { # child. - &delForked($label); - &status("fork finished for '$label'."); - exit 0; - } + &delForked($label); } sub closePID { @@ -631,4 +647,34 @@ sub closePID { 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}; + + + &sqlSet('stats', {'nick' => $type}, { + type => 'cmdstats', + 'time' => time(), + counter => $i, + } ); + } +} + 1;