X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FShm.pl;h=efdfced295665d79c98598e3a26facd549272e38;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=b978a3af22e633db9985f77a2584ec01a0527f82;hpb=75f2b19595115590279956a176b7a35fd0b5df77;p=infobot.git diff --git a/src/Shm.pl b/src/Shm.pl index b978a3a..efdfced 100644 --- a/src/Shm.pl +++ b/src/Shm.pl @@ -5,12 +5,19 @@ # Created: 20000124 # -if (&IsParam("useStrict")) { use strict; } +# use strict; # TODO + +use POSIX qw(_exit); sub openSHM { 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 $_; @@ -25,6 +32,9 @@ sub closeSHM { my ($key) = @_; my $IPC_RMID = 0; + return '' if (!defined $key); + + &shmFlush(); &status("Closed shared memory (shm) key: [$key]"); return shmctl($key, $IPC_RMID, 0); } @@ -35,10 +45,15 @@ sub shmRead { 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 ''; } } @@ -48,85 +63,216 @@ sub shmWrite { 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{ircNick}, $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: $!"); } } -####### -# Helpers -# +############## +### Helpers +### # Usage: &addForked($name); # Return: 1 for success, 0 for failure. sub addForked { - my ($name) = @_; + my ($name) = @_; my $forker_timeout = 360; # 6mins, in seconds. + $forker = $name; + + if (!defined $name) { + &WARN("addForked: name == NULL."); + return 0; + } foreach (keys %forked) { - my $time = time() - $forked{$_}; + 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; - while (scalar keys %forked > 2) { # 2 or more == fail. + while (scalar keys %forked > 1) { # 2 or more == fail. sleep 1; 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}) { - my $time = $forked{$name}; - if (time() - $forked{$name} > 900) { # stale fork > 15m. + 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; + + $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."); - $forked{$name} = time(); - return 1; + } else { # fresh fork. - &msg($who, "$name is already running ". &Time2String(time() - $forked{$name})); + &msg($who, "$name is already running ". &Time2String(time() - $time)); return 0; } - } else { - $forked{$name} = time(); - $forkedtime = time(); - $count{'Fork'}++; - return 1; } + + $forked{$name}{Time} = time(); + $forked{$name}{PID} = $$; + $forkedtime = time(); + $count{'Fork'}++; + return 1; } sub delForked { - my ($name) = @_; + my ($name) = @_; + + return if ($$ == $bot_pid); + + if (!defined $name) { + &WARN("delForked: name == NULL."); + 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}) { - my $timestr = &Time2String(time() - $forked{$name}); + my $timestr = &Time2String(time() - $forked{$name}{Time}); &status("fork: took $timestr for $name."); &shmWrite($shm,"DELETE FORK $name"); - return 1; } else { &ERROR("delForked: forked{$name} does not exist. should not happen."); - return 0; } + + &status("--- fork finished for '$name' ---"); + + POSIX::_exit(0); +} + +sub shmFlush { + return if ($$ != $::bot_pid); # fork protection. + + if (@_) { + &ScheduleThis(5, "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;