src/Shm.pl

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