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