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