src/Misc.pl

   1 #
   2 #   Misc.pl: Miscellaneous stuff.
   3 #    Author: dms
   4 #   Version: 20000124
   5 #      NOTE: Based on code by Kevin Lenzo & Patrick Cole  (c) 1997
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub help {
  11     my $topic = $_[0];
  12     my $file  = $bot_misc_dir."/blootbot.help";
  13     my %help  = ();
  14
  15     if (!open(FILE, $file)) {
  16         &ERROR("FAILED loadHelp ($file): $!");
  17         return;
  18     }
  19
  20     while (defined(my $help = <FILE>)) {
  21         $help =~ s/^[\# ].*//;
  22         chomp $help;
  23         next unless $help;
  24         my ($key, $val) = split(/:/, $help, 2);
  25
  26         $val =~ s/^\s+//;
  27         $val =~ s/^D:/\002   Desc\002:/;
  28         $val =~ s/^E:/\002Example\002:/;
  29         $val =~ s/^N:/\002   NOTE\002:/;
  30         $val =~ s/^U:/\002  Usage\002:/;
  31         $val =~ s/##/$key/;
  32         $val =~ s/__/\037/g;
  33         $val =~ s/==/        /;
  34
  35         $help{$key}  = ""                if (!exists $help{$key});
  36         $help{$key} .= $val."\n";
  37     }
  38     close FILE;
  39
  40     if (!defined $topic) {
  41         &msg($who, $help{'main'});
  42
  43         my $i = 0;
  44         my @array;
  45         my $count = scalar(keys %help);
  46         my $reply;
  47         foreach (sort keys %help) {
  48             push(@array,$_);
  49             $reply = scalar(@array) ." topics: ".
  50                         join("\002,\002 ", @array);
  51             $i++;
  52
  53             if (length $reply > 400 or $count == $i) {
  54                 &msg($who,$reply);
  55                 undef @array;
  56             }
  57         }
  58
  59         return '';
  60     }
  61
  62     $topic = &fixString(lc $topic);
  63
  64     if (exists $help{$topic}) {
  65         foreach (split /\n/, $help{$topic}) {
  66             &msg($who,$_);
  67         }
  68     } else {
  69         &msg($who, "no help on $topic.  Use 'help' without arguments.");
  70     }
  71
  72     return '';
  73 }
  74
  75 sub getPath {
  76     my ($pathnfile) = @_;
  77
  78     ### TODO: gotta hate an if statement.
  79     if ($pathnfile =~ /(.*)\/(.*?)$/) {
  80         return $1;
  81     } else {
  82         return ".";
  83     }
  84 }
  85
  86 sub gettimeofday {
  87     if ($no_syscall) {          # fallback.
  88         return time();
  89     } else {                    # the real thing.
  90         my $time = pack("LL", 0);
  91
  92         syscall(&SYS_gettimeofday, $time, 0);
  93         my @time = unpack("LL",$time);
  94
  95         return sprintf("%d.%d", @time);
  96     }
  97 }
  98
  99 ###
 100 ### FORM Functions.
 101 ###
 102
 103 ###
 104 # Usage; &formListReply($rand, $prefix, @list);
 105 sub formListReply {
 106     my($rand, $prefix, @list) = @_;
 107     my $total   = scalar @list;
 108     my $maxshow = $param{'maxListReplyCount'}  || 10;
 109     my $maxlen  = $param{'maxListReplyLength'} || 400;
 110     my $reply;
 111
 112     # no results.
 113     return $prefix ."returned no results." unless ($total);
 114
 115     # random.
 116     if ($rand) {
 117         my @rand;
 118         foreach (&makeRandom($total)) {
 119             push(@rand, $list[$_]);
 120             last if (scalar @rand == $maxshow);
 121         }
 122         @list = @rand;
 123     } elsif ($total > $maxshow) {
 124         &status("formListReply: truncating list.");
 125
 126         @list = @list[0..$maxshow-1];
 127     }
 128
 129     # form the reply.
 130     while () {
 131         $reply  = $prefix ."(\002". scalar(@list). "\002 shown";
 132         $reply .= "; \002$total\002 total" if ($total != scalar @list);
 133         $reply .= "): ". join(" \002;;\002 ",@list) .".";
 134
 135         last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
 136         last if (scalar(@list) == 1);
 137
 138         pop @list;
 139     }
 140
 141     return $reply;
 142 }
 143
 144 ### Intelligence joining of arrays.
 145 # Usage: &IJoin(@array);
 146 sub IJoin {
 147     if (!scalar @_) {
 148         return "NULL";
 149     } elsif (scalar @_ == 1) {
 150         return $_[0];
 151     } else {
 152         return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]";
 153     }
 154 }
 155
 156 #####
 157 # Usage: &Time2String(seconds);
 158 sub Time2String {
 159     my $time = shift;
 160     my $retval;
 161
 162     return("0s")        if ($time !~ /\d+/ or $time <= 0);
 163
 164     my $s = int($time) % 60;
 165     my $m = int($time / 60) % 60;
 166     my $h = int($time / 3600) % 24;
 167     my $d = int($time / 86400);
 168
 169     $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
 170     $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
 171     $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
 172     $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
 173
 174     return substr($retval, 1);
 175 }
 176
 177 ###
 178 ### FIX Functions.
 179 ###
 180
 181 # Usage: &fixFileList(@files);
 182 sub fixFileList {
 183     my @files = @_;
 184     my %files;
 185
 186     # generate a hash list.
 187     foreach (@files) {
 188         if (/^(.*\/)(.*?)$/) {
 189             $files{$1}{$2} = 1;
 190         }
 191     }
 192     @files = ();        # reuse the array.
 193
 194     # sort the hash list appropriately.
 195     foreach (sort keys %files) {
 196         my $file = $_;
 197         my @keys = sort keys %{$files{$file}};
 198         my $i    = scalar(@keys);
 199
 200         if ($i > 1) {
 201             $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
 202         } else {
 203             $file .= $keys[0];
 204         }
 205
 206         push(@files,$file);
 207     }
 208
 209     return @files;
 210 }
 211
 212 # Usage: &fixString($str);
 213 sub fixString {
 214     my ($str, $level) = @_;
 215     if (!defined $str) {
 216         &WARN("fixString: str == NULL.");
 217         return '';
 218     }
 219
 220     for ($str) {
 221         s/^\s+//;               # remove start whitespaces.
 222         s/\s+$//;               # remove end whitespaces.
 223         s/\s+/ /g;              # remove excessive whitespaces.
 224
 225         next unless (defined $level);
 226         s/[\cA-\c_]//ig         # remove control characters.
 227     }
 228
 229     return $str;
 230 }
 231
 232 # Usage: &fixPlural($str,$int);
 233 sub fixPlural {
 234     my ($str,$int) = @_;
 235
 236     if ($str eq "has") {
 237         $str = "have"   if ($int > 1);
 238     } elsif ($str eq "is") {
 239         $str = "are"    if ($int > 1);
 240     } elsif ($str eq "was") {
 241         $str = "were"   if ($int > 1);
 242     } elsif ($str eq "this") {
 243         $str = "these"  if ($int > 1);
 244     } elsif ($str =~ /y$/) {
 245         if ($int > 1) {
 246             if ($str =~ /ey$/) {
 247                 $str .= "s";    # eg: "money" => "moneys".
 248             } else {
 249                 $str =~ s/y$/ies/;
 250             }
 251         }
 252     } else {
 253         $str .= "s"     if ($int != 1);
 254     }
 255
 256     return $str;
 257 }
 258
 259
 260
 261 ##########
 262 ### get commands.
 263 ###
 264
 265 sub getRandomLineFromFile {
 266     my($file) = @_;
 267
 268     if (! -f $file) {
 269         &WARN("gRLfF: file '$file' does not exist.");
 270         return;
 271     }
 272
 273     if (open(IN,$file)) {
 274         my @lines = <IN>;
 275
 276         if (!scalar @lines) {
 277             &ERROR("GRLF: nothing loaded?");
 278             return;
 279         }
 280
 281         while (my $line = &getRandom(@lines)) {
 282             chop $line;
 283
 284             next if ($line =~ /^\#/);
 285             next if ($line =~ /^\s*$/);
 286
 287             return $line;
 288         }
 289     } else {
 290         &WARN("gRLfF: could not open file '$file'.");
 291         return;
 292     }
 293 }
 294
 295 sub getLineFromFile {
 296     my($file,$lineno) = @_;
 297
 298     if (! -f $file) {
 299         &ERROR("getLineFromFile: file '$file' does not exist.");
 300         return 0;
 301     }
 302
 303     if (open(IN,$file)) {
 304         my @lines = <IN>;
 305         close IN;
 306
 307         if ($lineno > scalar @lines) {
 308             &ERROR("getLineFromFile: lineno exceeds line count from file.");
 309             return 0;
 310         }
 311
 312         my $line = $lines[$lineno-1];
 313         chop $line;
 314         return $line;
 315     } else {
 316         &ERROR("getLineFromFile: could not open file '$file'.");
 317         return 0;
 318     }
 319 }
 320
 321 # Usage: &getRandom(@array);
 322 sub getRandom {
 323     my @array = @_;
 324
 325     srand();
 326     return $array[int(rand(scalar @array))];
 327 }
 328
 329 # Usage: &getRandomInt("30-60");
 330 sub getRandomInt {
 331     my $str = $_[0];
 332
 333     srand();
 334
 335     if ($str =~ /^(\d+)$/) {
 336         my $i = $1;
 337         my $fuzzy = int(rand 5);
 338         if ($i < 10) {
 339             return $i*60;
 340         }
 341         if (rand > 0.5) {
 342             return ($i - $fuzzy)*60;
 343         } else {
 344             return ($i + $fuzzy)*60;
 345         }
 346     } elsif ($str =~ /^(\d+)-(\d+)$/) {
 347         return ($2 - $1)*int(rand $1)*60;
 348     } else {
 349         return $str;    # hope we're safe.
 350     }
 351
 352     &ERROR("getRandomInt: invalid arg '$str'.");
 353     return 1800;
 354 }
 355
 356 ##########
 357 ### Is commands.
 358 ###
 359
 360 sub iseq {
 361     my ($left,$right) = @_;
 362     return 0 unless defined $right;
 363     return 0 unless defined $left;
 364     return 1 if ($left =~ /^\Q$right$/i);
 365 }
 366
 367 sub isne {
 368     my $retval = &iseq(@_);
 369     return 1 unless ($retval);
 370     return 0;
 371 }
 372
 373 # Usage: &IsHostMatch($nuh);
 374 sub IsHostMatch {
 375     my ($thisnuh) = @_;
 376     my (%this,%local);
 377
 378     if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) {
 379         $local{'nick'} = lc $1;
 380         $local{'user'} = lc $2;
 381         $local{'host'} = &makeHostMask(lc $3);
 382     }
 383
 384     if ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
 385         $this{'nick'} = lc $1;
 386         $this{'user'} = lc $2;
 387         $this{'host'} = &makeHostMask(lc $3);
 388     } else {
 389         &WARN("IHM: thisnuh is invalid '$thisnuh'.");
 390         return 1 if ($thisnuh eq "");
 391         return 0;
 392     }
 393
 394     # auth if 1) user and host match 2) user and nick match.
 395     # this may change in the future.
 396
 397     if ($this{'user'} =~ /^\Q$local{'user'}$/i) {
 398         return 2 if ($this{'host'} eq $local{'host'});
 399         return 1 if ($this{'nick'} eq $local{'nick'});
 400     }
 401     return 0;
 402 }
 403
 404 ####
 405 # Usage: &isStale($file, $age);
 406 sub isStale {
 407     my ($file, $age) = @_;
 408
 409     &DEBUG("isStale: $file does not exist") unless ( -f $file);
 410     return 1 unless ( -f $file);
 411     return 1 if (time() - (stat($file))[8] > $age*60*60*24);
 412     my $delta = time() - (stat($file))[8];
 413     my $hage  = $age*60*60*24;
 414     &DEBUG("isStale: not stale! $delta < $hage");
 415     return 0;
 416 }
 417
 418 ##########
 419 ### make commands.
 420 ###
 421
 422 # Usage: &makeHostMask($host);
 423 sub makeHostMask {
 424     my ($host) = @_;
 425
 426     if ($host =~ /^$mask{ip}$/) {
 427         return "$1.$2.$3.*";
 428     }
 429
 430     my @array = split(/\./, $host);
 431     return $host if (scalar @array <= 3);
 432     return "*.".join('.',@{array}[1..$#array]);
 433 }
 434
 435 # Usage: &makeRandom(int);
 436 sub makeRandom {
 437     my ($max) = @_;
 438     my @retval;
 439     my %done;
 440
 441     if ($max =~ /^\D+$/) {
 442         &ERROR("makeRandom: arg ($max) is not integer.");
 443         return 0;
 444     }
 445
 446     if ($max < 1) {
 447         &ERROR("makeRandom: arg ($max) is not positive.");
 448         return 0;
 449     }
 450
 451     srand();
 452     while (scalar keys %done < $max) {
 453         my $rand = int(rand $max);
 454         next if (exists $done{$rand});
 455
 456         push(@retval,$rand);
 457         $done{$rand} = 1;
 458     }
 459
 460     return @retval;
 461 }
 462
 463 sub checkMsgType {
 464     my ($reply) = @_;
 465     return unless (&IsParam("minLengthBeforePrivate"));
 466     return if ($force_public_reply);
 467
 468     if (length $reply > $param{'minLengthBeforePrivate'}) {
 469         &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
 470         $msgType = 'private';
 471     }
 472 }
 473
 474 ###
 475 ### Valid.
 476 ###
 477
 478 # Usage: &validExec($string);
 479 sub validExec {
 480     my ($str) = @_;
 481
 482     if ($str =~ /[\'\"\|]/) {   # invalid.
 483         return 0;
 484     } else {                    # valid.
 485         return 1;
 486     }
 487 }
 488
 489 # Usage: &validFactoid($lhs,$rhs);
 490 sub validFactoid {
 491     my ($lhs,$rhs) = @_;
 492     my $valid = 0;
 493
 494     for (lc $lhs) {
 495         # allow the following only if they have been made on purpose.
 496         if ($rhs ne "" and $rhs !~ /^</) {
 497             / \Q$ident$/i and last;     # someone said i'm something.
 498             /^i('m)? / and last;
 499             /^(it|that|there|what)('s)?(\s+|$)/ and last;
 500             /^you('re)?(\s+|$)/ and last;
 501
 502             /^(where|who|why|when|how)(\s+|$)/ and last;
 503             /^(this|that|these|those|they)(\s+|$)/ and last;
 504             /^(every(one|body)|we) / and last;
 505
 506             /^say / and last;
 507         }
 508
 509         # uncaught commands.
 510         /^add topic / and last;         # topic management.
 511         /( add$| add |^add )/ and last; # borked teach statement.
 512         /^learn / and last;             # teach. damn morons.
 513         /^tell (\S+) about / and last;  # tell.
 514         /\=\~/ and last;                # substituition.
 515         /^\S+ to \S+ \S+/ and last;     # babelfish.
 516
 517         # symbols.
 518         /(\"\*)/ and last;
 519         /, / and last;
 520         /^\'/ and last;
 521
 522         # delimiters.
 523         /\=\>/ and last;                # '=>'.
 524         /\;\;/ and last;                # ';;'.
 525         /\|\|/ and last;                # '||'.
 526
 527         /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
 528         /^[\-\, ]/ and last;
 529         /\\$/ and last;                 # forgot shift for '?'.
 530         /^all / and last;
 531         /^also / and last;
 532         / also$/ and last;
 533         / and$/ and last;
 534         /^because / and last;
 535         /^gives / and last;
 536         /^h(is|er) / and last;
 537         /^if / and last;
 538         / is,/ and last;
 539         / it$/ and last;
 540         / says$/ and last;
 541         /^should / and last;
 542         /^so / and last;
 543         /^supposedly/ and last;
 544         /^to / and last;
 545         /^was / and last;
 546         / which$/ and last;
 547
 548         # nasty bug I introduced _somehow_, probably by fixMySQLBug().
 549         /\\\%/ and last;
 550         /\\\_/ and last;
 551
 552         # weird/special stuff. also old (stock) blootbot bugs.
 553         $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
 554
 555         # duplication.
 556         $rhs =~ /^\Q$lhs /i and last;
 557         last if ($rhs =~ /^is /i and / is$/);
 558
 559         $valid++;
 560     }
 561
 562     return $valid;
 563 }
 564
 565 # Usage: &hasProfanity($string);
 566 sub hasProfanity {
 567     my ($string) = @_;
 568     my $profanity = 1;
 569
 570     for (lc $string) {
 571         /fuck/ and last;
 572         /dick|dildo/ and last;
 573         /shit|turd|crap/ and last;
 574         /pussy|[ck]unt/ and last;
 575         /wh[0o]re|bitch|slut/ and last;
 576
 577         $profanity = 0;
 578     }
 579
 580     return $profanity;
 581 }
 582
 583 sub hasParam {
 584     my ($param) = @_;
 585
 586     if (&IsParam($param)) {
 587         return 1;
 588     } else {
 589         &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
 590         return 0;
 591     }
 592 }
 593
 594 sub Forker {
 595     my ($label, $code) = @_;
 596     my $pid;
 597
 598     &shmFlush();
 599     &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
 600
 601     if (&IsParam("forking") and $$ == $bot_pid) {
 602         return $noreply unless (&addForked($label));
 603         $SIG{CHLD} = 'IGNORE';
 604         $pid = eval { fork() };  # catch non-forking OSes and other errors
 605         return $noreply if $pid;   # parent does nothing
 606         &status("fork starting for '$label', PID == $$.");
 607     }
 608
 609     if (!&loadMyModule($myModules{$label})) {
 610         &DEBUG("Forker: failed?");
 611         return;
 612     }
 613
 614     if (defined $code) {
 615         $code->();                      # weird, hey?
 616     } else {
 617         &WARN("Forker: code not defined!");
 618     }
 619
 620     if (defined $pid) {         # child.
 621         &delForked($label);
 622         &status("fork finished for '$label'.");
 623         exit 0;
 624     }
 625 }
 626
 627 sub checkPing {
 628     &DEBUG("checkPing() called.");
 629     $conn->schedule(60, \&checkPing, "this is a test");
 630     $conn->sl("PING $server :".time());
 631 }
 632
 633 sub closePID {
 634     return 1 unless (exists $file{PID});
 635     return 1 unless ( -f $file{PID});
 636     return 1 if (unlink $file{PID});
 637     return 0 if ( -f $file{PID});
 638 }
 639
 640 1;