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