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: [$_]");
33 &ERROR('openSHM: failed.');
34 &ERROR('Please delete some shared memory with ipcs or ipcrm.');
43 return '' if ( !defined $key );
46 &status("Closed shared memory (shm) key: [$key]");
47 return shmctl( $key, $IPC_RMID, 0 );
56 return '' if ( &IsParam('noSHM') );
58 if ( shmread( $key, $retval, $position, $size ) ) {
60 #&DEBUG("shmRead($key): $retval");
64 &ERROR("shmRead: failed: $!");
65 if ( exists $shm_keys{$_} ) {
68 ### TODO: if this fails, never try again.
69 # What use is opening a SHM segment if we're not going to read it?
76 my ( $key, $str ) = @_;
80 return if ( &IsParam('noSHM') );
82 $shm_keys{$keys}{accessed} = 1;
84 if ( length($str) > $size ) {
85 &status("ERROR: length(str) (..)>$size...");
89 if ( length($str) == 0 ) {
91 # does $size overwrite the whole lot?
92 # if not, set to 2000.
93 if ( !shmwrite( $key, '', $position, $size ) ) {
94 &ERROR("shmWrite: failed: $!");
99 my $read = &shmRead($key);
102 $str = sprintf( '%s:%d:%d: ', $param{ircUser}, $bot_pid, time() );
105 $str = $read . '||' . $str;
108 if ( !shmwrite( $key, $str, $position, $size ) ) {
109 &DEBUG("shmWrite($key, $str)");
110 &ERROR("shmWrite: failed: $!");
118 # Usage: &addForked($name);
119 # Return: 1 for success, 0 for failure.
122 my $forker_timeout = 360; # 6mins, in seconds.
125 if ( !defined $name ) {
126 &WARN('addForked: name == NULL.');
130 foreach ( keys %forked ) {
132 my $time = time() - $forked{$n}{Time};
133 next unless ( $time > $forker_timeout );
135 ### TODO: use &time2string()?
136 &WARN("Fork: looks like we lost '$n', executed $time ago");
138 my $pid = $forked{$n}{PID};
139 if ( !defined $pid ) {
140 &WARN("Fork: no pid for $n.");
145 if ( $pid == $bot_pid ) {
147 # don't kill parent, just warn.
148 &status("Fork: pid == \$bot_pid == \$\$ ($bot_pid)");
151 elsif ( -d "/proc/$pid" ) { # pid != bot_pid.
152 &status("Fork: killing $name ($pid)");
160 while ( scalar keys %forked > 1 ) { # 2 or more == fail.
163 if ( $count > 3 ) { # 3 seconds.
164 my $list = join( ', ', keys %forked );
165 if ( defined $who ) {
166 &msg( $who, "exceeded allowed forked count (shm $shm): $list" );
170 "Fork: I ran too many forked processes :) Giving up $name. Shm: $shm"
180 if ( exists $forked{$name} and !scalar keys %{ $forked{$name} } ) {
181 &WARN("addF: forked{$name} exists but is empty; deleting.");
182 undef $forked{$name};
185 if ( exists $forked{$name} and scalar keys %{ $forked{$name} } ) {
186 my $time = $forked{$name}{Time};
189 $continue++ if ( $forked{$name}{PID} == $$ );
192 &WARN("hrm.. fork pid == mypid == $$; how did this happen?");
195 elsif ( -d "/proc/$forked{$name}{PID}" ) {
196 &status('fork: still running; good. BAIL OUT.');
201 &WARN('Found dead fork; removing and resetting.');
210 elsif ( time() - $time > 900 ) { # stale fork > 15m.
212 "forked: forked{$name} presumably exited without notifying us."
218 "$name is already running " . &Time2String( time() - $time ) );
223 $forked{$name}{Time} = time();
224 $forked{$name}{PID} = $$;
225 $forkedtime = time();
233 return if ( $$ == $bot_pid );
235 if ( !defined $name ) {
236 &WARN('delForked: name == NULL.');
240 if ( $name =~ /\.pl/ ) {
241 &WARN("dF: name is name of source file ($name). FIX IT!");
244 &showProc(); # just for informational purposes.
246 if ( exists $forked{$name} ) {
247 my $timestr = &Time2String( time() - $forked{$name}{Time} );
248 &status("fork: took $timestr for $name.");
249 &shmWrite( $shm, "DELETE FORK $name" );
252 &ERROR("delForked: forked{$name} does not exist. should not happen.");
255 &status("--- fork finished for '$name' ---");
261 return if ( $$ != $::bot_pid ); # fork protection.
264 &ScheduleThis( 15 * 60, 'shmFlush' ); # 15 minutes
265 return if ( $_[0] eq '2' );
269 my $shmmsg = &shmRead($shm);
271 # remove padded \0's.
273 return if ( length($shmmsg) == 0 );
274 if ( $shmmsg =~ s/^(\S+):(\d+):(\d+): // ) {
280 &status("warn: shmmsg='$shmmsg'.");
284 foreach ( split '\|\|', $shmmsg ) {
286 &VERB( "shm: Processing '$_'.", 2 );
288 if (/^DCC SEND (\S+) (\S+)$/) {
289 my ( $nick, $file ) = ( $1, $2 );
290 if ( exists $dcc{'SEND'}{$who} ) {
291 &msg( $nick, 'DCC already active.' );
294 &DEBUG("shm: dcc sending $2 to $1.");
295 $conn->new_send( $1, $2 );
296 $dcc{'SEND'}{$who} = time();
299 elsif (/^SET FORKPID (\S+) (\S+)/) {
300 $forked{$1}{PID} = $2;
302 elsif (/^DELETE FORK (\S+)$/) {
305 elsif (/^EVAL (.*)$/) {
306 &DEBUG("evaling '$1'.");
310 &DEBUG("shm: unknown msg. ($_)");
314 &shmWrite( $shm, '' ) if ( $shmmsg ne '' );
319 # vim:ts=4:sw=4:expandtab:tw=80