src/Factoids/Core.pl

   1 #
   2 #   Misc.pl: Miscellaneous stuff.
   3 #    Author: dms
   4 #   Version: v0.1 (20010906)
   5 #   Created: 20010906
   6 #
   7
   8 # use strict;   # TODO
   9
  10 use vars qw(%param %cache %lang %cmdstats %bots);
  11 use vars qw($message $who $addressed $chan $h $nuh $ident $msgType
  12   $correction_plausable);
  13
  14 # Usage: &validFactoid($lhs,$rhs);
  15 sub validFactoid {
  16     my ( $lhs, $rhs ) = @_;
  17     my $valid = 0;
  18
  19     for ( lc $lhs ) {
  20
  21         # allow the following only if they have been made on purpose.
  22         if ( $rhs ne '' and $rhs !~ /^</ ) {
  23             / \Q$ident\E$/i and last;    # someone said i'm something.
  24             /^i('m)? /    and last;
  25             /^(it|that|there|what)('s)?(\s+|$)/ and last;
  26             /^you('re)?(\s+|$)/                 and last;
  27
  28             /^(where|who|why|when|how)(\s+|$)/     and last;
  29             /^(this|that|these|those|they)(\s+|$)/ and last;
  30             /^(every(one|body)|we) /               and last;
  31
  32             /^say / and last;
  33         }
  34
  35         # uncaught commands.
  36         /^add topic /         and last;    # topic management.
  37         /( add$| add |^add )/ and last;    # borked teach statement.
  38         /^learn /             and last;    # teach. damn morons.
  39         /^tell (\S+) about /  and last;    # tell.
  40         /\=\~/                and last;    # substituition.
  41
  42         /^\=/               and last;      # botnick = heh is.
  43         /wants you to know/ and last;
  44
  45         # symbols.
  46         /(\"\*)/ and last;
  47         /, /     and last;
  48         ( /^'/ and /'$/ ) and last;
  49         ( /^"/ and /"$/ ) and last;
  50
  51         # delimiters.
  52         /\=\>/ and last;                   # '=>'.
  53         /\;\;/ and last;                   # ';;'.
  54         /\|\|/ and last;                   # '||'.
  55
  56         /^\Q$ident\E[\'\,\: ]/ and last;   # dupe addressed.
  57         /^[\-\, ]/             and last;
  58         /\\$/                  and last;   # forgot shift for '?'.
  59         /^all /                and last;
  60         /^also /               and last;
  61         / also$/               and last;
  62         / and$/                and last;
  63         /^because /            and last;
  64         /^but /                and last;
  65         /^gives /              and last;
  66         /^h(is|er) /           and last;
  67         /^if /                 and last;
  68         / is,/                 and last;
  69         / it$/                 and last;
  70         /^or /                 and last;
  71         / says$/               and last;
  72         /^should /             and last;
  73         /^so /                 and last;
  74         /^supposedly/          and last;
  75         /^to /                 and last;
  76         /^was /                and last;
  77         / which$/              and last;
  78
  79         # nasty bug I introduced _somehow_, probably by fixMySQLBug().
  80         /\\\%/ and last;
  81         /\\\_/ and last;
  82
  83         # weird/special stuff. also old infobot bugs.
  84         $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last;    # ownership.
  85
  86         # duplication.
  87         $rhs =~ /^\Q$lhs\E /i and last;
  88         last if ( $rhs =~ /^is /i and / is$/ );
  89
  90         $valid++;
  91     }
  92
  93     return $valid;
  94 }
  95
  96 sub FactoidStuff {
  97
  98     # inter-infobot.
  99     if ( $msgType =~ /private/ and $message =~ s/^:INFOBOT:// ) {
 100         ### identification.
 101         &status("infobot <$nuh> identified") unless $bots{$nuh};
 102         $bots{$nuh} = $who;
 103
 104         ### communication.
 105
 106         # query.
 107         if ( $message =~ /^QUERY (<.*?>) (.*)/ ) {    # query.
 108             my ( $target, $item ) = ( $1, $2 );
 109             $item =~ s/[.\?]$//;
 110
 111             &status(":INFOBOT:QUERY $who: $message");
 112
 113             if ( $_ = &getFactoid($item) ) {
 114                 &msg( $who, ":INFOBOT:REPLY $target $item =is=> $_" );
 115             }
 116
 117             return 'INFOBOT QUERY';
 118         }
 119         elsif ( $message =~ /^REPLY <(.*?)> (.*)/ ) {    # reply.
 120             my ( $target, $item ) = ( $1, $2 );
 121
 122             &status(":INFOBOT:REPLY $who: $message");
 123
 124             my ( $lhs, $mhs, $rhs ) = $item =~ /^(.*?) =(.*?)=> (.*)/;
 125
 126             if (   $param{'acceptUrl'} !~ /REQUIRE/
 127                 or $rhs =~ /(http|ftp|mailto|telnet|file):/ )
 128             {
 129                 &msg( $target, "$who knew: $lhs $mhs $rhs" );
 130
 131                 # 'are' hack :)
 132                 $rhs = "<REPLY> are" if ( $mhs eq 'are' );
 133                 &setFactInfo( $lhs, 'factoid_value', $rhs );
 134             }
 135
 136             return 'INFOBOT REPLY';
 137         }
 138         else {
 139             &ERROR(":INFOBOT:UNKNOWN $who: $message");
 140             return 'INFOBOT UNKNOWN';
 141         }
 142     }
 143
 144     # factoid forget.
 145     if ( $message =~ s/^forget\s+//i ) {
 146         return 'forget: no addr' unless ($addressed);
 147
 148         my $faqtoid = $message;
 149         if ( $faqtoid eq '' ) {
 150             &help('forget');
 151             return;
 152         }
 153
 154         $faqtoid =~ tr/A-Z/a-z/;
 155         my $result = &getFactoid($faqtoid);
 156
 157         # if it doesn't exist, well... it doesn't!
 158         if ( !defined $result ) {
 159             &performReply("i didn't have anything called '$faqtoid' to forget");
 160             return;
 161         }
 162
 163         # TODO: squeeze 3 getFactInfo calls into one?
 164         my $author = &getFactInfo( $faqtoid, 'created_by' );
 165         my $count = &getFactInfo( $faqtoid, 'requested_count' ) || 0;
 166
 167         # don't delete if requested $limit times
 168         my $limit =
 169           &getChanConfDefault( 'factoidPreventForgetLimit', 100, $chan );
 170
 171      # don't delete if older than $limitage seconds (modified by requests below)
 172         my $limitage = &getChanConfDefault( 'factoidPreventForgetLimitTime',
 173             7 * 24 * 60 * 60, $chan );
 174         my $t = &getFactInfo( $faqtoid, 'created_time' ) || 0;
 175         my $age = time() - $t;
 176
 177         # lets scale limitage from 1 (nearly 0) to $limit (full time).
 178         $limitage = $limitage * ( $count + 1 ) / $limit if ( $count < $limit );
 179
 180         # isauthor and isop.
 181         my $isau = ( defined $author and &IsHostMatch($author) == 2 ) ? 1 : 0;
 182         my $isop = ( &IsFlag('o') eq 'o' ) ? 1 : 0;
 183
 184         if ( IsFlag('r') ne 'r' && !$isop ) {
 185             &msg( $who, "you don't have access to remove factoids" );
 186             return;
 187         }
 188
 189         return 'locked factoid' if ( &IsLocked($faqtoid) == 1 );
 190
 191         ###
 192         ### lets go do some checking.
 193         ###
 194
 195         # factoidPreventForgetLimitTime:
 196         if ( !( $isop or $isau ) and $age / ( 60 * 60 * 24 ) > $limitage ) {
 197             &msg( $who,
 198                     "cannot remove factoid '$faqtoid', too old. ("
 199                   . $age / ( 60 * 60 * 24 )
 200                   . ">$limitage) use 'no,' instead" );
 201             return;
 202         }
 203
 204         # factoidPreventForgetLimit:
 205         if ( !( $isop or $isau ) and $limit and $count > $limit ) {
 206             &msg( $who,
 207 "will not delete '$faqtoid', count > limit ($count > $limit) use 'no, ' instead."
 208             );
 209             return;
 210         }
 211
 212         # this may eat some memory.
 213         # prevent deletion if other factoids redirect to it.
 214         # TODO: use hash instead of array.
 215         my @list;
 216         if ( &getChanConf('factoidPreventForgetRedirect') ) {
 217             &status("Factoids/Core: forget: checking for redirect factoids");
 218             @list =
 219               &searchTable( 'factoids', 'factoid_key', 'factoid_value',
 220                 "^<REPLY> see " );
 221         }
 222
 223         my $match = 0;
 224         for (@list) {
 225             my $f     = $_;
 226             my $v     = &getFactInfo( $f, 'factoid_value' );
 227             my $fsafe = quotemeta($faqtoid);
 228             next unless ( $v =~ /^<REPLY> ?see( also)? $fsafe\.?$/i );
 229
 230             &DEBUG("Factoids/Core: match! ($f || $faqtoid)");
 231
 232             $match++;
 233         }
 234
 235         # TODO: warn for op aswell, but allow force delete.
 236         if ( !$isop and $match ) {
 237             &msg( $who,
 238                 "uhm, other (redirection) factoids depend on this one." );
 239             return;
 240         }
 241
 242         # minimize abuse.
 243         if ( !$isop and &IsHostMatch($author) != 2 ) {
 244             $cache{forget}{$h}++;
 245
 246             # warn.
 247             if ( $cache{forget}{$h} > 3 ) {
 248                 &msg( $who, "Stop abusing forget!" );
 249             }
 250
 251             # ignore.
 252             # TODO: make forget limit configurable.
 253             # TODO: make forget ignore time configurable.
 254             if ( $cache{forget}{$h} > 5 ) {
 255                 &ignoreAdd(
 256                     &makeHostMask($nuh), '*',
 257                     3 * 24 * 60,
 258                     "abuse of forget"
 259                 );
 260                 &msg( $who, "forget: Ignoring you for abuse!" );
 261             }
 262         }
 263
 264         # lets do it!
 265
 266         if (   &IsParam('factoidDeleteDelay')
 267             or &IsChanConf('factoidDeleteDelay') > 0 )
 268         {
 269             if ( !( $isop or $isau ) and $faqtoid =~ / #DEL#$/ ) {
 270                 &msg( $who, "cannot delete it ($faqtoid)." );
 271                 return;
 272             }
 273
 274             &status( "forgot (safe delete): '$faqtoid' - " . scalar(gmtime) );
 275             ### TODO: check if the 'backup' exists and overwrite it
 276             my $check = &getFactoid("$faqtoid #DEL#");
 277
 278             if ( !defined $check or $check =~ /^\s*$/ ) {
 279                 if ( $faqtoid !~ / #DEL#$/ ) {
 280                     my $new = $faqtoid . " #DEL#";
 281
 282                     my $backup = &getFactoid($new);
 283                     if ($backup) {
 284                         &DEBUG("forget: not overwriting backup: $faqtoid");
 285                     }
 286                     else {
 287                         &status("forget: backing up '$faqtoid'");
 288                         &setFactInfo( $faqtoid, 'factoid_key',   $new );
 289                         &setFactInfo( $new,     'modified_by',   $who );
 290                         &setFactInfo( $new,     'modified_time', time() );
 291                     }
 292
 293                 }
 294                 else {
 295                     &status("forget: not backing up $faqtoid.");
 296                 }
 297
 298             }
 299             else {
 300                 &status("forget: not overwriting backup!");
 301             }
 302         }
 303
 304         &status("forget: <$who> '$faqtoid' =is=> '$result'");
 305         &delFactoid($faqtoid);
 306
 307         &performReply("i forgot $faqtoid");
 308
 309         $count{'Update'}++;
 310
 311         return;
 312     }
 313
 314     # factoid unforget/undelete.
 315     if ( $message =~ s/^un(forget|delete)\s+//i ) {
 316         return 'unforget: no addr' unless ($addressed);
 317
 318         my $i = 0;
 319         $i++ if ( &IsParam('factoidDeleteDelay') );
 320         $i++ if ( &IsChanConf('factoidDeleteDelay') > 0 );
 321         if ( !$i ) {
 322             &performReply(
 323                 "safe delete has been disable so what is there to undelete?");
 324             return;
 325         }
 326
 327         my $faqtoid = $message;
 328         if ( $faqtoid eq '' ) {
 329             &help('unforget');
 330             return;
 331         }
 332
 333         $faqtoid =~ tr/A-Z/a-z/;
 334         my $result = &getFactoid( $faqtoid . " #DEL#" );
 335         my $check  = &getFactoid($faqtoid);
 336
 337         if ( defined $check ) {
 338             &performReply(
 339                 "cannot undeleted '$faqtoid' because it already exists!");
 340             return;
 341         }
 342
 343         if ( !defined $result ) {
 344             &performReply("that factoid was not backedup :/");
 345             return;
 346         }
 347
 348         &setFactInfo( $faqtoid . " #DEL#", 'factoid_key', $faqtoid );
 349
 350         #       &setFactInfo($faqtoid, 'modified_by',   '');
 351         #       &setFactInfo($faqtoid, 'modified_time', 0);
 352
 353         $check = &getFactoid($faqtoid);
 354
 355         # TODO: check if $faqtoid." #DEL#" exists?
 356         if ( defined $check ) {
 357             &performReply("Successfully recovered '$faqtoid'.  Have fun now.");
 358             $count{'Undelete'}++;
 359         }
 360         else {
 361             &performReply("did not recover '$faqtoid'.  What happened?");
 362         }
 363
 364         return;
 365     }
 366
 367     # factoid locking.
 368     if ( $message =~ /^((un)?lock)(\s+(.*))?\s*?$/i ) {
 369         return 'lock: no addr 2' unless ($addressed);
 370
 371         my $function = lc $1;
 372         my $faqtoid  = lc $4;
 373
 374         if ( $faqtoid eq '' ) {
 375             &help($function);
 376             return;
 377         }
 378
 379         if ( &getFactoid($faqtoid) eq '' ) {
 380             &msg( $who, "factoid \002$faqtoid\002 does not exist" );
 381             return;
 382         }
 383
 384         if ( $function eq 'lock' ) {
 385
 386             # strongly requested by #debian on 19991028. -xk
 387             if ( 1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag('o') ne 'o' ) {
 388                 &msg( $who,
 389 "sorry, locking cannot be used since it can be abused unneccesarily."
 390                 );
 391                 &status(
 392                     "Replace 1 with 0 in Process.pl#~324 for locking support.");
 393                 return;
 394             }
 395
 396             &CmdLock($faqtoid);
 397         }
 398         else {
 399             &CmdUnLock($faqtoid);
 400         }
 401
 402         return;
 403     }
 404
 405     # factoid rename.
 406     if ( $message =~ s/^rename(\s+|$)// ) {
 407         return 'rename: no addr' unless ($addressed);
 408
 409         if ( $message eq '' ) {
 410             &help('rename');
 411             return;
 412         }
 413
 414         if ( $message =~ /^'(.*)'\s+'(.*)'$/ ) {
 415             my ( $from, $to ) = ( lc $1, lc $2 );
 416
 417             my $result = &getFactoid($from);
 418             if ( !defined $result ) {
 419                 &performReply(
 420                     "i didn't have anything called '$from' to rename");
 421                 return;
 422             }
 423
 424             # author == nick!user@host
 425             # created_by == nick
 426             my $author = &getFactInfo( $from, 'created_by' );
 427             $author =~ /^(.*)!/;
 428             my $created_by = $1;
 429
 430             # Can they even modify factoids?
 431             if (    &IsFlag('m') ne 'm'
 432                 and &IsFlag('M') ne 'M'
 433                 and &IsFlag('o') ne 'o' )
 434             {
 435                 &performReply("You do not have permission to modify factoids");
 436                 return;
 437
 438                 # If they have +M but they didnt create the factoid
 439             }
 440             elsif ( &IsFlag('M') eq 'M'
 441                 and $who !~ /^\Q$created_by\E$/i
 442                 and &IsFlag('m') ne 'm'
 443                 and &IsFlag('o') ne 'o' )
 444             {
 445                 &performReply("factoid '$from' is not yours to modify.");
 446                 return;
 447             }
 448
 449             # Else they have permission, so continue
 450
 451             if ( $_ = &getFactoid($to) ) {
 452                 &performReply("destination factoid already exists.");
 453                 return;
 454             }
 455
 456             &setFactInfo( $from, 'factoid_key', $to );
 457
 458             &status("rename: <$who> '$from' is now '$to'");
 459             &performReply("i renamed '$from' to '$to'");
 460         }
 461         else {
 462             &msg( $who, "error: wrong format. ask me about 'help rename'." );
 463         }
 464
 465         return;
 466     }
 467
 468     # factoid substitution. (X =~ s/A/B/FLAG)
 469     if ( $message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$| ) {
 470         my ( $faqtoid, $delim, $op, $np, $flags ) = ( lc $1, $2, $3, $4, $5 );
 471         return 'subst: no addr' unless ($addressed);
 472
 473         # incorrect format.
 474         if ( $np =~ /$delim/ ) {
 475             &msg( $who,
 476 "looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'."
 477             );
 478             return;
 479         }
 480
 481         # success.
 482         if ( my $result = &getFactoid($faqtoid) ) {
 483             return 'subst: locked' if ( &IsLocked($faqtoid) == 1 );
 484             my $was = $result;
 485             my $faqauth = &getFactInfo( $faqtoid, 'created_by' );
 486
 487             if ( ( $flags eq 'g' && $result =~ s/\Q$op/$np/gi )
 488                 || $result =~ s/\Q$op/$np/i )
 489             {
 490                 my $author = $faqauth;
 491                 $author =~ /^(.*)!/;
 492                 my $created_by = $1;
 493
 494                 # Can they even modify factoids?
 495                 if (    &IsFlag('m') ne 'm'
 496                     and &IsFlag('M') ne 'M'
 497                     and &IsFlag('o') ne 'o' )
 498                 {
 499                     &performReply(
 500                         "You do not have permission to modify factoids");
 501                     return;
 502
 503                     # If they have +M but they didnt create the factoid
 504                 }
 505                 elsif ( &IsFlag('M') eq 'M'
 506                     and $who !~ /^\Q$created_by\E$/i
 507                     and &IsFlag('m') ne 'm'
 508                     and &IsFlag('o') ne 'o' )
 509                 {
 510                     &performReply("factoid '$faqtoid' is not yours to modify.");
 511                     return;
 512                 }
 513
 514                 # excessive length.
 515                 if ( length $result > $param{'maxDataSize'} ) {
 516                     &performReply("that's too long");
 517                     return;
 518                 }
 519
 520                 # empty
 521                 if ( length $result == 0 ) {
 522                     &performReply(
 523                         "factoid would be empty. Use forget instead.");
 524                     return;
 525                 }
 526
 527                 # min length.
 528                 if (    ( length $result ) * 2 < length $was
 529                     and &IsFlag('o') ne 'o'
 530                     and &IsHostMatch($faqauth) != 2 )
 531                 {
 532                     &performReply("too drastic change of factoid.");
 533                 }
 534
 535                 &setFactInfo( $faqtoid, 'factoid_value', $result );
 536                 &status("update: '$faqtoid' =is=> '$result'; was '$was'");
 537                 &performReply('OK');
 538             }
 539             else {
 540                 &performReply("that doesn't contain '$op'");
 541             }
 542         }
 543         else {
 544             &performReply("i didn't have anything called '$faqtoid' to modify");
 545         }
 546
 547         return;
 548     }
 549
 550     # Fix up $message for question.
 551     my $question = $message;
 552     for ($question) {
 553
 554         # fix the string.
 555         s/^where is //i;
 556         s/\s+\?$/?/;
 557         s/^whois //i;   # Must match ^, else factoids with "whois" anywhere break
 558         s/^who is //i;
 559         s/^what is (a|an)?//i;
 560         s/^how do i //i;
 561         s/^where can i (find|get|download)//i;
 562         s/^how about //i;
 563         s/ da / the /ig;
 564
 565         # clear the string of useless words.
 566         s/^(stupid )?q(uestion)?:\s+//i;
 567         s/^(does )?(any|ne)(1|one|body) know //i;
 568
 569         s/^[uh]+m*[,\.]* +//i;
 570
 571         s/^well([, ]+)//i;
 572         s/^still([, ]+)//i;
 573         s/^(gee|boy|golly|gosh)([, ]+)//i;
 574         s/^(well|and|but|or|yes)([, ]+)//i;
 575
 576         s/^o+[hk]+(a+y+)?([,. ]+)//i;
 577         s/^g(eez|osh|olly)([,. ]+)//i;
 578         s/^w(ow|hee|o+ho+)([,. ]+)//i;
 579         s/^heya?,?( folks)?([,. ]+)//i;
 580     }
 581
 582     if ( $addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i ) {
 583         $correction_plausible = 1;
 584         &status(
 585             "correction is plausible, initial negative and nick deleted ($&)")
 586           if ( $param{VERBOSITY} );
 587     }
 588     else {
 589         $correction_plausible = 0;
 590     }
 591
 592     my $result = &doQuestion($question);
 593     if ( !defined $result or $result eq $noreply ) {
 594         return 'result from doQ undef.';
 595     }
 596
 597     if ( defined $result and $result !~ /^0?$/ ) {    # question.
 598         &status("question: <$who> $message");
 599         $count{'Question'}++;
 600     }
 601     elsif ( &IsChanConf('Math') > 0 and $addressed ) {    # perl math.
 602         &loadMyModule('Math');
 603         my $newresult = &perlMath();
 604
 605         if ( defined $newresult and $newresult ne '' ) {
 606             $cmdstats{'Maths'}++;
 607             $result = $newresult;
 608             &status("math: <$who> $message => $result");
 609         }
 610     }
 611
 612     if ( $result !~ /^0?$/ ) {
 613         &performStrictReply($result);
 614         return;
 615     }
 616
 617     # why would a friendly bot get passed here?
 618     if ( &IsParam('friendlyBots') ) {
 619         return
 620           if ( grep lc($_) eq lc($who),
 621             split( /\s+/, $param{'friendlyBots'} ) );
 622     }
 623
 624     # do the statement.
 625     if ( !defined &doStatement($message) ) {
 626         return;
 627     }
 628
 629     return unless ( $addressed and !$addrchar );
 630
 631     if ( length $message > 64 ) {
 632         &status("unparseable-moron: $message");
 633
 634         #       &performReply( &getRandom(keys %{ $lang{'moron'} }) );
 635         $count{'Moron'}++;
 636
 637         &performReply( "You are moron \002#" . $count{'Moron'} . "\002" );
 638         return;
 639     }
 640
 641     &status("unparseable: $message");
 642     &performReply( &getRandom( keys %{ $lang{'dunno'} } ) );
 643     $count{'Dunno'}++;
 644 }
 645
 646 1;
 647
 648 # vim:ts=4:sw=4:expandtab:tw=80