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"); &getRandomInt(5);
 371 # Desc : Returns a randomn integer between "X-Y" or 1 and the value passed
 372 sub getRandomInt {
 373         my $str = shift;
 374
 375         if ( !defined $str ) {
 376                 &WARN("getRandomInt: str == NULL.");
 377                 return undef;
 378         }
 379
 380         if ( $str =~ /^(\d+(\.\d+)?)$/ ) {
 381                 return int( rand $str ) + 1;
 382         } elsif ( $str =~ /^(\d+)-(\d+)$/ ) {
 383                 return $1 if $1 == $2;
 384                 my $min = $1 < $2 ? $1 : $2;    # Swap is backwords
 385                 my $max = $2 > $1 ? $2 : $1;
 386                 return int( rand( $max - $min + 1 ) ) + $min;
 387         } else {
 388
 389                 # &ERROR("getRandomInt: invalid arg '$str'.");
 390                 return undef;
 391         }
 392 }
 393
 394 ##########
 395 ### Is commands.
 396 ###
 397
 398 sub iseq {
 399     my ($left,$right) = @_;
 400     return 0 unless defined $right;
 401     return 0 unless defined $left;
 402     return 1 if ($left =~ /^\Q$right$/i);
 403 }
 404
 405 sub isne {
 406     my $retval = &iseq(@_);
 407     return 1 unless ($retval);
 408     return 0;
 409 }
 410
 411 # Usage: &IsHostMatch($nuh);
 412 sub IsHostMatch {
 413     my ($thisnuh) = @_;
 414     my (%this,%local);
 415
 416     if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) {
 417         $local{'nick'} = lc $1;
 418         $local{'user'} = lc $2;
 419         $local{'host'} = &makeHostMask(lc $3);
 420     }
 421
 422     if (!defined $thisnuh) {
 423         &WARN("IHM: thisnuh == NULL.");
 424         return 0;
 425     } elsif ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
 426         $this{'nick'} = lc $1;
 427         $this{'user'} = lc $2;
 428         $this{'host'} = &makeHostMask(lc $3);
 429     } else {
 430         &WARN("IHM: thisnuh is invalid '$thisnuh'.");
 431         return 1 if ($thisnuh eq '');
 432         return 0;
 433     }
 434
 435     # auth if 1) user and host match 2) user and nick match.
 436     # this may change in the future.
 437
 438     if ($this{'user'} =~ /^\Q$local{'user'}\E$/i) {
 439         return 2 if ($this{'host'} eq $local{'host'});
 440         return 1 if ($this{'nick'} eq $local{'nick'});
 441     }
 442     return 0;
 443 }
 444
 445 ####
 446 # Usage: &isStale($file, $age);
 447 sub isStale {
 448     my ($file, $age) = @_;
 449
 450     if (!defined $age) {
 451         &WARN("isStale: age == NULL.");
 452         return 1;
 453     }
 454
 455     if (!defined $file) {
 456         &WARN("isStale: file == NULL.");
 457         return 1;
 458     }
 459
 460     &DEBUG("!exist $file") if (! -f $file);
 461
 462     return 1 unless ( -f $file);
 463     if ($file =~ /idx/) {
 464         my $age2 = time() - (stat($file))[9];
 465         &VERB("stale: $age2. (". &Time2String($age2) .")",2);
 466     }
 467     $age *= 60*60*24 if ($age >= 0 and $age < 30);
 468
 469     return 1 if (time() - (stat($file))[9] > $age);
 470     return 0;
 471 }
 472
 473 sub isFileUpdated {
 474     my ($file, $time) = @_;
 475
 476     if (! -f $file) {
 477         return 1;
 478     }
 479
 480     my $time_file = (stat $file)[9];
 481
 482     if ($time <= $time_file) {
 483         return 0;
 484     } else {
 485         return 1;
 486     }
 487 }
 488
 489 ##########
 490 ### make commands.
 491 ###
 492
 493 # Usage: &makeHostMask($host);
 494 sub makeHostMask {
 495     my ($host)  = @_;
 496     my $nu      = '';
 497
 498     if ($host =~ s/^(\S+!\S+\@)//) {
 499         &DEBUG("mHM: detected nick!user\@ for host arg; fixing");
 500         &DEBUG("nu => $nu");
 501         $nu = $1;
 502     }
 503
 504     if ($host =~ /^$mask{ip}$/) {
 505         return $nu."$1.$2.$3.*";
 506     }
 507
 508     my @array = split(/\./, $host);
 509     return $nu.$host if (scalar @array <= 3);
 510     return $nu."*.".join('.',@{array}[1..$#array]);
 511 }
 512
 513 # Usage: &makeRandom(int);
 514 sub makeRandom {
 515     my ($max) = @_;
 516     my @retval;
 517     my %done;
 518
 519     if ($max =~ /^\D+$/) {
 520         &ERROR("makeRandom: arg ($max) is not integer.");
 521         return 0;
 522     }
 523
 524     if ($max < 1) {
 525         &ERROR("makeRandom: arg ($max) is not positive.");
 526         return 0;
 527     }
 528
 529     srand();
 530     while (scalar keys %done < $max) {
 531         my $rand = int(rand $max);
 532         next if (exists $done{$rand});
 533
 534         push(@retval,$rand);
 535         $done{$rand} = 1;
 536     }
 537
 538     return @retval;
 539 }
 540
 541 sub checkMsgType {
 542     my ($reply) = @_;
 543     return unless (&IsParam('minLengthBeforePrivate'));
 544     return if ($force_public_reply);
 545
 546     if (length $reply > $param{'minLengthBeforePrivate'}) {
 547         &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
 548         $msgType = 'private';
 549     }
 550 }
 551
 552 ###
 553 ### Valid.
 554 ###
 555
 556 # Usage: &validExec($string);
 557 sub validExec {
 558     my ($str) = @_;
 559
 560     if ($str =~ /[\`\'\"\|]/) { # invalid.
 561         return 0;
 562     } else {                    # valid.
 563         return 1;
 564     }
 565 }
 566
 567 # Usage: &hasProfanity($string);
 568 sub hasProfanity {
 569     my ($string) = @_;
 570     my $profanity = 1;
 571
 572     for (lc $string) {
 573         /fuck/ and last;
 574         /dick|dildo/ and last;
 575         /shit/ and last;
 576         /pussy|[ck]unt/ and last;
 577         /wh[0o]re|bitch|slut/ and last;
 578
 579         $profanity = 0;
 580     }
 581
 582     return $profanity;
 583 }
 584
 585 sub IsChanConfOrWarn {
 586     my ($param) = @_;
 587
 588     if (&IsChanConf($param) > 0) {
 589         return 1;
 590     } else {
 591         ### TODO: specific reason why it failed.
 592         &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
 593         return 0;
 594     }
 595 }
 596
 597 sub Forker {
 598     my ($label, $code) = @_;
 599     my $pid;
 600
 601     &shmFlush();
 602     &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
 603
 604     if (&IsParam('forking') and $$ == $bot_pid) {
 605         return unless &addForked($label);
 606
 607         $SIG{CHLD} = 'IGNORE';
 608         $pid = eval { fork() };
 609         return if $pid;         # parent does nothing
 610
 611         select(undef, undef, undef, 0.2);
 612 #       &status("fork starting for '$label', PID == $$.");
 613         &status("--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---");
 614         &shmWrite($shm,"SET FORKPID $label $$");
 615
 616         sleep 1;
 617     }
 618
 619     ### TODO: use AUTOLOAD
 620     ### very lame hack.
 621     if ($label !~ /-/ and !&loadMyModule($label)) {
 622         &DEBUG("Forker: failed?");
 623         &delForked($label);
 624     }
 625
 626     if (defined $code) {
 627         $code->();                      # weird, hey?
 628     } else {
 629         &WARN("Forker: code not defined!");
 630     }
 631
 632     &delForked($label);
 633 }
 634
 635 sub closePID {
 636     return 1 unless (exists $file{PID});
 637     return 1 unless ( -f $file{PID});
 638     return 1 if (unlink $file{PID});
 639     return 0 if ( -f $file{PID});
 640 }
 641
 642 sub mkcrypt {
 643     my($str) = @_;
 644     my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
 645
 646     return crypt($str, $salt);
 647 }
 648
 649 sub closeStats {
 650     return unless (&getChanConfList('ircTextCounters'));
 651
 652     foreach (keys %cmdstats) {
 653         my $type        = $_;
 654         my $i   = &sqlSelect('stats', 'counter', {
 655                 nick    => $type,
 656                 type    => 'cmdstats',
 657         } );
 658         my $z   = 0;
 659         $z++ unless ($i);
 660
 661         $i      += $cmdstats{$type};
 662
 663
 664         &sqlSet('stats', {'nick' => $type}, {
 665             type        => 'cmdstats',
 666             'time'      => time(),
 667             counter     => $i,
 668         } );
 669     }
 670 }
 671
 672 1;
 673
 674 # vim:ts=4:sw=4:expandtab:tw=80