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     # no results.
 125     return $prefix ."returned no results." unless ($total);
 126
 127     # random.
 128     if ($rand) {
 129         my @rand;
 130         foreach (&makeRandom($total)) {
 131             push(@rand, $list[$_]);
 132             last if (scalar @rand == $maxshow);
 133         }
 134         @list = @rand;
 135     } elsif ($total > $maxshow) {
 136         &status("formListReply: truncating list.");
 137
 138         @list = @list[0..$maxshow-1];
 139     }
 140
 141     # form the reply.
 142     while () {
 143         $reply  = $prefix ."(\002". scalar(@list). "\002 shown";
 144         $reply .= "; \002$total\002 total" if ($total != scalar @list);
 145         $reply .= "): ". join(" \002;;\002 ",@list) .".";
 146
 147         last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
 148         last if (scalar(@list) == 1);
 149
 150         pop @list;
 151     }
 152
 153     return $reply;
 154 }
 155
 156 ### Intelligence joining of arrays.
 157 # Usage: &IJoin(@array);
 158 sub IJoin {
 159     if (!scalar @_) {
 160         return "NULL";
 161     } elsif (scalar @_ == 1) {
 162         return $_[0];
 163     } else {
 164         return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]";
 165     }
 166 }
 167
 168 #####
 169 # Usage: &Time2String(seconds);
 170 sub Time2String {
 171     my ($time) = @_;
 172     my $prefix = "";
 173     my (@s, @t);
 174
 175     return "NULL" if (!defined $time);
 176     return $time  if ($time !~ /\d+/);
 177
 178     if ($time < 0) {
 179         $time   = - $time;
 180         $prefix = "- ";
 181     }
 182
 183     $t[0] = int($time) % 60;
 184     $t[1] = int($time / 60) % 60;
 185     $t[2] = int($time / 3600) % 24;
 186     $t[3] = int($time / 86400);
 187
 188     push(@s, "$t[3]d") if ($t[3] != 0);
 189     push(@s, "$t[2]h") if ($t[2] != 0);
 190     push(@s, "$t[1]m") if ($t[1] != 0);
 191     push(@s, "$t[0]s") if ($t[0] != 0 or !@s);
 192
 193     my $retval = $prefix.join(' ', @s);
 194     $retval =~ s/(\d+)/\002$1\002/g;
 195     return $retval;
 196 }
 197
 198 ###
 199 ### FIX Functions.
 200 ###
 201
 202 # Usage: &fixFileList(@files);
 203 sub fixFileList {
 204     my @files = @_;
 205     my %files;
 206
 207     # generate a hash list.
 208     foreach (@files) {
 209         next unless /^(.*\/)(.*?)$/;
 210
 211         $files{$1}{$2} = 1;
 212     }
 213     @files = ();        # reuse the array.
 214
 215     # sort the hash list appropriately.
 216     foreach (sort keys %files) {
 217         my $file = $_;
 218         my @keys = sort keys %{ $files{$file} };
 219         my $i    = scalar(@keys);
 220
 221         if (scalar @keys > 3) {
 222             pop @keys while (scalar @keys > 3);
 223             push(@keys, "...");
 224         }
 225
 226         if ($i > 1) {
 227             $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
 228         } else {
 229             $file .= $keys[0];
 230         }
 231
 232         push(@files,$file);
 233     }
 234
 235     return @files;
 236 }
 237
 238 # Usage: &fixString($str);
 239 sub fixString {
 240     my ($str, $level) = @_;
 241     if (!defined $str) {
 242         &WARN("fixString: str == NULL.");
 243         return '';
 244     }
 245
 246     for ($str) {
 247         s/^\s+//;               # remove start whitespaces.
 248         s/\s+$//;               # remove end whitespaces.
 249         s/\s+/ /g;              # remove excessive whitespaces.
 250
 251         next unless (defined $level);
 252         if (s/[\cA-\c_]//ig) {          # remove control characters.
 253             &DEBUG("stripped control chars");
 254         }
 255     }
 256
 257     return $str;
 258 }
 259
 260 # Usage: &fixPlural($str,$int);
 261 sub fixPlural {
 262     my ($str,$int) = @_;
 263
 264     if (!defined $str) {
 265         &WARN("fixPlural: str == NULL.");
 266         return;
 267     }
 268
 269     if (!defined $int or $int =~ /^\D+$/) {
 270         &WARN("fixPlural: int != defined or int");
 271         return $str;
 272     }
 273
 274     if ($str eq "has") {
 275         $str = "have"   if ($int > 1);
 276     } elsif ($str eq "is") {
 277         $str = "are"    if ($int > 1);
 278     } elsif ($str eq "was") {
 279         $str = "were"   if ($int > 1);
 280     } elsif ($str eq "this") {
 281         $str = "these"  if ($int > 1);
 282     } elsif ($str =~ /y$/) {
 283         if ($int > 1) {
 284             if ($str =~ /ey$/) {
 285                 $str .= "s";    # eg: "money" => "moneys".
 286             } else {
 287                 $str =~ s/y$/ies/;
 288             }
 289         }
 290     } else {
 291         $str .= "s"     if ($int != 1);
 292     }
 293
 294     return $str;
 295 }
 296
 297 ##########
 298 ### get commands.
 299 ###
 300
 301 sub getRandomLineFromFile {
 302     my($file) = @_;
 303
 304     if (!open(IN, $file)) {
 305         &WARN("gRLfF: could not open ($file): $!");
 306         return;
 307     }
 308
 309     my @lines = <IN>;
 310     close IN;
 311
 312     if (!scalar @lines) {
 313         &ERROR("GRLF: nothing loaded?");
 314         return;
 315     }
 316
 317     # could we use the filehandler instead and put it through getRandom?
 318     while (my $line = &getRandom(@lines)) {
 319         chop $line;
 320
 321         next if ($line =~ /^\#/);
 322         next if ($line =~ /^\s*$/);
 323
 324         return $line;
 325     }
 326 }
 327
 328 sub getLineFromFile {
 329     my($file,$lineno) = @_;
 330
 331     if (! -f $file) {
 332         &ERROR("getLineFromFile: file '$file' does not exist.");
 333         return 0;
 334     }
 335
 336     if (open(IN,$file)) {
 337         my @lines = <IN>;
 338         close IN;
 339
 340         if ($lineno > scalar @lines) {
 341             &ERROR("getLineFromFile: lineno exceeds line count from file.");
 342             return 0;
 343         }
 344
 345         my $line = $lines[$lineno-1];
 346         chop $line;
 347         return $line;
 348     } else {
 349         &ERROR("gLFF: Could not open file ($file): $!");
 350         return 0;
 351     }
 352 }
 353
 354 # Usage: &getRandom(@array);
 355 sub getRandom {
 356     my @array = @_;
 357
 358     srand();
 359     return $array[int(rand(scalar @array))];
 360 }
 361
 362 # Usage: &getRandomInt("30-60");
 363 sub getRandomInt {
 364     my $str = $_[0];
 365
 366     if (!defined $str) {
 367         &WARN("gRI: str == NULL.");
 368         return;
 369     }
 370
 371     srand();
 372
 373     if ($str =~ /^(\d+(\.\d+)?)$/) {
 374         my $i = $1;
 375         my $fuzzy = int(rand 5);
 376         if ($i < 10) {
 377             return $i*60;
 378         }
 379         if (rand > 0.5) {
 380             return ($i - $fuzzy)*60;
 381         } else {
 382             return ($i + $fuzzy)*60;
 383         }
 384     } elsif ($str =~ /^(\d+)-(\d+)$/) {
 385         return ($2 - $1)*int(rand $1)*60;
 386     } else {
 387         return $str;    # hope we're safe.
 388     }
 389
 390     &ERROR("getRandomInt: invalid arg '$str'.");
 391     return 1800;
 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 ##########
 474 ### make commands.
 475 ###
 476
 477 # Usage: &makeHostMask($host);
 478 sub makeHostMask {
 479     my ($host)  = @_;
 480     my $nu      = "";
 481
 482     if ($host =~ s/^(\S+!\S+\@)//) {
 483         &DEBUG("mHM: detected nick!user\@ for host arg; fixing");
 484         &DEBUG("nu => $nu");
 485         $nu = $1;
 486     }
 487
 488     if ($host =~ /^$mask{ip}$/) {
 489         return $nu."$1.$2.$3.*";
 490     }
 491
 492     my @array = split(/\./, $host);
 493     return $nu.$host if (scalar @array <= 3);
 494     return $nu."*.".join('.',@{array}[1..$#array]);
 495 }
 496
 497 # Usage: &makeRandom(int);
 498 sub makeRandom {
 499     my ($max) = @_;
 500     my @retval;
 501     my %done;
 502
 503     if ($max =~ /^\D+$/) {
 504         &ERROR("makeRandom: arg ($max) is not integer.");
 505         return 0;
 506     }
 507
 508     if ($max < 1) {
 509         &ERROR("makeRandom: arg ($max) is not positive.");
 510         return 0;
 511     }
 512
 513     srand();
 514     while (scalar keys %done < $max) {
 515         my $rand = int(rand $max);
 516         next if (exists $done{$rand});
 517
 518         push(@retval,$rand);
 519         $done{$rand} = 1;
 520     }
 521
 522     return @retval;
 523 }
 524
 525 sub checkMsgType {
 526     my ($reply) = @_;
 527     return unless (&IsParam("minLengthBeforePrivate"));
 528     return if ($force_public_reply);
 529
 530     if (length $reply > $param{'minLengthBeforePrivate'}) {
 531         &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
 532         $msgType = 'private';
 533     }
 534 }
 535
 536 ###
 537 ### Valid.
 538 ###
 539
 540 # Usage: &validExec($string);
 541 sub validExec {
 542     my ($str) = @_;
 543
 544     if ($str =~ /[\'\"\|]/) {   # invalid.
 545         return 0;
 546     } else {                    # valid.
 547         return 1;
 548     }
 549 }
 550
 551 # Usage: &hasProfanity($string);
 552 sub hasProfanity {
 553     my ($string) = @_;
 554     my $profanity = 1;
 555
 556     for (lc $string) {
 557         /fuck/ and last;
 558         /dick|dildo/ and last;
 559         /shit|turd|crap/ and last;
 560         /pussy|[ck]unt/ and last;
 561         /wh[0o]re|bitch|slut/ and last;
 562
 563         $profanity = 0;
 564     }
 565
 566     return $profanity;
 567 }
 568
 569 sub hasParam {
 570     my ($param) = @_;
 571
 572     if (&IsChanConf($param) or &IsParam($param)) {
 573         return 1;
 574     } else {
 575         ### TODO: specific reason why it failed.
 576         &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
 577         return 0;
 578     }
 579 }
 580
 581 sub Forker {
 582     my ($label, $code) = @_;
 583     my $pid;
 584
 585     &shmFlush();
 586     &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
 587
 588     if (&IsParam("forking") and $$ == $bot_pid) {
 589         return unless &addForked($label);
 590
 591         $SIG{CHLD} = 'IGNORE';
 592         $pid = eval { fork() };
 593         return if $pid;         # parent does nothing
 594
 595         select(undef, undef, undef, 0.2);
 596 #       &status("fork starting for '$label', PID == $$.");
 597         &status("--- fork starting for '$label', PID == $$ ---");
 598         &shmWrite($shm,"SET FORKPID $label $$");
 599
 600         sleep 1;
 601     }
 602
 603     ### TODO: use AUTOLOAD
 604     ### very lame hack.
 605     if ($label !~ /-/ and !&loadMyModule($myModules{$label})) {
 606         &DEBUG("Forker: failed?");
 607         &delForked($label);
 608     }
 609
 610     if (defined $code) {
 611         $code->();                      # weird, hey?
 612     } else {
 613         &WARN("Forker: code not defined!");
 614     }
 615
 616     &delForked($label);
 617 }
 618
 619 sub closePID {
 620     return 1 unless (exists $file{PID});
 621     return 1 unless ( -f $file{PID});
 622     return 1 if (unlink $file{PID});
 623     return 0 if ( -f $file{PID});
 624 }
 625
 626 sub mkcrypt {
 627     my($str) = @_;
 628     my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
 629
 630     return crypt($str, $salt);
 631 }
 632
 633 sub closeStats {
 634     return unless (&getChanConfList("ircTextCounters"));
 635
 636     foreach (keys %cmdstats) {
 637         my $type        = $_;
 638         my $i   = &dbGet("stats", "counter", "nick=".&dbQuote($type).
 639                         " AND type='cmdstats'");
 640         my $z   = 0;
 641         $z++ unless ($i);
 642
 643         $i      += $cmdstats{$type};
 644
 645         my %hash = (
 646                 nick => $type,
 647                 type => "cmdstats",
 648                 counter => $i
 649         );
 650         $hash{time} = time() if ($z);
 651
 652         &dbReplace("stats", "nick", %hash);
 653     }
 654 }
 655
 656 1;