2 # core.pl: Important functions stuff...
4 # Version: v0.4 (20000718)
10 # scalar. MUST BE REDUCED IN SIZE!!!
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
30 use vars qw(@ircServers @wingateBad @wingateNow @wingateCache
33 ### hash. MUST BE REDUCED IN SIZE!!!
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
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';
48 # initialize variables.
52 $userHandle = "_default";
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*';
85 open( VERSION, '<VERSION' );
86 $bot_release = <VERSION> || "(unknown version)";
89 $bot_version = "infobot $bot_release -- $^O";
97 if ( !&IsParam('Interface') or $param{'Interface'} =~ /IRC/ ) {
108 if ( defined $flag_quit ) {
109 &WARN("doExit: quit already called.");
114 if ( !defined $bot_pid ) { # independent.
117 elsif ( $bot_pid == $$ ) { # parent.
118 &status("parent caught SIG$sig (pid $$).") if ( defined $sig );
120 &status("--- Start of quit.");
121 $ident ||= 'infobot'; # lame hack.
123 &status("Memory Usage: $memusage KiB");
128 # shutdown IRC and related components.
129 if ( &whatInterface() =~ /IRC/ ) {
132 &quit( $param{'quitMsg'} );
136 &uptimeWriteFile() if ( &IsParam('Uptime') );
140 if ( &IsParam('dumpvarsAtExit') ) {
141 &loadMyModule('DumpVars');
144 &symdumpAll() if ( &IsParam('symdumpAtExit') );
146 &closeSQLDebug() if ( &IsParam('SQLDebug') );
148 &status("--- QUIT.");
151 &status("child caught SIG$sig (pid $$).");
158 $SIG{__WARN__} = sub { warn $_[0]; };
164 $SIG{__WARN__} = 'doWarn'; # ???
167 # Usage: &IsParam($param);
168 # infobot.config specific.
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;
180 # Usage: &ChanConfList($param)
181 # About: gets channels with 'param' enabled. (!!!)
182 # Return: array of channels
185 return unless ( defined $param );
186 my %chan = &getChanConfList($param);
188 if ( exists $chan{_default} ) {
189 return keys %chanconf;
197 # Usage: &getChanConfList($param)
198 # About: gets channels with 'param' enabled, internal use only.
199 # Return: hash of channels
200 sub getChanConfList {
204 return unless ( defined $param );
206 foreach ( keys %chanconf ) {
208 my @array = grep /^$param$/, keys %{ $chanconf{$chan} };
210 #&DEBUG("gCCL param => $param, chan => $chan, keys => " . join(':',keys %{ $chanconf{$chan} }) . " array => " . join(':', @array)) if ($param eq 'whatever');
212 next unless ( scalar @array );
214 if ( scalar @array > 1 ) {
215 &WARN("multiple items found?");
218 if ( $chanconf{$chan}{$param} eq '0' ) {
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.
236 # knocked tons of bugs with this! :)
237 my $debug = 0; # 1 if ($param eq 'whatever');
239 if ( !defined $param ) {
240 &WARN("IsChanConf: param == NULL.");
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.");
251 $chan ||= "_default";
254 if ( $chan =~ tr/A-Z/a-z/ ) {
255 &WARN("IsChanConf: lowercased chan. ($old)");
258 ### TODO: VERBOSITY on how chanconf returned 1 or 0 or -1.
259 my %chan = &getChanConfList($param);
261 if ( !defined $msgType ) {
265 $nomatch++ if ( $msgType eq '' );
266 $nomatch++ unless ( $msgType =~ /^(public|private)$/i );
269 ## Please see file perltidy.ERR
270 ### debug purposes only.
272 # &DEBUG("param => $param, msgType => $msgType.");
273 # foreach (keys %chan) {
274 # &DEBUG(" $_ => $chan{$_}");
279 if ( $chan{$chan} ) {
280 &DEBUG("ICC: other: $chan{$chan} (_default/$param)") if ($debug);
282 elsif ( $chan{_default} ) {
283 &DEBUG("ICC: other: $chan{_default} (_default/$param)") if ($debug);
286 &DEBUG("ICC: other: 0 ($param)") if ($debug);
288 return $chan{$chan} || $chan{_default} || 0;
290 elsif ( $msgType =~ /^(public|private)$/i ) {
291 if ( $chan{$chan} ) {
292 &DEBUG("ICC: $msgType: $chan{$chan} ($chan/$param)") if ($debug);
294 elsif ( $chan{_default} ) {
295 &DEBUG("ICC: $msgType: $chan{_default} (_default/$param)")
299 &DEBUG("ICC: $msgType: 0 ($param)") if ($debug);
301 return $chan{$chan} || $chan{_default} || 0;
304 &DEBUG("ICC: no-match: 0/$param (msgType = $msgType)");
310 # Usage: &getChanConf($param);
311 # About: Retrieve value for 'param' value in current/default chan.
312 # Return: scalar for success, undef for failure.
314 my ( $param, $c ) = @_;
316 if ( !defined $param ) {
317 &WARN("gCC: param == NULL.");
322 if ( 0 and !defined $chan ) {
323 &DEBUG("gCC: ok !chan... doing _default instead.");
328 $c = "_default" if ( $c eq "*" ); # FIXME
329 my @c = grep /^\Q$c\E$/i, keys %chanconf;
332 if ( 0 and $c[0] ne $c ) {
333 &WARN("c ne chan ($c[0] ne $chan)");
335 if ( !defined $chanconf{ $c[0] }{$param} and ( $c ne '_default' ) ) {
336 return &getChanConf( $param, '_default' );
338 &DEBUG( "gCC: $param,$c \"" . $chanconf{ $c[0] }{$param} . '"' );
339 return $chanconf{ $c[0] }{$param};
342 #&DEBUG("gCC: returning _default... " . $chanconf{"_default"}{$param});
343 return $chanconf{"_default"}{$param};
346 sub getChanConfDefault {
347 my ( $what, $default, $chan ) = @_;
348 $chan ||= "_default";
350 if ( exists $param{$what} ) {
351 if ( !exists $cache{config}{$what} ) {
353 "config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead of chan option"
355 $cache{config}{$what} = 1;
358 return $param{$what};
360 my $val = &getChanConf( $what, $chan );
361 return $val if ( defined $val );
363 $param{$what} = $default;
364 &status("config ($chan): auto-setting param{$what} = $default");
365 $cache{config}{$what} = 1;
370 # Usage: &findChanConf($param);
371 # About: Retrieve value for 'param' value from any chan.
372 # Return: scalar for success, undef for failure.
376 if ( !defined $param ) {
377 &WARN("param == NULL.");
382 foreach $c ( keys %chanconf ) {
383 foreach ( keys %{ $chanconf{$c} } ) {
384 next unless (/^$param$/);
386 return $chanconf{$c}{$_};
394 my ($prefix) = $_[0] || '';
396 if ( $^O eq 'linux' ) {
397 if ( !open( IN, "/proc/$$/status" ) ) {
398 &ERROR("cannot open '/proc/$$/status'.");
403 $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
408 elsif ( $^O eq 'netbsd' ) {
409 $memusage = int( ( stat "/proc/$$/mem" )[7] / 1024 );
412 elsif ( $^O =~ /^(free|open)bsd$/ ) {
413 my @info = split /\s+/, `/bin/ps -l -p $$`;
414 $memusage = $info[20];
418 $memusage = 'UNKNOWN';
422 if ( defined $memusageOld and &IsParam('DEBUG') ) {
424 # it's always going to be increase.
425 my $delta = $memusage - $memusageOld;
430 elsif ( $delta > 500 ) {
432 "MEM:$prefix increased by $delta KiB. (total: $memusage KiB)";
434 elsif ( $delta > 0 ) {
435 $str = "MEM:$prefix increased by $delta KiB";
440 # never knew RSS could decrease, probably Size can't?
441 $str = "MEM:$prefix decreased by $delta KiB.";
446 $memusageOld = $memusage;
454 &showProc(" (\&openLog before)");
455 &openLog(); # write, append.
456 &status("--- Started logging.");
459 &loadLang( $bot_data_dir . "/infobot.lang" );
463 &loadMyModulesNow(); # must be after chan file.
466 &openSQLDebug() if ( &IsParam('SQLDebug') );
468 $param{'DBName'}, $param{'DBType'},
469 $param{'SQLUser'}, $param{'SQLPass'}
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 );
481 $param{tempDir} =~ s#\~/#$ENV{HOME}/#;
483 &status("Initial memory usage: $memusage KiB");
484 &status("-------------------------------------------------------");
488 $param{'VERBOSITY'} = 1;
489 &loadConfig( $bot_config_dir . "/infobot.config" );
491 foreach (qw(ircNick ircUser ircName DBType tempDir)) {
492 next if &IsParam($_);
493 &ERROR("Parameter $_ has not been defined.");
497 if ( $param{tempDir} =~ s#\~/#$ENV{HOME}/# ) {
498 &VERB( "Fixing up tempDir.", 2 );
501 if ( $param{tempDir} =~ /~/ ) {
502 &ERROR("parameter tempDir still contains tilde.");
506 if ( !-d $param{tempDir} ) {
507 &status("making $param{tempDir}...");
508 mkdir $param{tempDir}, 0755;
511 # static scalar variables.
512 $file{utm} = "$bot_state_dir/$param{'ircUser'}.uptime";
513 $file{PID} = "$bot_run_dir/$param{'ircUser'}.pid";
517 if ( &IsParam('DEBUG') ) {
518 &status("enabling debug diagnostics.");
520 # I thought disabling this reduced memory usage by 1000 KiB.
524 $count{'Question'} = 0;
525 $count{'Update'} = 0;
533 # reverse order of &setup().
534 &status("--- shutdown called.");
537 $ident ||= 'infobot';
539 if ( !&isFileUpdated( "$bot_state_dir/infobot.users", $wtime_userfile ) ) {
543 if ( !&isFileUpdated( "$bot_state_dir/infobot.chan", $wtime_chanfile ) ) {
549 # aswell. TODO: use this in &doExit?
557 if ( $$ == $bot_pid ) {
558 &status("--- $sig called.");
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 \@ "
572 &ircCheck(); # heh, evil!
574 &DCCBroadcast( "-HUP called.", 'm' );
576 &loadConfig( $bot_config_dir . "/infobot.config" );
577 &reloadAllModules() if ( &IsParam('DEBUG') );
580 &status("--- End of $sig.");
583 &status("$sig called; ignoring restart.");
587 # File: Configuration.
591 if ( !open( FILE, $file ) ) {
592 &ERROR("Failed to read configuration file ($file): $!");
594 "Please read the INSTALL file on how to install and setup this file."
604 my ( $set, $key, $val ) = split( /\s+/, $_, 3 );
606 if ( $set ne 'set' ) {
607 &status("loadConfig: invalid line '$_'.");
611 # perform variable interpolation
612 $val =~ s/(\$(\w+))/$param{$2}/g;
621 &status("Loaded config $file ($count items)");
626 # vim:ts=4:sw=4:expandtab:tw=80