2 # Shm.pl: Shared Memory stuff.
18 if (&IsParam("noSHM")) {
19 &status("Shared memory: Disabled. WARNING: bot may become unreliable");
23 if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
24 &status("Created shared memory (shm) key: [$_]");
25 $shm_keys{$_} = {time => time,
31 &ERROR("openSHM: failed.");
32 &ERROR("Please delete some shared memory with ipcs or ipcrm.");
41 return '' if (!defined $key);
44 &status("Closed shared memory (shm) key: [$key]");
45 return shmctl($key, $IPC_RMID, 0);
54 return '' if (&IsParam("noSHM"));
56 if (shmread($key,$retval,$position,$size)) {
57 #&DEBUG("shmRead($key): $retval");
60 &ERROR("shmRead: failed: $!");
61 if (exists $shm_keys{$_}) {
64 ### TODO: if this fails, never try again.
65 # What use is opening a SHM segment if we're not going to read it?
76 return if (&IsParam("noSHM"));
78 $shm_keys{$keys}{accessed} = 1;
80 if (length($str) > $size) {
81 &status("ERROR: length(str) (..)>$size...");
85 if (length($str) == 0) {
86 # does $size overwrite the whole lot?
87 # if not, set to 2000.
88 if (!shmwrite($key, '', $position, $size)) {
89 &ERROR("shmWrite: failed: $!");
94 my $read = &shmRead($key);
97 $str = sprintf("%s:%d:%d: ", $param{ircUser}, $bot_pid, time());
99 $str = $read ."||". $str;
102 if (!shmwrite($key, $str, $position, $size)) {
103 &DEBUG("shmWrite($key, $str)");
104 &ERROR("shmWrite: failed: $!");
112 # Usage: &addForked($name);
113 # Return: 1 for success, 0 for failure.
116 my $forker_timeout = 360; # 6mins, in seconds.
119 if (!defined $name) {
120 &WARN("addForked: name == NULL.");
124 foreach (keys %forked) {
126 my $time = time() - $forked{$n}{Time};
127 next unless ($time > $forker_timeout);
129 ### TODO: use &time2string()?
130 &WARN("Fork: looks like we lost '$n', executed $time ago");
132 my $pid = $forked{$n}{PID};
134 &WARN("Fork: no pid for $n.");
139 if ($pid == $bot_pid) {
140 # don't kill parent, just warn.
141 &status("Fork: pid == \$bot_pid == \$\$ ($bot_pid)");
143 } elsif ( -d "/proc/$pid") { # pid != bot_pid.
144 &status("Fork: killing $name ($pid)");
152 while (scalar keys %forked > 1) { # 2 or more == fail.
155 if ($count > 3) { # 3 seconds.
156 my $list = join(', ', keys %forked);
158 &msg($who, "exceeded allowed forked count (shm $shm): $list");
160 &status("Fork: I ran too many forked processes :) Giving up $name. Shm: $shm");
169 if (exists $forked{$name} and !scalar keys %{ $forked{$name} }) {
170 &WARN("addF: forked{$name} exists but is empty; deleting.");
171 undef $forked{$name};
174 if (exists $forked{$name} and scalar keys %{ $forked{$name} }) {
175 my $time = $forked{$name}{Time};
178 $continue++ if ($forked{$name}{PID} == $$);
181 &WARN("hrm.. fork pid == mypid == $$; how did this happen?");
183 } elsif ( -d "/proc/$forked{$name}{PID}") {
184 &status("fork: still running; good. BAIL OUT.");
188 &WARN("Found dead fork; removing and resetting.");
195 } elsif (time() - $time > 900) { # stale fork > 15m.
196 &status("forked: forked{$name} presumably exited without notifying us.");
198 } else { # fresh fork.
199 &msg($who, "$name is already running ". &Time2String(time() - $time));
204 $forked{$name}{Time} = time();
205 $forked{$name}{PID} = $$;
206 $forkedtime = time();
214 return if ($$ == $bot_pid);
216 if (!defined $name) {
217 &WARN("delForked: name == NULL.");
221 if ($name =~ /\.pl/) {
222 &WARN("dF: name is name of source file ($name). FIX IT!");
225 &showProc(); # just for informational purposes.
227 if (exists $forked{$name}) {
228 my $timestr = &Time2String(time() - $forked{$name}{Time});
229 &status("fork: took $timestr for $name.");
230 &shmWrite($shm,"DELETE FORK $name");
232 &ERROR("delForked: forked{$name} does not exist. should not happen.");
235 &status("--- fork finished for '$name' ---");
241 return if ($$ != $::bot_pid); # fork protection.
244 &ScheduleThis(15, "shmFlush");
245 return if ($_[0] eq "2");
249 my $shmmsg = &shmRead($shm);
250 # remove padded \0's.
252 return if (length($shmmsg) == 0);
253 if ($shmmsg =~ s/^(\S+):(\d+):(\d+): //) {
258 &status("warn: shmmsg='$shmmsg'.");
262 foreach (split '\|\|', $shmmsg) {
264 &VERB("shm: Processing '$_'.",2);
266 if (/^DCC SEND (\S+) (\S+)$/) {
267 my ($nick,$file) = ($1,$2);
268 if (exists $dcc{'SEND'}{$who}) {
269 &msg($nick, "DCC already active.");
271 &DEBUG("shm: dcc sending $2 to $1.");
272 $conn->new_send($1,$2);
273 $dcc{'SEND'}{$who} = time();
275 } elsif (/^SET FORKPID (\S+) (\S+)/) {
276 $forked{$1}{PID} = $2;
277 } elsif (/^DELETE FORK (\S+)$/) {
279 } elsif (/^EVAL (.*)$/) {
280 &DEBUG("evaling '$1'.");
283 &DEBUG("shm: unknown msg. ($_)");
287 &shmWrite($shm,"") if ($shmmsg ne "");