X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FUserExtra.pl;h=ada60ce8113155e9c07a0e378c67793df0f403a1;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=0e43a3b81bcaa62e0f8371cce6e7387cf34a49ad;hpb=c35c69fa2e9479628f528c2b45f8f8f2a53aa635;p=infobot.git diff --git a/src/UserExtra.pl b/src/UserExtra.pl index 0e43a3b..ada60ce 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -5,381 +5,591 @@ # Created: 20000107 # -if (&IsParam("useStrict")) { use strict; } +use strict; +use vars qw($message $arg $qWord $verb $lobotomized $who $result $chan + $conn $msgType $query $talkchannel $ident $memusage); +use vars qw(%channels %chanstats %cmdstats %count %ircstats %param + %cache %mask %userstats %hooks_main); + +### +### Start of command hooks for UserExtra. +### + +&addCmdHook("main", 'chan(stats|info)', ('CODEREF' => 'chaninfo', ) ); +&addCmdHook("main", 'cmd(stats|info)', ('CODEREF' => 'cmdstats', ) ); +&addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo', + 'Cmdstats' => 'Factoid Info', Module => 'factoids', ) ); +&addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats', + 'Cmdstats' => 'Factoid Stats', Help => "factstats", + Forker => 1, 'Identifier' => 'factoids', ) ); +&addCmdHook("main", 'help', ('CODEREF' => 'help', + 'Cmdstats' => 'Help', ) ); +&addCmdHook("main", 'karma', ('CODEREF' => 'karma', ) ); +&addCmdHook("main", 'i?spell', ('CODEREF' => 'ispell', + Help => 'spell', Identifier => 'spell', ) ); +&addCmdHook("main", 'd?nslookup', ('CODEREF' => 'DNS', + Help => 'nslookup', Identifier => 'allowDNS', + Forker => "NULL", ) ); +&addCmdHook("main", 'tell|explain', ('CODEREF' => 'tell', + Help => 'tell', Identifier => 'allowTelling', + Cmdstats => 'Tell') ); +&addCmdHook("main", 'news', ('CODEREF' => 'News::Parse', + Module => 'news', 'Cmdstats' => 'News' ) ); +&addCmdHook("main", 'countrystats', ('CODEREF' => 'countryStats', +# Forker => "NULL", + ) ); + +&status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks."); + +### +### Start of commands for hooks. +### + +sub chaninfo { + my $chan = lc shift(@_); + my $mode; + + if ($chan eq "") { # all channels. + my $i = keys %channels; + my $reply = "i am on \002$i\002 ".&fixPlural("channel",$i); + my $tucount = 0; # total user count. + my $uucount = 0; # unique user count. + my @array; -use vars qw($message $arg $qWord $verb $lobotomized); -use vars qw(%channels %chanstats %cmdstats); + ### line 1. + foreach (sort keys %channels) { + if ( /^\s*$/ or / / ) { + &status("chanstats: fe channels: chan == NULL."); + &ircCheck(); + next; + } + next if (/^_default$/); -sub userCommands { - return '' unless ($addressed); + my $str = sprintf("%s (%d)", $_, scalar(keys %{ $channels{$_}{''} })); + push(@array, $str); + } + &pSReply($reply.": ".join(', ', @array)); - # chaninfo. xk++. - if ($message =~ /^chan(stats|info)(\s+(\S+))?$/i) { - my $chan = lc $3; - my $mode; - - if ($chan eq "") { # all channels. - my $count = 0; - my $i = keys %channels; - my $reply = "i am on \002$i\002 ".&fixPlural("channel",$i); - my @array; - - ### line 1. - foreach (sort keys %channels) { - if (/^\s*$/ or / /) { - &status("chanstats: fe channels: chan == NULL."); - &ircCheck(); - next; - } - push(@array, "$_ (".scalar(keys %{$channels{$_}{''}}).")"); - } - &performStrictReply($reply.": ".join(' ', @array)); - - ### line 2. - foreach $chan (keys %channels) { - # crappy debugging... - # TODO: use $mask{chan} instead? - if ($chan =~ / /) { - &ERROR("bad channel: chan => '$chan'."); - } - $count += scalar(keys %{$channels{$chan}{''}}); + ### total user count. + foreach $chan (keys %channels) { + $tucount += scalar(keys %{ $channels{$chan}{''} }); + } + + ### unique user count. + my @nicks; + foreach $chan (keys %channels) { + foreach (keys %{ $channels{$chan}{''} }) { + next if (grep /^\Q$_\E$/, @nicks); + $uucount++; + push(@nicks, $_); } - &performStrictReply( - "i've cached \002$count\002 ".&fixPlural("user",$count). - " distributed over \002".scalar(keys %channels)."\002 ". - &fixPlural("channel",scalar(keys %channels))."." - ); + } - return $noreply; + if (scalar @nicks != $uucount) { + &DEBUG("nicks != uucount..."); } - # channel specific. + my $chans = scalar(keys %channels); + &pSReply( + "i've cached \002$tucount\002 ". &fixPlural("user",$tucount). + ", \002$uucount\002 unique ". &fixPlural("user",$uucount). + ", distributed over \002$chans\002 ". + &fixPlural("channel", $chans)."." + ); - if (&validChan($chan) == 0) { - &msg($who,"error: invalid channel \002$chan\002"); - return $noreply; - } + return; + } - # Step 1: - my @array; - foreach (sort keys %{$chanstats{$chan}}) { - my $int = $chanstats{$chan}{$_}; - next unless ($int); + # channel specific. - push(@array, "\002$int\002 ". &fixPlural($_,$int)); - } - my $reply = "On \002$chan\002, there ". + if (&validChan($chan) == 0) { + &msg($who,"error: invalid channel \002$chan\002"); + return; + } + + # Step 1: + my @array; + foreach (sort keys %{ $chanstats{$chan} }) { + my $int = $chanstats{$chan}{$_}; + next unless ($int); + + push(@array, "\002$int\002 ". &fixPlural($_,$int)); + } + my $reply = "On \002$chan\002, there ". &fixPlural("has",scalar(@array)). " been ". &IJoin(@array); - # Step 1b: check channel inconstencies. - $chanstats{$chan}{'Join'} ||= 0; - $chanstats{$chan}{'SignOff'} ||= 0; - $chanstats{$chan}{'Part'} ||= 0; + # Step 1b: check channel inconstencies. + $chanstats{$chan}{'Join'} ||= 0; + $chanstats{$chan}{'SignOff'} ||= 0; + $chanstats{$chan}{'Part'} ||= 0; - my $delta_stats = $chanstats{$chan}{'Join'} + my $delta_stats = $chanstats{$chan}{'Join'} - $chanstats{$chan}{'SignOff'} - $chanstats{$chan}{'Part'}; - if ($delta_stats) { - my $total = scalar(keys %{$channels{$chan}{''}}); - &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."); + if ($delta_stats) { + my $total = scalar(keys %{ $channels{$chan}{''} }); + &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."); - if ($delta_stats > $total) { - &ERROR("chaninfo: delta_stats exceeds total users."); - } + if ($delta_stats > $total) { + &ERROR("chaninfo: delta_stats exceeds total users."); } + } - # Step 2: - undef @array; - my $type; - foreach ("v","o","") { - my $int = scalar(keys %{$channels{$chan}{$_}}); - next unless ($int); + # Step 2: + undef @array; + my $type; + foreach ("v","o","") { + my $int = scalar(keys %{ $channels{$chan}{$_} }); + next unless ($int); - $type = "Voice" if ($_ eq "v"); - $type = "Opped" if ($_ eq "o"); - $type = "Total" if ($_ eq ""); + $type = "Voice" if ($_ eq "v"); + $type = "Opped" if ($_ eq "o"); + $type = "Total" if ($_ eq ""); - push(@array,"\002$int\002 $type"); - } - $reply .= ". At the moment, ". &IJoin(@array); + push(@array,"\002$int\002 $type"); + } + $reply .= ". At the moment, ". &IJoin(@array); - # Step 3: - ### TODO: what's wrong with the following? - my %new = map { $userstats{$_}{'Count'} => $_ } keys %userstats; - my($count) = (sort { $b <=> $a } keys %new)[0]; - if ($count) { - $reply .= ". \002$new{$count}\002 has said the most with a total of \002$count\002 messages"; + # Step 3: + my %new; + foreach (keys %userstats) { + next unless (exists $userstats{$_}{'Count'}); + if ($userstats{$_}{'Count'} =~ /^\D+$/) { + &WARN("userstats{$_}{Count} is non-digit."); + next; } - &performStrictReply("$reply."); - return $noreply; + $new{$_} = $userstats{$_}{'Count'}; } - # Command statistics. - if ($message =~ /^cmdstats$/i) { - my @array; + # todo: show top 3 with percentages? + my($count) = (sort { $new{$a} <=> $new{$b} } keys %new)[0]; + if ($count) { + $reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages"; + } + &pSReply("$reply."); +} - if (!scalar(keys %cmdstats)) { - &performReply("no-one has run any commands yet"); - return $noreply; - } +# Command statistics. +sub cmdstats { + my @array; - my %countstats; - foreach (keys %cmdstats) { - $countstats{$cmdstats{$_}}{$_} = 1; - } + if (!scalar(keys %cmdstats)) { + &performReply("no-one has run any commands yet"); + return; + } - foreach (sort {$b <=> $a} keys %countstats) { - my $int = $_; - next unless ($int); + my %countstats; + foreach (keys %cmdstats) { + $countstats{ $cmdstats{$_} }{$_} = 1; + } - foreach (keys %{$countstats{$int}}) { - push(@array, "\002$int\002 of $_"); - } - } - &performStrictReply("command usage include ". &IJoin(@array)."."); + foreach (sort {$b <=> $a} keys %countstats) { + my $int = $_; + next unless ($int); - return $noreply; + foreach (keys %{ $countstats{$int} }) { + push(@array, "\002$int\002 of $_"); + } } + &pSReply("command usage include ". &IJoin(@array)."."); +} - # conversion: ascii. - if ($message =~ /^(asci*|chr) (\d+)$/) { - return '' unless (&IsParam("allowConv")); +# Factoid extension info. xk++ +sub factinfo { + my $faqtoid = lc shift(@_); + my $query = ""; - $arg = $2; - if ($arg < 32) { - $arg += 64; - $result = "^".chr($arg); - } else { - $result = chr($2); - } - $result = "NULL" if ($arg == 0); + if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) { + &msg($who,"error: individual factoid info queries not supported as yet."); + &msg($who,"it's possible that the factoid mistakenly begins with '-'."); + return; - &performReply( sprintf("ascii %s is '%s'", $arg, $result) ); - return $noreply; + $query = lc $1; + $faqtoid = lc $3; } - # conversion: ord. - if ($message =~ /^ord (.)$/) { - return '' unless (&IsParam("allowConv")); + &CmdFactInfo($faqtoid, $query); +} - $arg = $1; - if (ord($arg) < 32) { - $arg = chr(ord($arg) + 64); - if ($arg eq chr(64)) { - $arg = 'NULL'; - } else { - $arg = '^'.$arg; - } - } +sub factstats { + my $type = shift(@_); - &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) ); - return $noreply; + &Forker("factoids", sub { + &pSReply( &CmdFactStats($type) ); + } ); +} + +sub karma { + my $target = lc( shift || $who ); + my $karma = &sqlSelect("stats", "counter", + { nick => $target, type => "karma" }) || 0; + + if ($karma != 0) { + &pSReply("$target has karma of $karma"); + } else { + &pSReply("$target has neutral karma"); } +} - # hex. - if ($message =~ /^hex(\s+(.*))?$/i) { - my $arg = $2; +sub ispell { + my $query = shift; - if (!defined $arg) { - &help("hex"); - return $noreply; - } + if (! -x "/usr/bin/ispell") { + &msg($who, "no binary found."); + return; + } - if (length $arg > 80) { - &msg($who, "Too long."); - return $noreply; - } + if (!&validExec($query)) { + &msg($who,"argument appears to be fuzzy."); + return; + } - my $retval; - foreach (split //, $arg) { - $retval .= sprintf(" %X", ord($_)); + my $reply = "I can't find alternate spellings for '$query'"; + + foreach (`/bin/echo '$query' | /usr/bin/ispell -a -S`) { + chop; + last if !length; # end of query. + + if (/^\@/) { # intro line. + next; + } elsif (/^\*/) { # possibly correct. + $reply = "'$query' may be spelled correctly"; + last; + } elsif (/^\&/) { # possible correction(s). + s/^\& (\S+) \d+ \d+: //; + my @array = split(/,? /); + + $reply = "possible spellings for $query: @array"; + last; + } elsif (/^\+/) { + &DEBUG("spell: '+' found => '$_'."); + last; + } elsif (/^# (.*?) 0$/) { + # none found. + last; + } else { + &DEBUG("spell: unknown: '$_'."); } + } + + &pSReply($reply); +} - &performStrictReply("$arg is$retval"); +sub nslookup { + my $query = shift; + &status("DNS Lookup: $query"); + &DNS($query); +} - return $noreply; +sub tell { + my $args = shift; + my ($target, $tell_obj) = ('',''); + my $dont_tell_me = 0; + my $reply; + + ### is this fixed elsewhere? + $args =~ s/\s+/ /g; # fix up spaces. + $args =~ s/^\s+|\s+$//g; # again. + + # this one catches most of them + if ($args =~ /^(\S+) (-?)about (.*)$/i) { + $target = $1; + $tell_obj = $3; + $dont_tell_me = ($2) ? 1 : 0; + + $tell_obj = $who if ($tell_obj =~ /^(me|myself)$/i); + $query = $tell_obj; + } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) { + # i'm sure this could all be nicely collapsed + $target = $1; + $tell_obj = $4; + $query = $tell_obj; + + } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) { + $target = $1; + $qWord = $2; + $tell_obj = $3; + $verb = $4; + $query = "$qWord $verb $tell_obj"; + + } elsif ($args =~ /^(.*?) to (\S+)$/i) { + $target = $3; + $tell_obj = $2; + $query = $tell_obj; } - # crypt. - if ($message =~ /^crypt\s+(\S+)\s*(?:,| )\s*(\S+)/) { - # word salt. - &performStrictReply(crypt($1, $2)); - return $noreply; + # check target type. Deny channel targets. + if ($target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/) { + &msg($who,"No, $who, I won't. (target invalid?)"); + return; } - # Factoid extension info. xk++ - if ($message =~ /^(factinfo)(\s+(.*))?$/i) { - my $query = ""; - my $faqtoid = lc $3; + $target = $talkchannel if ($target =~ /^us$/i); + $target = $who if ($target =~ /^(me|myself)$/i); - if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) { - &msg($who,"error: individual factoid info queries not supported as yet."); - &msg($who,"it's possible that the factoid mistakenly begins with '-'."); - return $noreply; + &status("tell: target = $target, query = $query"); - $query = lc $1; - $faqtoid = lc $3; - } + # "intrusive". +# if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { +# &msg($who, "No, $target is not in any of my chans."); +# return; +# } - &loadMyModule($myModules{'factoids'}); - &CmdFactInfo($faqtoid, $query); - - $cmdstats{'Factoid Info'}++; - return $noreply; + # self. + if ($target =~ /^\Q$ident\E$/i) { + &msg($who, "Isn't that a bit silly?"); + return; } - # Factoid extension statistics. xk++ - if ($message =~ /^(factstats?)(\s+(\S+))?$/i) { - my $type = $3; + my $oldwho = $who; + my $oldmtype = $msgType; + $who = $target; + my $result = &doQuestion($tell_obj); + # ^ returns '0' if nothing was found. + $who = $oldwho; + + # no such factoid. + if (!defined $result || $result =~ /^0?$/) { + $who = $target; + $msgType = "private"; + + # support command redirection. + # recursive cmdHooks aswell :) + my $done = 0; + $done++ if &parseCmdHook("main", $tell_obj); + $done++ if &parseCmdHook("extra", $tell_obj); + $message = $tell_obj; + $done++ unless (&Modules()); + + &VERB("tell: setting old values of who and msgType.",2); + $who = $oldwho; + $msgType = $oldmtype; + + if ($done) { + &msg($who, "told $target about CMD '$tell_obj'"); + } else { + &msg($who, "i dunno what is '$tell_obj'."); + } - if (!defined $type) { - &help("factstats"); - return $noreply; + return; + } + + # success. + &status("tell: <$who> telling $target about $tell_obj."); + if ($who ne $target) { + if ($dont_tell_me) { + &msg($who, "told $target about $tell_obj."); + } else { + &msg($who, "told $target about $tell_obj ($result)"); } - &Forker("factoids", sub { - &performStrictReply( &CmdFactStats($type) ); - } ); - $cmdstats{'Factoid Statistics'}++; - return $noreply; + $reply = "$who wants you to know: $result"; + } else { + $reply = "telling yourself: $result"; } - # help. - if ($message =~ /^help(\s+(.*))?$/i) { - $cmdstats{'Help'}++; + &msg($target, $reply); +} - &help($2); +sub DNS { + my $dns = shift; + my($match, $x, $y, $result); + my $pid; + $dns =~ s/^\s+|\s+$//g; - return $noreply; + if (!defined $dns or $dns =~ /^\s*$/ or $dns =~ / /) { + &help("dns"); + return; } - # karma. - if ($message =~ /^karma(\s+(\S+))?\??$/i) { - return '' unless (&IsParam("karma")); + if ($dns =~ /(\d+\.\d+\.\d+\.\d+)/) { + $match = $1; + &status("DNS query by IP address: $match"); - my $target = lc $2 || lc $who; + $y = pack('C4', split(/\./, $match)); + $x = (gethostbyaddr($y, &AF_INET)); - my $karma = &dbGet("karma", "nick",$target,"karma") || 0; - if ($karma != 0) { - &performStrictReply("$target has karma of $karma"); + if ($x !~ /^\s*$/) { + $result = $match." is ".$x unless ($x =~ /^\s*$/); } else { - &performStrictReply("$target has neutral karma"); + $result = "I can't seem to find that address in DNS"; } - return $noreply; + } else { + + &status("DNS query by name: $dns"); + $x = join('.',unpack('C4',(gethostbyname($dns))[4])); + + if ($x !~ /^\s*$/) { + $result = $dns." is ".$x; + } else { + $result = "I can\'t find that machine name"; + } } - # ignorelist. - if ($message =~ /^ignorelist$/i) { - &status("$who asked for the ignore list"); + &performReply($result); +} - my $time = time(); - my $count = scalar(keys %ignoreList); - my $counter = 0; - my @array; +sub countryStats { + if (exists $cache{countryStats}) { + &msg($who,"countrystats is already running!"); + return; + } - if ($count == 0) { - &performStrictReply("no one in the ignore list!!!"); - return $noreply; - } + if ($chan eq "") { + $chan = $_[0]; + } - foreach (sort keys %ignoreList) { - my $str; + if ($chan eq "") { + &help("countrystats"); + return; + } - if ($ignoreList{$_} != 1) { # temporary ignore. - my $expire = $ignoreList{$_} - $time; - if (defined $expire and $expire < 0) { - &status("ignorelist: deleting $_."); - delete $ignoreList{$_}; - } else { - $str = "$_ (". &Time2String($expire) .")"; - } - } else { - $str = $_; - } + $conn->who($chan); + $cache{countryStats}{chan} = $chan; + $cache{countryStats}{mtype} = $msgType; + $cache{countryStats}{who} = $who; + $cache{on_who_Hack} = 1; +} - push(@array,$str); - $counter++; - if (scalar @array >= 8 or $counter == $count) { - &msg($who, &formListReply(0, "Ignore list ", @array) ); - @array = (); - } +sub do_countrystats { + $chan = $cache{countryStats}{chan}; + $msgType = $cache{countryStats}{mtype}; + $who = $cache{countryStats}{who}; + + my $total = 0; + my %cstats; + foreach (keys %{ $cache{nuhInfo} }) { + my $h = $cache{nuhInfo}{$_}{Host}; + + if ($h =~ /^.*\.(\D+)$/) { # host + $cstats{$1}++; + } else { # ip + $cstats{unresolve}++; } + $total++; + } + my %count; + foreach (keys %cstats) { + $count{ $cstats{$_} }{$_} = 1; + } - return $noreply; + my @list; + foreach (sort {$b <=> $a} keys %count) { + my $str = join(", ", sort keys %{ $count{$_} }); +# push(@list, "$str ($_)"); + my $perc = sprintf("%.01f", 100 * $_ / $total); + $perc =~ s/\.0+$//; + push(@list, "$str ($_, $perc %)"); } - # ispell. - if ($message =~ /^spell(\s+(.*))?$/) { - return '' unless (&IsParam("spell")); - my $query = $2; + # todo: move this into a scheduler like nickometer + $msgType = "private"; + &pSReply( &formListReply(0, "Country Stats ", @list) ); - if ($query eq "") { - &help("spell"); - return $noreply; - } + delete $cache{countryStats}; + delete $cache{on_who_Hack}; +} - if (! -x "/usr/bin/spell") { - &msg($who, "no binary found."); - return $noreply; - } +### +### amalgamated commands. +### - if (!&validExec($query)) { - &msg($who,"argument appears to be fuzzy."); - return $noreply; - } +sub userCommands { + # conversion: ascii. + if ($message =~ /^(asci*|chr) (\d+)$/) { + &DEBUG("ascii/chr called ..."); + return unless (&hasParam("allowConv")); - my $reply = "I can't find alternate spellings for '$query'"; + &DEBUG("ascii/chr called"); - foreach (`echo '$query' | ispell -a -S`) { - chop; - last if !length; # end of query. + $arg = $2; + $result = chr($arg); + $result = "NULL" if ($arg == 0); - if (/^\@/) { # intro line. - next; - } elsif (/^\*/) { # possibly correct. - $reply = "'$query' may be spelled correctly"; - last; - } elsif (/^\&/) { # possible correction(s). - s/^\& (\S+) \d+ \d+: //; - my @array = split(/,? /); - - $reply = "possible spellings for $query: @array"; - last; - } elsif (/^\+/) { - &DEBUG("spell: '+' found => '$_'."); - last; + &performReply( sprintf("ascii %s is '%s'", $arg, $result) ); + + return; + } + + # conversion: ord. + if ($message =~ /^ord(\s+(.*))$/) { + return unless (&hasParam("allowConv")); + + $arg = $2; + + if (!defined $arg or length $arg != 1) { + &help("ord"); + return; + } + + if (ord($arg) < 32) { + $arg = chr(ord($arg) + 64); + if ($arg eq chr(64)) { + $arg = 'NULL'; } else { - &DEBUG("spell: unknown: '$_'."); + $arg = '^'.$arg; } } - &performStrictReply($reply); + &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) ); + return; + } + + # hex. + if ($message =~ /^hex(\s+(.*))?$/i) { + return unless (&hasParam("allowConv")); + my $arg = $2; + + if (!defined $arg) { + &help("hex"); + return; + } - return $noreply; + if (length $arg > 80) { + &msg($who, "Too long."); + return; + } + + my $retval; + foreach (split //, $arg) { + $retval .= sprintf(" %X", ord($_)); + } + + &pSReply("$arg is$retval"); + + return; } - # nslookup. - if ($message =~ /^(dns|nslookup)(\s+(\S+))?$/i) { - return '' unless (&IsParam("allowDNS")); + # crypt. + if ($message =~ /^crypt(\s+(.*))?$/i) { + my @args = split /\s+/, $2; + + if (!scalar @args or scalar @args > 2) { + &help("crypt"); + return; + } + + if (scalar @args == 2) { + if (length $args[0] != 2) { + &msg($who, "invalid format..."); + return; + } - if ($3 eq "") { - &help("nslookup"); - return $noreply; + &pSReply( crypt($args[1], $args[0]) ); + } else { + &pSReply( &mkcrypt($args[0]) ); } - &status("DNS Lookup: $3"); - &loadMyModule($myModules{'allowDNS'}); - &DNS($3); - return $noreply; + return; } # cycle. if ($message =~ /^(cycle)(\s+(\S+))?$/i) { - return $noreply unless (&hasFlag("o")); + return unless (&hasFlag("o")); my $chan = lc $3; if ($chan eq "") { @@ -388,13 +598,13 @@ sub userCommands { &DEBUG("cycle: setting chan to '$chan'."); } else { &help("cycle"); - return $noreply; + return; } } if (&validChan($chan) == 0) { &msg($who,"error: invalid channel \002$chan\002"); - return $noreply; + return; } &msg($chan, "I'm coming back. (courtesy of $who)"); @@ -403,23 +613,34 @@ sub userCommands { &status("Schedule rejoin in 5secs to $chan by $who."); $conn->schedule(5, sub { &joinchan($chan); }); - return $noreply; + return; + } + + # reload. + if ($message =~ /^reload$/i) { + return unless (&hasFlag("n")); + + &status("USER reload $who"); + &pSReply("reloading..."); + my $modules = &reloadAllModules(); + &pSReply("reloaded:$modules"); + return; } # redir. if ($message =~ /^redir(\s+(.*))?/i) { - return $noreply unless (&hasFlag("o")); + return unless (&hasFlag("o")); my $factoid = $2; if (!defined $factoid) { &help("redir"); - return $noreply; + return; } my $val = &getFactInfo($factoid, "factoid_value"); if (!defined $val or $val eq "") { &msg($who, "error: '$factoid' does not exist."); - return $noreply; + return; } &DEBUG("val => '$val'."); my @list = &searchTable("factoids", "factoid_key", @@ -427,54 +648,125 @@ sub userCommands { if (scalar @list == 1) { &msg($who, "hrm... '$factoid' is unique."); - return $noreply; + return; } if (scalar @list > 5) { &msg($who, "A bit too many factoids to be redirected, hey?"); - return $noreply; + return; } my @redir; &status("Redirect '$factoid' (". ($#list) .")..."); for (@list) { + my $x = $_; next if (/^\Q$factoid\E$/i); &status(" Redirecting '$_'."); my $was = &getFactoid($_); + if ($was =~ / see/i) { + &status("warn: not redirecting a redirection."); + next; + } + &DEBUG(" was '$was'."); - push(@redir,$_); - &setFactInfo($_, "factoid_value", " see $factoid"); + push(@redir,$x); + &setFactInfo($x, "factoid_value", " see $factoid"); } &status("Done."); &msg($who, &formListReply(0, "'$factoid' is redirected to by '", @redir)); - return $noreply; + return; } # rot13 it. if ($message =~ /^rot13(\s+(.*))?/i) { my $reply = $2; - if ($reply eq "") { + if (!defined $reply) { &help("rot13"); - return $noreply; + return; } $reply =~ y/A-Za-z/N-ZA-Mn-za-m/; - &performStrictReply($reply); + &pSReply($reply); - return $noreply; + return; + } + + # cpustats. + if ($message =~ /^cpustats$/i) { + if ($^O !~ /linux/) { + &ERROR("cpustats: your OS is not supported yet."); + return; + } + + ### poor method to get info out of file, please fix. + open(STAT,"/proc/$$/stat"); + my $line = ; + chop $line; + my @data = split(/ /, $line); + close STAT; + + # utime(13) + stime(14). + my $cpu_usage = sprintf("%.01f", ($data[13]+$data[14]) / 100 ); + # cutime(15) + cstime (16). + my $cpu_usage2 = sprintf("%.01f", ($data[15]+$data[16]) / 100 ); + my $time = time() - $^T; + my $raw_perc = $cpu_usage*100/$time; + my $raw_perc2 = $cpu_usage2*100/$time; + my $perc; + my $perc2; + my $total; + my $ratio; + + if ($raw_perc > 1) { + $perc = sprintf("%.01f", $raw_perc); + $perc2 = sprintf("%.01f", $raw_perc2); + $total = sprintf("%.01f", $raw_perc+$raw_perc2); + } elsif ($raw_perc > 0.1) { + $perc = sprintf("%.02f", $raw_perc); + $perc2 = sprintf("%.02f", $raw_perc2); + $total = sprintf("%.02f", $raw_perc+$raw_perc2); + } else { # <=0.1 + $perc = sprintf("%.03f", $raw_perc); + $perc2 = sprintf("%.03f", $raw_perc2); + $total = sprintf("%.03f", $raw_perc+$raw_perc2); + } + $ratio = sprintf("%.01f", 100*$perc/($perc+$perc2) ); + + &pSReply("Total CPU usage: \002$cpu_usage\002 s ... ". + "Total used: \002$total\002 % ". + "(parent/child ratio: $ratio %)" + ); + + return; } # ircstats. - if ($message =~ /^ircstats$/i) { + if ($message =~ /^ircstats?$/i) { + $ircstats{'TotalTime'} ||= 0; + $ircstats{'OffTime'} ||= 0; + my $count = $ircstats{'ConnectCount'}; my $format_time = &Time2String(time() - $ircstats{'ConnectTime'}); + my $total_time = time() - $ircstats{'ConnectTime'} + + $ircstats{'TotalTime'}; my $reply; - foreach (keys %ircstats) { - &DEBUG("ircstats: $_ => '$ircstats{$_}'."); + my $connectivity = 100 * ($total_time - $ircstats{'OffTime'}) / + $total_time; + my $p = sprintf("%.03f", $connectivity); + $p =~ s/(\.\d*)0+$/$1/; + if ($p =~ s/\.0$//) { + # this should not happen... but why... + } else { + $p =~ s/\.$// + } + + if ($total_time != (time() - $ircstats{'ConnectTime'}) ) { + my $tt_format = &Time2String($total_time); + &DEBUG("tt_format => $tt_format"); } ### RECONNECT COUNT. @@ -484,149 +776,118 @@ sub userCommands { } else { $reply = "Currently I'm hooked up to $ircstats{'Server'} but only". " for $format_time. ". - "I had to reconnect \002$count\002 times."; + "I had to reconnect \002$count\002 times.". + " Connectivity: $p %"; } ### REASON. my $reason = $ircstats{'DisconnectReason'}; if (defined $reason) { - $reply .= " I was last disconnected for '$reason'."; + $reply .= ". I was last disconnected for '$reason'."; } - &performStrictReply($reply); - - return $noreply; + &pSReply($reply); + + return; } # status. if ($message =~ /^statu?s$/i) { - my $startString = scalar(localtime $^T); + my $startString = scalar(gmtime $^T); my $upString = &Time2String(time() - $^T); - my $count = &countKeys("factoids"); + my $factoids = &countKeys("factoids"); + my $forks = 0; + foreach (keys %forked) { + $forks += scalar keys %{ $forked{$_} }; + } + $forks /= 2; + $count{'Commands'} = 0; + foreach (keys %cmdstats) { + $count{'Commands'} += $cmdstats{$_}; + } - &performStrictReply( + &pSReply( "Since $startString, there have been". " \002$count{'Update'}\002 ". &fixPlural("modification", $count{'Update'}). - " and \002$count{'Question'}\002 ". + ", \002$count{'Question'}\002 ". &fixPlural("question",$count{'Question'}). - " and \002$count{'Dunno'}\002 ". + ", \002$count{'Dunno'}\002 ". &fixPlural("dunno",$count{'Dunno'}). + ", \002$count{'Moron'}\002 ". + &fixPlural("moron",$count{'Moron'}). + " and \002$count{'Commands'}\002 ". + &fixPlural("command",$count{'Commands'}). ". I have been awake for $upString this session, and ". - "currently reference \002$count\002 factoids. ". + "currently reference \002$factoids\002 factoids. ". "I'm using about \002$memusage\002 ". - "kB of memory." + "kB of memory. With \002$forks\002 active ". + &fixPlural("fork",$forks). + "." ); - return $noreply; - } - - # tell. - if ($message =~ /^(tell|explain)(\s+(.*))?$/) { - return '' unless (&IsParam("allowTelling")); - - my $args = $3; - if (!defined $args) { - &help("tell"); - return $noreply; - } - - my ($target, $tell_obj) = ('',''); - my $reply; - ### is this fixed elsewhere? - $args =~ s/\s+/ /g; # fix up spaces. - $args =~ s/^\s+|\s+$//g; # again. - - # this one catches most of them - if ($args =~ /^(\S+) about (.*)$/i) { - $target = lc $1; - $tell_obj = $2; + return; - $tell_obj = $who if ($tell_obj =~ /^(me|myself)$/i); - $query = $tell_obj; - } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) { - # i'm sure this could all be nicely collapsed - $target = lc $1; - $tell_obj = $4; - $query = $tell_obj; + my %hash = &sqlSelectColHash("stats", "nick,counter", + { type => "cmdstats" }, 1); +# ORDER won't be retained in a hash +# " ORDER BY counter DESC", 1); - } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) { - $target = lc $1; - $qWord = $2; - $tell_obj = $3; - $verb = $4; - $query = "$qWord $verb $tell_obj"; - - } elsif ($args =~ /^(.*?) to (\S+)$/i) { - $target = lc $3; - $tell_obj = $2; - $query = $tell_obj; - } - - # check target type. Deny channel targets. - if ($target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/) { - &msg($who,"No, $who, I won't. (target invalid?)"); - return $noreply; +if (0) { + foreach (keys %hash) { + my $i = $_; + foreach (keys %{ $hash{$i} }) { + &DEBUG("cmdstats: $hash{$i}{$_} = $_"); + } } + &DEBUG("end of cmdstats."); +} - $target = $talkchannel if ($target =~ /^us$/i); - $target = $who if ($target =~ /^(me|myself)$/i); - - &status("target: $target query: $query"); - - # "intrusive". - if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { - &msg($who, "No, $target is not in any of my chans."); - return $noreply; - } + return; + } - ### TODO: don't "tell" if sender is not in target's channel. + # wantNick. xk++ + if ($message =~ /^wantNick(\+)?$/i) { + my ($force) = ($1) ? 1 : 0; + $force = 0 unless (&IsFlag("n")); - # self. - if ($target eq $ident) { # lc? - &msg($who, "Isn't that a bit silly?"); - return $noreply; + # cannot trust Net::IRC's nick() + if ($param{'ircNick'} eq $ident) { + &msg($who, "I hope you're right. I'll try anyway."); + &DEBUG("ircNick => $param{'ircNick'}"); + &DEBUG("ident => $ident"); } - # ... - my $result = &doQuestion($tell_obj); - return $noreply if ($result eq $noreply); - - # no such factoid. - if ($result eq "") { - &msg($who, "i dunno what is '$tell_obj'."); - return $noreply; + # fallback check, I guess. needed? + if (! &IsNickInAnyChan( $param{'ircNick'} ) ) { + my $str = "attempting to change nick to $param{'ircNick'}"; + &status($str); + &msg($who, $str); + &nick($param{ 'ircNick' }); + return; } - # success. - &status("tell: <$who> telling $target about $tell_obj."); - if ($who ne $target) { - &msg($who, "told $target about $tell_obj ($result)"); - $reply = "$who wants you to know: $result"; - } else { - $reply = "telling yourself: $result"; - } + # idea from dondelecarlo :) + # todo: use cache{nickserv} + if ($param{'nickServ_pass'}) { + return if ($param{'ircNick'} eq $ident or $force == 0); - &msg($target, $reply); + &status("someone is using our nick; GHOSTing"); + &msg($who, "using GHOST on $param{'ircNick'}."); + &msg("NickServ", "GHOST $param{'ircNick'} $param{'nickServ_pass'}"); - return $noreply; - } + $conn->schedule(5, sub { + &status("going to change nick after GHOST."); + &nick( $param{'ircNick'} ); + } ); - # wantNick. xk++ - if ($message =~ /^wantNick$/i) { - if ($param{'ircNick'} eq $ident) { - &msg($who, "I hope you're right. I'll try anyway."); + return; } - my $str = "attempting to change nick to $param{'ircNick'}"; - &status($str); - &msg($who, $str); - - &nick($param{'ircNick'}); - return $noreply; + return; } - # what else... + return "CONTINUE"; } 1;