X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FMisc.pl;h=3163bb3201690e9970d289305af6e4929806326b;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=cbb31e7ff2ca335ffac2512bb66039a965051bc1;hpb=f2d72df4973205a34bc2bf18ae808759ccbb4986;p=infobot.git

diff --git a/src/Misc.pl b/src/Misc.pl
index cbb31e7..3163bb3 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."/blootbot.help";
     my %help  = ();
 
+    # crude hack for pSReply() 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;
     }
 
@@ -37,7 +44,7 @@ sub help {
     }
     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,$_);
+	    &pSReply($_);
 	}
     } else {
-	&msg($who, "no help on $topic.  Use 'help' without arguments.");
+	&pSReply("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);
     }
 }
 
@@ -156,22 +168,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 +206,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 +249,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,6 +261,16 @@ sub fixString {
 sub fixPlural {
     my ($str,$int) = @_;
 
+    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") {
@@ -256,8 +294,6 @@ sub fixPlural {
     return $str;
 }
 
-
-
 ##########
 ### get commands.
 ###
@@ -265,30 +301,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 = <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;
     }
 }
 
@@ -313,7 +346,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,9 +363,14 @@ 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) {
@@ -381,7 +419,10 @@ 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);
@@ -394,7 +435,7 @@ sub IsHostMatch {
     # 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,29 +447,67 @@ sub IsHostMatch {
 sub isStale {
     my ($file, $age) = @_;
 
+    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))[8] > $age*60*60*24);
-    my $delta = time() - (stat($file))[8];
-    my $hage  = $age*60*60*24;
-    &DEBUG("isStale: not stale! $delta < $hage ($age) ?");
+    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);
@@ -485,82 +564,6 @@ sub validExec {
     }
 }
 
-# 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.
-
-	# 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 (stock) blootbot 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) = @_;
@@ -582,9 +585,10 @@ sub hasProfanity {
 sub hasParam {
     my ($param) = @_;
 
-    if (&IsParam($param)) {
+    if (&IsChanConf($param) or &IsParam($param)) {
 	return 1;
     } else {
+	### TODO: specific reason why it failed.
 	&msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
 	return 0;
     }
@@ -595,19 +599,28 @@ sub Forker {
     my $pid;
 
     &shmFlush();
-    &status("double fork detected; not forking.") if ($$ != $bot_pid);
+    &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
 
     if (&IsParam("forking") and $$ == $bot_pid) {
-	return $noreply unless (&addForked($label));
+	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 == $$ ---");
+	&shmWrite($shm,"SET FORKPID $label $$");
+
+	sleep 1;
     }
 
-    if (!&loadMyModule($myModules{$label})) {
+    ### TODO: use AUTOLOAD
+    ### very lame hack.
+    if ($label !~ /-/ and !&loadMyModule($myModules{$label})) {
 	&DEBUG("Forker: failed?");
-	return;
+	&delForked($label);
     }
 
     if (defined $code) {
@@ -616,17 +629,7 @@ sub Forker {
 	&WARN("Forker: code not defined!");
     }
 
-    if (defined $pid) {		# child.
-	&delForked($label);
-	&status("fork finished for '$label'.");
-	exit 0;
-    }
-}
-
-sub checkPing {
-    &DEBUG("checkPing() called.");
-    $conn->schedule(60, \&checkPing, "this is a test");
-    $conn->sl("PING $server :".time());
+    &delForked($label);
 }
 
 sub closePID {
@@ -635,4 +638,36 @@ sub closePID {
     return 1 if (unlink $file{PID});
     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;