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