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