src/Shm.pl

   1 #
   2 #   Shm.pl: Shared Memory stuff.
   3 #    Author: dms
   4 #   Version: 20000201
   5 #   Created: 20000124
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub openSHM {
  11     my $IPC_PRIVATE = 0;
  12     my $size = 2000;
  13
  14     if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
  15         &status("Created shared memory (shm) key: [$_]");
  16         return $_;
  17     } else {
  18         &ERROR("openSHM: failed.");
  19         &ERROR("Please delete some shared memory with ipcs or ipcrm.");
  20         exit 1;
  21     }
  22 }
  23
  24 sub closeSHM {
  25     my ($key) = @_;
  26     my $IPC_RMID = 0;
  27
  28     &shmFlush();
  29     &status("Closed shared memory (shm) key: [$key]");
  30     return shmctl($key, $IPC_RMID, 0);
  31 }
  32
  33 sub shmRead {
  34     my ($key) = @_;
  35     my $position = 0;
  36     my $size = 3*80;
  37     my $retval = '';
  38
  39     if (shmread($key,$retval,$position,$size)) {
  40         return $retval;
  41     } else {
  42         &ERROR("shmRead: failed: $!");
  43         return '';
  44     }
  45 }
  46
  47 sub shmWrite {
  48     my ($key, $str) = @_;
  49     my $position = 0;
  50     my $size = 80*3;
  51
  52     # NULL hack.
  53     ### TODO: create shmClear to deal with this.
  54     if ($str !~ /^$/) {
  55         my $read = &shmRead($key);
  56         $read =~ s/\0+//g;
  57         $str = $read ."||". $str if ($read ne "");
  58     }
  59
  60     if (!shmwrite($key,$str,$position,$size)) {
  61         &ERROR("shmWrite: failed: $!");
  62     }
  63 }
  64
  65 #######
  66 # Helpers
  67 #
  68
  69 # Usage: &addForked($name);
  70 # Return: 1 for success, 0 for failure.
  71 sub addForked {
  72     my ($name) = @_;
  73     my $forker_timeout  = 360;  # 6mins, in seconds.
  74
  75     foreach (keys %forked) {
  76         my $time = time() - $forked{$_};
  77         next unless ($time > $forker_timeout);
  78
  79         ### TODO: use &time2string()?
  80         &WARN("Fork: looks like we lost '$_', executed $time ago.");
  81         delete $forked{$_};
  82     }
  83
  84     my $count = 0;
  85     while (scalar keys %forked > 2) {   # 2 or more == fail.
  86         sleep 1;
  87
  88         if ($count > 3) {       # 3 seconds.
  89             my $list = join(', ', keys %forked);
  90             if (defined $who) {
  91                 &msg($who, "already running ($list) => exceeded allowed forked processes count (1?).");
  92             } else {
  93                 &status("Fork: I ran too many forked processes :) Giving up $name.");
  94             }
  95             return 0;
  96         }
  97
  98         $count++;
  99     }
 100
 101     if (exists $forked{$name}) {
 102         my $time = $forked{$name};
 103         if (time() - $forked{$name} > 900) {    # stale fork > 15m.
 104             &status("forked: forked{$name} presumably exited without notifying us.");
 105             $forked{$name} = time();
 106             return 1;
 107         } else {                                # fresh fork.
 108             &msg($who, "$name is already running ". &Time2String(time() - $forked{$name}));
 109             return 0;
 110         }
 111     } else {
 112         $forked{$name}  = time();
 113         $forkedtime     = time();
 114         $count{'Fork'}++;
 115         return 1;
 116     }
 117 }
 118
 119 sub delForked {
 120     my ($name) = @_;
 121
 122     if (exists $forked{$name}) {
 123         my $timestr = &Time2String(time() - $forked{$name});
 124         &status("fork: took $timestr for $name.");
 125         &shmWrite($shm,"DELETE FORK $name");
 126         return 1;
 127     } else {
 128         &ERROR("delForked: forked{$name} does not exist. should not happen.");
 129         return 0;
 130     }
 131 }
 132
 133 1;