src/Misc.pl

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