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