# Created: 20000124
#
-if (&IsParam("useStrict")) { use strict; }
+# use strict; # TODO
use POSIX qw(_exit);
my $IPC_PRIVATE = 0;
my $size = 2000;
+ if (&IsParam("noSHM")) {
+ &status("Shared memory: Disabled. WARNING: bot may become unreliable");
+ return 0;
+ }
+
if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
&status("Created shared memory (shm) key: [$_]");
return $_;
my $size = 3*80;
my $retval = '';
+ return '' if (&IsParam("noSHM"));
+
if (shmread($key,$retval,$position,$size)) {
+ #&DEBUG("shmRead($key): $retval");
return $retval;
} else {
&ERROR("shmRead: failed: $!");
+ ### TODO: if this fails, never try again.
+ &openSHM();
return '';
}
}
my $position = 0;
my $size = 80*3;
- # NULL hack.
- ### TODO: create shmClear to deal with this.
- if ($str !~ /^$/) {
- my $read = &shmRead($key);
- $read =~ s/\0+//g;
- $str = $read ."||". $str if ($read ne "");
+ return if (&IsParam("noSHM"));
+
+ if (length($str) > $size) {
+ &status("ERROR: length(str) (..)>$size...");
+ return;
+ }
+
+ if (length($str) == 0) {
+ # does $size overwrite the whole lot?
+ # if not, set to 2000.
+ if (!shmwrite($key, '', $position, $size)) {
+ &ERROR("shmWrite: failed: $!");
+ }
+ return;
+ }
+
+ my $read = &shmRead($key);
+ $read =~ s/\0+//g;
+ if ($read eq "") {
+ $str = sprintf("%s:%d:%d: ", $param{ircUser}, $bot_pid, time());
+ } else {
+ $str = $read ."||". $str;
}
- if (!shmwrite($key,$str,$position,$size)) {
+ if (!shmwrite($key, $str, $position, $size)) {
+ &DEBUG("shmWrite($key, $str)");
&ERROR("shmWrite: failed: $!");
}
}
return 0;
}
- &DEBUG("forked => ".scalar(keys %forked) );
-
foreach (keys %forked) {
- my $time = time() - $forked{$_}{Time};
+ my $n = $_;
+ my $time = time() - $forked{$n}{Time};
next unless ($time > $forker_timeout);
### TODO: use &time2string()?
- &WARN("Fork: looks like we lost '$_', executed $time ago.");
- delete $forked{$_};
+ &WARN("Fork: looks like we lost '$n', executed $time ago");
+
+ my $pid = $forked{$n}{PID};
+ if (!defined $pid) {
+ &WARN("Fork: no pid for $n.");
+ delete $forked{$n};
+ next;
+ }
+
+ if ($pid == $bot_pid) {
+ # don't kill parent, just warn.
+ &status("Fork: pid == \$bot_pid == \$\$ ($bot_pid)");
+
+ } elsif ( -d "/proc/$pid") { # pid != bot_pid.
+ &status("Fork: killing $name ($pid)");
+ kill 9, $pid;
+ }
+
+ delete $forked{$n};
}
my $count = 0;
if ($count > 3) { # 3 seconds.
my $list = join(', ', keys %forked);
if (defined $who) {
- &msg($who, "already running ($list) => exceeded allowed forked processes count (1?).");
+ &msg($who, "exceeded allowed forked count (shm $shm): $list");
} else {
- &status("Fork: I ran too many forked processes :) Giving up $name.");
+ &status("Fork: I ran too many forked processes :) Giving up $name. Shm: $shm");
}
+
return 0;
}
$count++;
}
- if (exists $forked{$name}) {
+ if (exists $forked{$name} and !scalar keys %{ $forked{$name} }) {
+ &WARN("addF: forked{$name} exists but is empty; deleting.");
+ undef $forked{$name};
+ }
+
+ if (exists $forked{$name} and scalar keys %{ $forked{$name} }) {
my $time = $forked{$name}{Time};
my $continue = 0;
- if (-d "/proc/$forked{$name}{PID}") {
+ $continue++ if ($forked{$name}{PID} == $$);
+
+ if ($continue) {
+ &WARN("hrm.. fork pid == mypid == $$; how did this happen?");
+
+ } elsif ( -d "/proc/$forked{$name}{PID}") {
&status("fork: still running; good. BAIL OUT.");
+ return 0;
+
} else {
&WARN("Found dead fork; removing and resetting.");
$continue = 1;
if ($continue) {
# NOTHING.
+
} elsif (time() - $time > 900) { # stale fork > 15m.
&status("forked: forked{$name} presumably exited without notifying us.");
+
} else { # fresh fork.
&msg($who, "$name is already running ". &Time2String(time() - $time));
return 0;
}
$forked{$name}{Time} = time();
+ $forked{$name}{PID} = $$;
$forkedtime = time();
$count{'Fork'}++;
return 1;
POSIX::_exit(0);
}
+ if ($name =~ /\.pl/) {
+ &WARN("dF: name is name of source file ($name). FIX IT!");
+ }
+
&showProc(); # just for informational purposes.
if (exists $forked{$name}) {
POSIX::_exit(0);
}
+sub shmFlush {
+ return if ($$ != $::bot_pid); # fork protection.
+
+ if (@_) {
+ &ScheduleThis(15, "shmFlush");
+ return if ($_[0] eq "2");
+ }
+
+ my $time;
+ my $shmmsg = &shmRead($shm);
+ # remove padded \0's.
+ $shmmsg =~ s/\0//g;
+ return if (length($shmmsg) == 0);
+ if ($shmmsg =~ s/^(\S+):(\d+):(\d+): //) {
+ my $n = $1;
+ my $pid = $2;
+ $time = $3;
+ } else {
+ &status("warn: shmmsg='$shmmsg'.");
+ return;
+ }
+
+ foreach (split '\|\|', $shmmsg) {
+ next if (/^$/);
+ &VERB("shm: Processing '$_'.",2);
+
+ if (/^DCC SEND (\S+) (\S+)$/) {
+ my ($nick,$file) = ($1,$2);
+ if (exists $dcc{'SEND'}{$who}) {
+ &msg($nick, "DCC already active.");
+ } else {
+ &DEBUG("shm: dcc sending $2 to $1.");
+ $conn->new_send($1,$2);
+ $dcc{'SEND'}{$who} = time();
+ }
+ } elsif (/^SET FORKPID (\S+) (\S+)/) {
+ $forked{$1}{PID} = $2;
+ } elsif (/^DELETE FORK (\S+)$/) {
+ delete $forked{$1};
+ } elsif (/^EVAL (.*)$/) {
+ &DEBUG("evaling '$1'.");
+ eval $1;
+ } else {
+ &DEBUG("shm: unknown msg. ($_)");
+ }
+ }
+
+ &shmWrite($shm,"") if ($shmmsg ne "");
+}
+
1;