src/core.pl

   1 #
   2 #   core.pl: Important functions stuff...
   3 #    Author: dms
   4 #   Version: v0.4 (20000718)
   5 #   Created: 20000322
   6 #
   7
   8 use strict;
   9
  10 # scalar. MUST BE REDUCED IN SIZE!!!
  11 ### TODO: reorder.
  12 use vars qw(
  13   $bot_misc_dir $bot_pid $bot_base_dir $bot_src_dir
  14   $bot_data_dir $bot_config_dir $bot_state_dir $bot_run_dir
  15   $answer $correction_plausible $talkchannel $bot_release
  16   $statcount $memusage $user $memusageOld $bot_version $dbh
  17   $shm $host $msg $noreply $conn $irc $learnok $nick $ident
  18   $force_public_reply $addrchar $userHandle $addressedother
  19   $floodwho $chan $msgtime $server $firsttime $wingaterun
  20   $flag_quit $msgType $no_syscall
  21   $utime_userfile       $wtime_userfile $ucount_userfile
  22   $utime_chanfile       $wtime_chanfile $ucount_chanfile
  23   $pubsize $pubcount $pubtime
  24   $msgsize $msgcount $msgtime
  25   $notsize $notcount $nottime
  26   $running
  27 );
  28
  29 # array.
  30 use vars qw(@ircServers @wingateBad @wingateNow @wingateCache
  31 );
  32
  33 ### hash. MUST BE REDUCED IN SIZE!!!
  34 #
  35 use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig
  36   %nuh %talkWho %seen %floodwarn %param %dbh %ircPort
  37   %topic %moduleAge %last %time %mask %file
  38   %forked %chanconf %channels %cache
  39 );
  40
  41 # Signals.
  42 $SIG{'HUP'}      = 'restart';    #  1.
  43 $SIG{'INT'}      = 'doExit';     #  2.
  44 $SIG{'KILL'}     = 'doExit';     #  9. DOES NOT WORK. 'man perlipc' for details.
  45 $SIG{'TERM'}     = 'doExit';     # 15.
  46 $SIG{'__WARN__'} = 'doWarn';
  47
  48 # initialize variables.
  49 $last{buflen}    = 0;
  50 $last{say}       = '';
  51 $last{msg}       = '';
  52 $userHandle      = '_default';
  53 $wingaterun      = time();
  54 $firsttime       = 1;
  55 $utime_userfile  = 0;
  56 $wtime_userfile  = 0;
  57 $ucount_userfile = 0;
  58 $utime_chanfile  = 0;
  59 $wtime_chanfile  = 0;
  60 $ucount_chanfile = 0;
  61 $running         = 0;
  62
  63 ### more variables...
  64
  65 # static scalar variables.
  66 $mask{ip}   = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
  67 $mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
  68 $mask{chan} = '[\#\&]\S*|_default';
  69 my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
  70 my $isnick2 = '0-9\-';
  71 $mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*";
  72 $mask{nuh}  = '\S*!\S*\@\S*';
  73 $msgtime    = time();
  74 $msgsize    = 0;
  75 $msgcount   = 0;
  76 $pubtime    = 0;
  77 $pubsize    = 0;
  78 $pubcount   = 0;
  79 $nottime    = 0;
  80 $notsize    = 0;
  81 $notcount   = 0;
  82
  83 ###
  84
  85 open( VERSION, '<VERSION' );
  86 $bot_release = <VERSION> || '(unknown version)';
  87 chomp($bot_release);
  88 close(VERSION);
  89 $bot_version = "infobot $bot_release -- $^O";
  90 $noreply     = 'NOREPLY';
  91
  92 ##########
  93 ### misc commands.
  94 ###
  95
  96 sub whatInterface {
  97     if ( !&IsParam('Interface') or $param{'Interface'} =~ /IRC/ ) {
  98         return 'IRC';
  99     }
 100     else {
 101         return 'CLI';
 102     }
 103 }
 104
 105 sub doExit {
 106     my ($sig) = @_;
 107
 108     if ( defined $flag_quit ) {
 109         &WARN('doExit: quit already called.');
 110         return;
 111     }
 112     $flag_quit = 1;
 113
 114     if ( !defined $bot_pid ) {    # independent.
 115         exit 0;
 116     }
 117     elsif ( $bot_pid == $$ ) {    # parent.
 118         &status("parent caught SIG$sig (pid $$).") if ( defined $sig );
 119
 120         &status('--- Start of quit.');
 121         $ident ||= 'infobot';     # lame hack.
 122
 123         &status("Memory Usage: $memusage KiB");
 124
 125         &closePID();
 126         &closeStats();
 127
 128         # shutdown IRC and related components.
 129         if ( &whatInterface() =~ /IRC/ ) {
 130             &closeDCC();
 131             &seenFlush();
 132             &quit( $param{'quitMsg'} );
 133         }
 134         &writeUserFile();
 135         &writeChanFile();
 136         &uptimeWriteFile() if ( &IsParam('Uptime') );
 137         &sqlCloseDB();
 138         &closeSHM($shm);
 139
 140         if ( &IsParam('dumpvarsAtExit') ) {
 141             &loadMyModule('DumpVars');
 142             &dumpallvars();
 143         }
 144         &symdumpAll() if ( &IsParam('symdumpAtExit') );
 145         &closeLog();
 146         &closeSQLDebug() if ( &IsParam('SQLDebug') );
 147
 148         &status('--- QUIT.');
 149     }
 150     else {    # child.
 151         &status("child caught SIG$sig (pid $$).");
 152     }
 153
 154     exit 0;
 155 }
 156
 157 sub doWarn {
 158     $SIG{__WARN__} = sub { warn $_[0]; };
 159
 160     foreach (@_) {
 161         &WARN("PERL: $_");
 162     }
 163
 164     $SIG{__WARN__} = 'doWarn';    # ???
 165 }
 166
 167 # Usage: &IsParam($param);
 168 # infobot.config specific.
 169 sub IsParam {
 170     my $param = $_[0];
 171
 172     return 0 unless ( defined $param );
 173     return 0 unless ( exists $param{$param} );
 174     return 0 unless ( $param{$param} );
 175     return 0 if $param{$param} =~ /^false$/i;
 176     return 1;
 177 }
 178
 179 #####
 180 #  Usage: &ChanConfList($param)
 181 #  About: gets channels with 'param' enabled. (!!!)
 182 # Return: array of channels
 183 sub ChanConfList {
 184     my $param = $_[0];
 185     return unless ( defined $param );
 186     my %chan = &getChanConfList($param);
 187
 188     if ( exists $chan{_default} ) {
 189         return keys %chanconf;
 190     }
 191     else {
 192         return keys %chan;
 193     }
 194 }
 195
 196 #####
 197 #  Usage: &getChanConfList($param)
 198 #  About: gets channels with 'param' enabled, internal use only.
 199 # Return: hash of channels
 200 sub getChanConfList {
 201     my $param = $_[0];
 202     my %chan;
 203
 204     return unless ( defined $param );
 205
 206     foreach ( keys %chanconf ) {
 207         my $chan = $_;
 208         my @array = grep /^$param$/, keys %{ $chanconf{$chan} };
 209
 210 #&DEBUG("gCCL param => $param, chan => $chan, keys => " . join(':',keys %{ $chanconf{$chan} }) . ' array => ' . join(':', @array)) if ($param eq 'whatever');
 211
 212         next unless ( scalar @array );
 213
 214         if ( scalar @array > 1 ) {
 215             &WARN('multiple items found?');
 216         }
 217
 218         if ( $chanconf{$chan}{$param} eq '0' ) {
 219             $chan{$chan} = -1;
 220         }
 221         else {
 222             $chan{$chan} = 1;
 223         }
 224     }
 225
 226     return %chan;
 227 }
 228
 229 #####
 230 #  Usage: &IsChanConf($param);
 231 #  About: Check for 'param' on the basis of channel config.
 232 # Return: 1 for enabled, 0 for passive disable, -1 for active disable.
 233 sub IsChanConf {
 234     my ($param) = shift;
 235
 236     # knocked tons of bugs with this! :)
 237     my $debug = 0;    # 1 if ($param eq 'whatever');
 238
 239     if ( !defined $param ) {
 240         &WARN('IsChanConf: param == NULL.');
 241         return 0;
 242     }
 243
 244     # these should get moved to your .chan file instead of the .config
 245     # .config items overide any .chan entries
 246     if ( &IsParam($param) ) {
 247         &WARN("ICC: found '$param' option in main config file.");
 248         return 1;
 249     }
 250
 251     $chan ||= '_default';
 252
 253     my $old = $chan;
 254     if ( $chan =~ tr/A-Z/a-z/ ) {
 255         &WARN("IsChanConf: lowercased chan. ($old)");
 256     }
 257
 258     ### TODO: VERBOSITY on how chanconf returned 1 or 0 or -1.
 259     my %chan    = &getChanConfList($param);
 260     my $nomatch = 0;
 261     if ( !defined $msgType ) {
 262         $nomatch++;
 263     }
 264     else {
 265         $nomatch++ if ( $msgType eq '' );
 266         $nomatch++ unless ( $msgType =~ /^(public|private)$/i );
 267     }
 268
 269 ## Please see file perltidy.ERR
 270 ### debug purposes only.
 271     #    if ($debug) {
 272     #   &DEBUG("param => $param, msgType => $msgType.");
 273     #   foreach (keys %chan) {
 274     #       &DEBUG("   $_ => $chan{$_}");
 275     #   }
 276     #    }
 277
 278     if ($nomatch) {
 279         if ( $chan{$chan} ) {
 280             &DEBUG("ICC: other: $chan{$chan} (_default/$param)") if ($debug);
 281         }
 282         elsif ( $chan{_default} ) {
 283             &DEBUG("ICC: other: $chan{_default} (_default/$param)") if ($debug);
 284         }
 285         else {
 286             &DEBUG("ICC: other: 0 ($param)") if ($debug);
 287         }
 288         return $chan{$chan} || $chan{_default} || 0;
 289     }
 290     elsif ( $msgType =~ /^(public|private)$/i ) {
 291         if ( $chan{$chan} ) {
 292             &DEBUG("ICC: $msgType: $chan{$chan} ($chan/$param)") if ($debug);
 293         }
 294         elsif ( $chan{_default} ) {
 295             &DEBUG("ICC: $msgType: $chan{_default} (_default/$param)")
 296               if ($debug);
 297         }
 298         else {
 299             &DEBUG("ICC: $msgType: 0 ($param)") if ($debug);
 300         }
 301         return $chan{$chan} || $chan{_default} || 0;
 302     }
 303
 304     &DEBUG("ICC: no-match: 0/$param (msgType = $msgType)");
 305
 306     return 0;
 307 }
 308
 309 #####
 310 #  Usage: &getChanConf($param);
 311 #  About: Retrieve value for 'param' value in current/default chan.
 312 # Return: scalar for success, undef for failure.
 313 sub getChanConf {
 314     my ( $param, $c ) = @_;
 315
 316     if ( !defined $param ) {
 317         &WARN('gCC: param == NULL.');
 318         return 0;
 319     }
 320
 321     # this looks evil...
 322     if ( 0 and !defined $chan ) {
 323         &DEBUG('gCC: ok !chan... doing _default instead.');
 324     }
 325
 326     $c ||= $chan;
 327     $c ||= '_default';
 328     $c = '_default' if ( $c eq '*' );    # FIXME
 329     my @c = grep /^\Q$c\E$/i, keys %chanconf;
 330
 331     if (@c) {
 332         if ( 0 and $c[0] ne $c ) {
 333             &WARN("c ne chan ($c[0] ne $chan)");
 334         }
 335         if ( !defined $chanconf{ $c[0] }{$param} and ( $c ne '_default' ) ) {
 336             return &getChanConf( $param, '_default' );
 337         }
 338         &DEBUG( "gCC: $param,$c \"" . $chanconf{ $c[0] }{$param} . '"' );
 339         return $chanconf{ $c[0] }{$param};
 340     }
 341
 342     #&DEBUG('gCC: returning _default... ' . $chanconf{'_default'}{$param});
 343     return $chanconf{'_default'}{$param};
 344 }
 345
 346 sub getChanConfDefault {
 347     my ( $what, $default, $chan ) = @_;
 348     $chan ||= '_default';
 349
 350     if ( exists $param{$what} ) {
 351         if ( !exists $cache{config}{$what} ) {
 352             &status(
 353 "config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead of chan option"
 354             );
 355             $cache{config}{$what} = 1;
 356         }
 357
 358         return $param{$what};
 359     }
 360     my $val = &getChanConf( $what, $chan );
 361     return $val if ( defined $val );
 362
 363     $param{$what} = $default;
 364     &status("config ($chan): auto-setting param{$what} = $default");
 365     $cache{config}{$what} = 1;
 366     return $default;
 367 }
 368
 369 #####
 370 #  Usage: &findChanConf($param);
 371 #  About: Retrieve value for 'param' value from any chan.
 372 # Return: scalar for success, undef for failure.
 373 sub findChanConf {
 374     my ($param) = @_;
 375
 376     if ( !defined $param ) {
 377         &WARN('param == NULL.');
 378         return 0;
 379     }
 380
 381     my $c;
 382     foreach $c ( keys %chanconf ) {
 383         foreach ( keys %{ $chanconf{$c} } ) {
 384             next unless (/^$param$/);
 385
 386             return $chanconf{$c}{$_};
 387         }
 388     }
 389
 390     return;
 391 }
 392
 393 sub showProc {
 394     my ($prefix) = $_[0] || '';
 395
 396     if ( $^O eq 'linux' ) {
 397         if ( !open( IN, "/proc/$$/status" ) ) {
 398             &ERROR("cannot open '/proc/$$/status'.");
 399             return;
 400         }
 401
 402         while (<IN>) {
 403             $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
 404         }
 405         close IN;
 406
 407     }
 408     elsif ( $^O eq 'netbsd' ) {
 409         $memusage = int( ( stat "/proc/$$/mem" )[7] / 1024 );
 410
 411     }
 412     elsif ( $^O =~ /^(free|open)bsd$/ ) {
 413         my @info = split /\s+/, `/bin/ps -l -p $$`;
 414         $memusage = $info[20];
 415
 416     }
 417     else {
 418         $memusage = 'UNKNOWN';
 419         return;
 420     }
 421
 422     if ( defined $memusageOld and &IsParam('DEBUG') ) {
 423
 424         # it's always going to be increase.
 425         my $delta = $memusage - $memusageOld;
 426         my $str;
 427         if ( $delta == 0 ) {
 428             return;
 429         }
 430         elsif ( $delta > 500 ) {
 431             $str =
 432               "MEM:$prefix increased by $delta KiB. (total: $memusage KiB)";
 433         }
 434         elsif ( $delta > 0 ) {
 435             $str = "MEM:$prefix increased by $delta KiB";
 436         }
 437         else {    # delta < 0.
 438             $delta = -$delta;
 439
 440             # never knew RSS could decrease, probably Size can't?
 441             $str = "MEM:$prefix decreased by $delta KiB.";
 442         }
 443
 444         &status($str);
 445     }
 446     $memusageOld = $memusage;
 447 }
 448
 449 ######
 450 ###### SETUP
 451 ######
 452
 453 sub setup {
 454     &showProc(" (\&openLog before)");
 455     &openLog();    # write, append.
 456     &status('--- Started logging.');
 457
 458     # read.
 459     &loadLang( $bot_data_dir . '/infobot.lang' );
 460     &loadIRCServers();
 461     &readUserFile();
 462     &readChanFile();
 463     &loadMyModulesNow();    # must be after chan file.
 464
 465     $shm = &openSHM();
 466     &openSQLDebug() if ( &IsParam('SQLDebug') );
 467     &sqlOpenDB(
 468         $param{'DBName'},  $param{'DBType'},
 469         $param{'SQLUser'}, $param{'SQLPass'}
 470     );
 471     &checkTables();
 472
 473     &status( 'Setup: ' . &countKeys('factoids') . ' factoids.' );
 474     &getChanConfDefault( 'sendPrivateLimitLines', 3,    $chan );
 475     &getChanConfDefault( 'sendPrivateLimitBytes', 1000, $chan );
 476     &getChanConfDefault( 'sendPublicLimitLines',  3,    $chan );
 477     &getChanConfDefault( 'sendPublicLimitBytes',  1000, $chan );
 478     &getChanConfDefault( 'sendNoticeLimitLines',  3,    $chan );
 479     &getChanConfDefault( 'sendNoticeLimitBytes',  1000, $chan );
 480
 481     $param{tempDir} =~ s#\~/#$ENV{HOME}/#;
 482
 483     &status("Initial memory usage: $memusage KiB");
 484     &status('-------------------------------------------------------');
 485 }
 486
 487 sub setupConfig {
 488     $param{'VERBOSITY'} = 1;
 489     &loadConfig( $bot_config_dir . '/infobot.config' );
 490
 491     foreach (qw(ircNick ircUser ircName DBType tempDir)) {
 492         next if &IsParam($_);
 493         &ERROR("Parameter $_ has not been defined.");
 494         exit 1;
 495     }
 496
 497     if ( $param{tempDir} =~ s#\~/#$ENV{HOME}/# ) {
 498         &VERB( 'Fixing up tempDir.', 2 );
 499     }
 500
 501     if ( $param{tempDir} =~ /~/ ) {
 502         &ERROR('parameter tempDir still contains tilde.');
 503         exit 1;
 504     }
 505
 506     if ( !-d $param{tempDir} ) {
 507         &status("making $param{tempDir}...");
 508         mkdir $param{tempDir}, 0755;
 509     }
 510
 511     # static scalar variables.
 512     $file{utm} = "$bot_state_dir/$param{'ircUser'}.uptime";
 513     $file{PID} = "$bot_run_dir/$param{'ircUser'}.pid";
 514 }
 515
 516 sub startup {
 517     if ( &IsParam('DEBUG') ) {
 518         &status('enabling debug diagnostics.');
 519
 520         # I thought disabling this reduced memory usage by 1000 KiB.
 521         use diagnostics;
 522     }
 523
 524     $count{'Question'} = 0;
 525     $count{'Update'}   = 0;
 526     $count{'Dunno'}    = 0;
 527     $count{'Moron'}    = 0;
 528 }
 529
 530 sub shutdown {
 531     my ($sig) = @_;
 532
 533     # reverse order of &setup().
 534     &status('--- shutdown called.');
 535
 536     # hack.
 537     $ident ||= 'infobot';
 538
 539     if ( !&isFileUpdated( "$bot_state_dir/infobot.users", $wtime_userfile ) ) {
 540         &writeUserFile();
 541     }
 542
 543     if ( !&isFileUpdated( "$bot_state_dir/infobot.chan", $wtime_chanfile ) ) {
 544         &writeChanFile();
 545     }
 546
 547     &sqlCloseDB();
 548
 549     # aswell. TODO: use this in &doExit?
 550     &closeSHM($shm);
 551     &closeLog();
 552 }
 553
 554 sub restart {
 555     my ($sig) = @_;
 556
 557     if ( $$ == $bot_pid ) {
 558         &status("--- $sig called.");
 559
 560         ### crappy bug in Net::IRC?
 561         my $delta = time() - $msgtime;
 562         &DEBUG("restart: dtime = $delta");
 563         if ( !$conn->connected or time() - $msgtime > 900 ) {
 564             &status( "reconnecting because of uncaught disconnect \@ "
 565                   . scalar(gmtime) );
 566 ###         $irc->start;
 567             &clearIRCVars();
 568             $conn->connect();
 569 ###         return;
 570         }
 571
 572         &ircCheck();    # heh, evil!
 573
 574         &DCCBroadcast( '-HUP called.', 'm' );
 575         &shutdown($sig);
 576         &loadConfig( $bot_config_dir . '/infobot.config' );
 577         &reloadAllModules() if ( &IsParam('DEBUG') );
 578         &setup();
 579
 580         &status("--- End of $sig.");
 581     }
 582     else {
 583         &status("$sig called; ignoring restart.");
 584     }
 585 }
 586
 587 # File: Configuration.
 588 sub loadConfig {
 589     my ($file) = @_;
 590
 591     if ( !open( FILE, $file ) ) {
 592         &ERROR("Failed to read configuration file ($file): $!");
 593         &status(
 594 'Please read the INSTALL file on how to install and setup this file.'
 595         );
 596         exit 0;
 597     }
 598
 599     my $count = 0;
 600     while (<FILE>) {
 601         chomp;
 602         next if /^\s*\#/;
 603         next unless /\S/;
 604         my ( $set, $key, $val ) = split( /\s+/, $_, 3 );
 605
 606         if ( $set ne 'set' ) {
 607             &status("loadConfig: invalid line '$_'.");
 608             next;
 609         }
 610
 611         # perform variable interpolation
 612         $val =~ s/(\$(\w+))/$param{$2}/g;
 613
 614         $param{$key} = $val;
 615
 616         ++$count;
 617     }
 618     close FILE;
 619
 620     $file =~ s/^.*\///;
 621     &status("Loaded config $file ($count items)");
 622 }
 623
 624 1;
 625
 626 # vim:ts=4:sw=4:expandtab:tw=80