X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FUserExtra.pl;h=3a33008631a70dcfcafd9ca221303016f3e812f7;hb=cb81fea9939f349b36e3b5a0cdc0343a6b781da1;hp=c27605ba57ff2fd6c29d76d605349cd929b17d19;hpb=02dd5778cf86851ed8158551400149133843516a;p=infobot.git diff --git a/src/UserExtra.pl b/src/UserExtra.pl index c27605b..3a33008 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -1,44 +1,15 @@ # # UserExtra.pl: User Commands, Public. # Author: dms -# Version: v0.2b (20000707) -# 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 %forked %ircstats %param + %cache %mask %userstats); -use vars qw($message $arg $qWord $verb $lobotomized); -use vars qw(%channels %chanstats %cmdstats); - -### -### 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 Statistics', 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."); +### hooks get added in CommandHooks.pl. ### ### Start of commands for hooks. @@ -48,23 +19,29 @@ sub chaninfo { my $chan = lc shift(@_); my $mode; - if ($chan eq "") { # all channels. + if ($chan eq '') { # all channels. my $i = keys %channels; - my $reply = "i am on \002$i\002 ".&fixPlural("channel",$i); + my $reply = "I'm on \002$i\002 ".&fixPlural('channel',$i); my $tucount = 0; # total user count. my $uucount = 0; # unique user count. + my %chans; my @array; ### line 1. - foreach (sort keys %channels) { - if (/^\s*$/ or / /) { + foreach (keys %channels) { + if ( /^\s*$/ or / / ) { &status("chanstats: fe channels: chan == NULL."); - &ircCheck(); + #&ircCheck(); next; } - push(@array, "$_ (".scalar(keys %{ $channels{$_}{''} }).")"); + next if (/^_default$/); + + $chans{$_} = scalar(keys %{ $channels{$_}{''} }); + } + foreach $chan (sort {$chans{$b} <=> $chans{$a}} keys %chans) { + push(@array, "$chan/" . $chans{$chan}); } - &pSReply($reply.": ".join(' ', @array)); + &performStrictReply($reply.": ".join(', ', @array)); ### total user count. foreach $chan (keys %channels) { @@ -72,26 +49,23 @@ sub chaninfo { } ### unique user count. - my @nicks; + my %nicks = (); foreach $chan (keys %channels) { - foreach (keys %{ $channels{$chan}{''} }) { - next if (grep /^\Q$_\E$/, @nicks); - $uucount++; - push(@nicks, $_); + my $nick; + foreach $nick (keys %{ $channels{$chan}{''} }) { + $nicks{$nick}++; } } - &DEBUG("nicks => '".scalar(@nicks)."'..."); - if (scalar @nicks != $uucount) { - &DEBUG("nicks != uucount..."); - } + $uucount = scalar(keys %nicks); my $chans = scalar(keys %channels); - &pSReply( - "i've cached \002$tucount\002 ". &fixPlural("user",$tucount). - ", \002$uucount\002 unique ". &fixPlural("user",$uucount). + &performStrictReply( + "i've cached \002$tucount\002 ". &fixPlural('user',$tucount). + ", \002$uucount\002 unique ". &fixPlural('user',$uucount). ", distributed over \002$chans\002 ". - &fixPlural("channel", $chans)."." + &fixPlural('channel', $chans)."." ); + &ircCheck(); return; } @@ -112,7 +86,7 @@ sub chaninfo { push(@array, "\002$int\002 ". &fixPlural($_,$int)); } my $reply = "On \002$chan\002, there ". - &fixPlural("has",scalar(@array)). " been ". + &fixPlural('has',scalar(@array)). " been ". &IJoin(@array); # Step 1b: check channel inconstencies. @@ -136,13 +110,13 @@ sub chaninfo { # Step 2: undef @array; my $type; - foreach ("v","o","") { + 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"); } @@ -160,11 +134,12 @@ sub chaninfo { $new{$_} = $userstats{$_}{'Count'}; } - my($count) = (sort { $a <=> $b } keys %new)[0]; + # TODO: show top 3 with percentages? + my($count) = (sort { $new{$b} <=> $new{$a} } keys %new)[0]; if ($count) { $reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages"; } - &pSReply("$reply."); + &performStrictReply("$reply."); } # Command statistics. @@ -189,13 +164,13 @@ sub cmdstats { push(@array, "\002$int\002 of $_"); } } - &pSReply("command usage include ". &IJoin(@array)."."); + &performStrictReply("command usage include ". &IJoin(@array)."."); } # Factoid extension info. xk++ sub factinfo { my $faqtoid = lc shift(@_); - my $query = ""; + my $query = ''; if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) { &msg($who,"error: individual factoid info queries not supported as yet."); @@ -212,69 +187,23 @@ sub factinfo { sub factstats { my $type = shift(@_); - &Forker("factoids", sub { - &pSReply( &CmdFactStats($type) ); + &Forker('Factoids', sub { + &performStrictReply( &CmdFactStats($type) ); } ); } sub karma { my $target = lc( shift || $who ); - my $karma = &dbGet("stats", "counter", "nick='$target' and type='karma'") || 0; + my $karma = &sqlSelect('stats', 'counter', + { nick => $target, type => 'karma'}) || 0; if ($karma != 0) { - &pSReply("$target has karma of $karma"); + &performStrictReply("$target has karma of $karma"); } else { - &pSReply("$target has neutral karma"); + &performStrictReply("$target has neutral karma"); } } -sub ispell { - my $query = shift; - - if (! -x "/usr/bin/spell") { - &msg($who, "no binary found."); - return; - } - - if (!&validExec($query)) { - &msg($who,"argument appears to be fuzzy."); - return; - } - - 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; - } else { - &DEBUG("spell: unknown: '$_'."); - } - } - - &pSReply($reply); -} - -sub nslookup { - my $query = shift; - &status("DNS Lookup: $query"); - &DNS($query); -} - sub tell { my $args = shift; my ($target, $tell_obj) = ('',''); @@ -287,7 +216,7 @@ sub tell { # this one catches most of them if ($args =~ /^(\S+) (-?)about (.*)$/i) { - $target = lc $1; + $target = $1; $tell_obj = $3; $dont_tell_me = ($2) ? 1 : 0; @@ -295,19 +224,19 @@ sub tell { $query = $tell_obj; } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) { # i'm sure this could all be nicely collapsed - $target = lc $1; + $target = $1; $tell_obj = $4; $query = $tell_obj; } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) { - $target = lc $1; + $target = $1; $qWord = $2; $tell_obj = $3; $verb = $4; $query = "$qWord $verb $tell_obj"; } elsif ($args =~ /^(.*?) to (\S+)$/i) { - $target = lc $3; + $target = $3; $tell_obj = $2; $query = $tell_obj; } @@ -321,16 +250,16 @@ sub tell { $target = $talkchannel if ($target =~ /^us$/i); $target = $who if ($target =~ /^(me|myself)$/i); - &status("tell: target = $target, query = $query"); + &status("tell: target = $target, query = $query"); - # "intrusive". + # 'intrusive'. # if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { # &msg($who, "No, $target is not in any of my chans."); # return; # } # self. - if ($target eq $ident) { # lc? + if ($target =~ /^\Q$ident\E$/i) { &msg($who, "Isn't that a bit silly?"); return; } @@ -343,19 +272,18 @@ sub tell { $who = $oldwho; # no such factoid. - if ($result =~ /^0?$/) { + if (!defined $result || $result =~ /^0?$/) { $who = $target; - $msgType = "private"; + $msgType = 'private'; # support command redirection. # recursive cmdHooks aswell :) my $done = 0; - $done++ if &parseCmdHook("main", $tell_obj); - $done++ if &parseCmdHook("extra", $tell_obj); + $done++ if &parseCmdHook($tell_obj); $message = $tell_obj; $done++ unless (&Modules()); - &VERB("teel: setting old values of who and msgType.",2); + &VERB("tell: setting old values of who and msgType.",2); $who = $oldwho; $msgType = $oldmtype; @@ -385,52 +313,22 @@ sub tell { &msg($target, $reply); } -sub DNS { - my $dns = shift; - my($match, $x, $y, $result); - my $pid; - - if ($dns =~ /(\d+\.\d+\.\d+\.\d+)/) { - &status("DNS query by IP address: $in"); - $match = $1; - $y = pack('C4', split(/\./, $match)); - $x = (gethostbyaddr($y, &AF_INET)); - - if ($x !~ /^\s*$/) { - $result = $match." is ".$x unless ($x =~ /^\s*$/); - } else { - $result = "I can't seem to find that address in DNS"; - } - } else { - &status("DNS query by name: $in"); - $x = join('.',unpack('C4',(gethostbyname($in))[4])); - - if ($x !~ /^\s*$/) { - $result = $in." is ".$x; - } else { - $result = "I can\'t find that machine name"; - } - } - - &performReply($result); -} - sub countryStats { if (exists $cache{countryStats}) { &msg($who,"countrystats is already running!"); return; } - if ($chan eq "") { + if ($chan eq '') { $chan = $_[0]; } - if ($chan eq "") { - &help("countrystats"); + if ($chan eq '') { + &help('countrystats'); return; } - &rawout("WHO $chan"); + $conn->who($chan); $cache{countryStats}{chan} = $chan; $cache{countryStats}{mtype} = $msgType; $cache{countryStats}{who} = $who; @@ -468,9 +366,9 @@ sub do_countrystats { push(@list, "$str ($_, $perc %)"); } - # todo: move this into a scheduler like nickometer - $msgType = "private"; - &pSReply( &formListReply(0, "Country Stats ", @list) ); + # TODO: move this into a scheduler + $msgType = 'private'; + &performStrictReply( &formListReply(0, "Country Stats ", @list) ); delete $cache{countryStats}; delete $cache{on_who_Hack}; @@ -484,13 +382,13 @@ sub userCommands { # conversion: ascii. if ($message =~ /^(asci*|chr) (\d+)$/) { &DEBUG("ascii/chr called ..."); - return unless (&hasParam("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); &DEBUG("ascii/chr called"); $arg = $2; $result = chr($arg); - $result = "NULL" if ($arg == 0); + $result = 'NULL' if ($arg == 0); &performReply( sprintf("ascii %s is '%s'", $arg, $result) ); @@ -499,12 +397,12 @@ sub userCommands { # conversion: ord. if ($message =~ /^ord(\s+(.*))$/) { - return unless (&hasParam("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); $arg = $2; if (!defined $arg or length $arg != 1) { - &help("ord"); + &help('ord'); return; } @@ -517,17 +415,17 @@ sub userCommands { } } - &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) ); + &performReply( sprintf("'%s' is ascii %s", $arg, ord $arg) ); return; } # hex. if ($message =~ /^hex(\s+(.*))?$/i) { - return unless (&hasParam("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); my $arg = $2; if (!defined $arg) { - &help("hex"); + &help('hex'); return; } @@ -541,45 +439,33 @@ sub userCommands { $retval .= sprintf(" %X", ord($_)); } - &pSReply("$arg is$retval"); + &performStrictReply("$arg is$retval"); return; } # 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; - } - - &pSReply( crypt($args[1], $args[0]) ); + if ($message =~ /^crypt\s+(\S*)?\s*(.*)?$/i) { +&status("crypt: $1:$2:$3"); + if ("$2" ne '') { + &performStrictReply(crypt($2, $1)); } else { - &pSReply( &mkcrypt($args[0]) ); + &performStrictReply(&mkcrypt($1)); } - return; } # cycle. if ($message =~ /^(cycle)(\s+(\S+))?$/i) { - return unless (&hasFlag("o")); + return unless (&hasFlag('o')); my $chan = lc $3; - if ($chan eq "") { + if ($chan eq '') { if ($msgType =~ /public/) { $chan = $talkchannel; &DEBUG("cycle: setting chan to '$chan'."); } else { - &help("cycle"); + &help('cycle'); return; } } @@ -591,30 +477,41 @@ sub userCommands { &msg($chan, "I'm coming back. (courtesy of $who)"); &part($chan); -### &ScheduleThis(5, "getNickInUse") if (@_); +### &ScheduleThis(5, 'getNickInUse') if (@_); &status("Schedule rejoin in 5secs to $chan by $who."); $conn->schedule(5, sub { &joinchan($chan); }); return; } + # reload. + if ($message =~ /^reload$/i) { + return unless (&hasFlag('n')); + + &status("USER reload $who"); + &performStrictReply("reloading..."); + my $modules = &reloadAllModules(); + &performStrictReply("reloaded:$modules"); + return; + } + # redir. if ($message =~ /^redir(\s+(.*))?/i) { - return unless (&hasFlag("o")); + return unless (&hasFlag('o')); my $factoid = $2; if (!defined $factoid) { - &help("redir"); + &help('redir'); return; } my $val = &getFactInfo($factoid, "factoid_value"); - if (!defined $val or $val eq "") { + if (!defined $val or $val eq '') { &msg($who, "error: '$factoid' does not exist."); return; } &DEBUG("val => '$val'."); - my @list = &searchTable("factoids", "factoid_key", + my @list = &searchTable('factoids', "factoid_key", "factoid_value", "^$val\$"); if (scalar @list == 1) { @@ -651,16 +548,21 @@ sub userCommands { } # rot13 it. - if ($message =~ /^rot13(\s+(.*))?/i) { - my $reply = $2; + if ($message =~ /^rot([0-9]*)(\s+(.*))?/i) { + my $reply = $3; if (!defined $reply) { - &help("rot13"); + &help('rot13'); return; } + my $num = $1 % 26; + my $upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; + my $lower='abcdefghijklmnopqrstuvwxyz'; + my $to=substr($upper,$num).substr($upper,0,$num).substr($lower,$num).substr($lower,0,$num); + eval "\$reply =~ tr/$upper$lower/$to/;"; - $reply =~ y/A-Za-z/N-ZA-Mn-za-m/; - &pSReply($reply); + #$reply =~ y/A-Za-z/N-ZA-Mn-za-m/; + &performStrictReply($reply); return; } @@ -688,19 +590,28 @@ sub userCommands { 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: $cpu_usage s ... Percentage CPU used: $perc % (+childs: $perc2 %)"); + &performStrictReply("Total CPU usage: \002$cpu_usage\002 s ... ". + "Total used: \002$total\002 % ". + "(parent/child ratio: $ratio %)" + ); return; } @@ -748,62 +659,92 @@ sub userCommands { $reply .= ". I was last disconnected for '$reason'."; } - &pSReply($reply); - + &performStrictReply($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 ($puser,$psystem,$cuser,$csystem) = times; + 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{$_}; } - &pSReply( + &performStrictReply( "Since $startString, there have been". " \002$count{'Update'}\002 ". - &fixPlural("modification", $count{'Update'}). - " and \002$count{'Question'}\002 ". - &fixPlural("question",$count{'Question'}). - " and \002$count{'Dunno'}\002 ". - &fixPlural("dunno",$count{'Dunno'}). - " and \002$count{'Moron'}\002 ". - &fixPlural("moron",$count{'Moron'}). + &fixPlural('modification', $count{'Update'}). + ", \002$count{'Question'}\002 ". + &fixPlural('question',$count{'Question'}). + ", \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'}). + &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). + ". Process time user/system $puser/$psystem child $cuser/$csystem" ); return; } # wantNick. xk++ - if ($message =~ /^wantNick$/i) { - if ($param{'ircNick'} eq $ident) { - &msg($who, "I hope you're right. I'll try anyway."); + # FIXME does not try to get nick 'back', just switches nicks + if ($message =~ /^wantNick\s(.*)?$/i) { + return unless (&hasFlag('o')); + my $wantnick = lc $1; + my $mynick = $conn->nick(); + + if ($mynick eq $wantnick) { + &msg($who, "I hope you're right. I'll try anyway (mynick=$mynick, wantnick=$wantnick)."); } - if (! &IsNickInAnyChan( $param{ircNick} ) ) { - my $str = "attempting to change nick to $param{'ircNick'}"; + # fallback check, I guess. needed? + if (! &IsNickInAnyChan( $wantnick ) ) { + my $str = "attempting to change nick from $mynick to $wantnick"; &status($str); &msg($who, $str); - &nick($param{'ircNick'}); - } else { - &msg($who, "hrm... can't do it"); - &DEBUG("wN: nick is somewhere... should try later."); + &nick($wantnick); + return; + } + + # idea from dondelecarlo :) + # TODO: use cache{nickserv} + if ($param{'nickServ_pass'}) { + my $str = "someone is using nick $wantnick; GHOSTing"; + &status($str); + &msg($who, $str); + &msg('NickServ', "GHOST $wantnick $param{'nickServ_pass'}"); + + $conn->schedule(5, sub { + &status("going to change nick from $mynick to $wantnick after GHOST."); + &nick($wantnick); + } ); + + return; } return; } - return "CONTINUE"; + return 'CONTINUE'; } 1; + +# vim:ts=4:sw=4:expandtab:tw=80