X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FUserExtra.pl;h=12ec9c324a2f6729c5381cf2341b602f9da802c5;hb=f3618054e8879cfcc83a1e0c1d3aceb83a092ed7;hp=9923a092115a3aa652ae4c7d241a1d12bef254fb;hpb=c6ea16a8cf7e3bc0e1ef68d6f795520e6db4aebe;p=infobot.git

diff --git a/src/UserExtra.pl b/src/UserExtra.pl
index 9923a09..12ec9c3 100644
--- a/src/UserExtra.pl
+++ b/src/UserExtra.pl
@@ -1,42 +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 %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', ) );
-#	Module => 'news', Identifier => 'news') );
-
-&status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks.");
+### hooks get added in CommandHooks.pl.
 
 ###
 ### Start of commands for hooks.
@@ -48,21 +21,24 @@ sub chaninfo {
 
     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 @array;
 
 	### line 1.
 	foreach (sort keys %channels) {
-	    if (/^\s*$/ or / /) {
+	    if ( /^\s*$/ or / / ) {
 		&status("chanstats: fe channels: chan == NULL.");
-		&ircCheck();
+		#&ircCheck();
 		next;
 	    }
-	    push(@array, "$_ (".scalar(keys %{ $channels{$_}{''} }).")");
+	    next if (/^_default$/);
+
+	    my $str = sprintf("%s/%d", $_, scalar(keys %{ $channels{$_}{''} }));
+	    push(@array, $str);
 	}
-	&pSReply($reply.": ".join(' ', @array));
+	&performStrictReply($reply.": ".join(', ', @array));
 
 	### total user count.
 	foreach $chan (keys %channels) {
@@ -70,26 +46,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(
+	&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)."."
 	);
+	&ircCheck();
 
 	return;
     }
@@ -147,13 +120,23 @@ sub chaninfo {
     $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];
+    my %new;
+    foreach (keys %userstats) {
+	next unless (exists $userstats{$_}{'Count'});
+	if ($userstats{$_}{'Count'} =~ /^\D+$/) {
+	    &WARN("userstats{$_}{Count} is non-digit.");
+	    next;
+	}
+
+	$new{$_} = $userstats{$_}{'Count'};
+    }
+
+    # TODO: show top 3 with percentages?
+    my($count) = (sort { $new{$b} <=> $new{$a} } keys %new)[0];
     if ($count) {
-	$reply .= ".  \002$new{$count}\002 has said the most with a total of \002$count\002 messages";
+	$reply .= ".  \002$count\002 has said the most with a total of \002$new{$count}\002 messages";
     }
-    &pSReply("$reply.");
+    &performStrictReply("$reply.");
 }
 
 # Command statistics.
@@ -178,7 +161,7 @@ sub cmdstats {
 	    push(@array, "\002$int\002 of $_");
 	}
     }
-    &pSReply("command usage include ". &IJoin(@array).".");
+    &performStrictReply("command usage include ". &IJoin(@array).".");
 }
 
 # Factoid extension info. xk++
@@ -201,67 +184,21 @@ 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("karma", "nick",$target,"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");
-    }
-}
-
-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;
+	&performStrictReply("$target has neutral karma");
     }
-
-    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 {
@@ -276,7 +213,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;
 
@@ -284,19 +221,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;
     }
@@ -310,18 +247,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".
-    if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
-	&msg($who, "No, $target is not in any of my chans.");
-	return;
-    }
-
-    ### TODO: don't "tell" if sender is not in target's channel.
+#    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;
     }
@@ -334,19 +269,18 @@ sub tell {
     $who		= $oldwho;
 
     # no such factoid.
-    if ($result =~ /^0?$/) {
+    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);
+	$done++ if &parseCmdHook($tell_obj);
 	$message	= $tell_obj;
 	$done++ unless (&Modules());
 
-	&DEBUG("setting old values of who and msgType.");
+	&VERB("tell: setting old values of who and msgType.",2);
 	$who		= $oldwho;
 	$msgType	= $oldmtype;
 
@@ -376,36 +310,66 @@ sub tell {
     &msg($target, $reply);
 }
 
-sub DNS {
-    my $dns = shift;
-    my($match, $x, $y, $result);
-    my $pid;
+sub countryStats {
+    if (exists $cache{countryStats}) {
+	&msg($who,"countrystats is already running!");
+	return;
+    }
 
-    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 ($chan eq "") {
+	$chan = $_[0];
+    }
 
-	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 ($chan eq "") {
+	&help("countrystats");
+	return;
+    }
 
-	if ($x !~ /^\s*$/) {
-	    $result = $in." is ".$x;
-	} else {
-	    $result = "I can\'t find that machine name";
+    $conn->who($chan);
+    $cache{countryStats}{chan}	= $chan;
+    $cache{countryStats}{mtype}	= $msgType;
+    $cache{countryStats}{who}	= $who;
+    $cache{on_who_Hack}		= 1;
+}
+
+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;
     }
 
-    &performReply($result);
-}
+    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 %)");
+    }
 
