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