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