+    # TODO: move this into a scheduler
+    $msgType	= "private";
+    &performStrictReply( &formListReply(0, "Country Stats ", @list) );
+
+    delete $cache{countryStats};
+    delete $cache{on_who_Hack};
+}
 
 ###
 ### amalgamated commands.
@@ -414,7 +378,10 @@ sub DNS {
 sub userCommands {
     # conversion: ascii.
     if ($message =~ /^(asci*|chr) (\d+)$/) {
-	return unless (&IsParam("allowConv"));
+	&DEBUG("ascii/chr called ...");
+	return unless (&IsChanConfOrWarn("allowConv"));
+
+	&DEBUG("ascii/chr called");
 
 	$arg	= $2;
 	$result	= chr($arg);
@@ -426,10 +393,16 @@ sub userCommands {
     }
 
     # conversion: ord.
-    if ($message =~ /^ord (.)$/) {
-	return unless (&IsParam("allowConv"));
+    if ($message =~ /^ord(\s+(.*))$/) {
+	return unless (&IsChanConfOrWarn("allowConv"));
+
+	$arg = $2;
+
+	if (!defined $arg or length $arg != 1) {
+	    &help("ord");
+	    return;
+	}
 
-	$arg = $1;
 	if (ord($arg) < 32) {
 	    $arg = chr(ord($arg) + 64);
 	    if ($arg eq chr(64)) {
@@ -439,13 +412,13 @@ 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 (&IsParam("allowConv"));
+	return unless (&IsChanConfOrWarn("allowConv"));
 	my $arg = $2;
 
 	if (!defined $arg) {
@@ -463,7 +436,7 @@ sub userCommands {
 	    $retval .= sprintf(" %X", ord($_));
 	}
 
-	&pSReply("$arg is$retval");
+	&performStrictReply("$arg is$retval");
 
 	return;
     }
@@ -478,14 +451,15 @@ sub userCommands {
 	}
 
 	if (scalar @args == 2) {
-	    if (length $args[0] != 2) {
-		&msg($who, "invalid format...");
-		return;
-	    }
+# disable cause $1$ will use md5
+#	    if (length $args[0] != 2) {
+#		&msg($who, "invalid format...");
+#		return;
+#	    }
 
-	    &pSReply( crypt($args[1], $args[0]) );
+	    &performStrictReply( crypt($args[1], $args[0]) );
 	} else {
-	    &pSReply( &mkcrypt($args[0]) );
+	    &performStrictReply( &mkcrypt($args[0]) );
 	}
 
 	return;
@@ -520,6 +494,17 @@ sub userCommands {
 	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"));
@@ -573,16 +558,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");
 	    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;
     }
@@ -603,21 +593,35 @@ sub userCommands {
 
 	# 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: $cpu_usage s ... Percentage CPU used: $perc %");
-	&DEBUG("15 => $data[15] (cutime)");
-	&DEBUG("16 => $data[16] (cstime)");
+	&performStrictReply("Total CPU usage: \002$cpu_usage\002 s ... ".
+		"Total used: \002$total\002 % ".
+		"(parent/child ratio: $ratio %)"
+	);
 
 	return;
     }
@@ -665,50 +669,84 @@ 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 ".
+	  ", \002$count{'Question'}\002 ".
 		&fixPlural("question",$count{'Question'}).
-	  " and \002$count{'Dunno'}\002 ".
+	  ", \002$count{'Dunno'}\002 ".
 		&fixPlural("dunno",$count{'Dunno'}).
-	  " and \002$count{'Moron'}\002 ".
+	  ", \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).
+	  ". 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;