2 # Shm.pl: Shared Memory stuff.
8 if (&IsParam("useStrict")) { use strict; }
16 if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
17 &status("Created shared memory (shm) key: [$_]");
20 &ERROR("openSHM: failed.");
21 &ERROR("Please delete some shared memory with ipcs or ipcrm.");
30 return '' if (!defined $key);
33 &status("Closed shared memory (shm) key: [$key]");
34 return shmctl($key, $IPC_RMID, 0);
43 if (shmread($key,$retval,$position,$size)) {
46 &ERROR("shmRead: failed: $!");
47 ### TODO: if this fails, never try again.
59 ### TODO: create shmClear to deal with this.
61 my $read = &shmRead($key);
65 $str = time().": "; # time stamping, null.
66 } elsif ($read eq "") {
67 $str = time().": "; # timestamping.
69 $str = $read ."||". $str;
73 if (!shmwrite($key,$str,$position,$size)) {
74 &ERROR("shmWrite: failed: $!");
82 # Usage: &addForked($name);
83 # Return: 1 for success, 0 for failure.
86 my $forker_timeout = 360; # 6mins, in seconds.
90 &WARN("addForked: name == NULL.");
94 foreach (keys %forked) {
95 my $time = time() - $forked{$_}{Time};
96 next unless ($time > $forker_timeout);
98 ### TODO: use &time2string()?
99 &WARN("Fork: looks like we lost '$_', executed $time ago.");
104 while (scalar keys %forked > 1) { # 2 or more == fail.
107 if ($count > 3) { # 3 seconds.
108 my $list = join(', ', keys %forked);
110 &msg($who, "already running ($list) => exceeded allowed forked processes count (1?).");
112 &status("Fork: I ran too many forked processes :) Giving up $name.");
120 if (exists $forked{$name}) {
121 my $time = $forked{$name}{Time};
124 if (-d "/proc/$forked{$name}{PID}") {
125 &status("fork: still running; good. BAIL OUT.");
127 &WARN("Found dead fork; removing and resetting.");
133 } elsif (time() - $time > 900) { # stale fork > 15m.
134 &status("forked: forked{$name} presumably exited without notifying us.");
135 } else { # fresh fork.
136 &msg($who, "$name is already running ". &Time2String(time() - $time));
141 $forked{$name}{Time} = time();
142 $forkedtime = time();
150 return if ($$ == $bot_pid);
152 if (!defined $name) {
153 &WARN("delForked: name == NULL.");
157 &showProc(); # just for informational purposes.
159 if (exists $forked{$name}) {
160 my $timestr = &Time2String(time() - $forked{$name}{Time});
161 &status("fork: took $timestr for $name.");
162 &shmWrite($shm,"DELETE FORK $name");
164 &ERROR("delForked: forked{$name} does not exist. should not happen.");
167 &status("--- fork finished for '$name' ---");