forked from github/kensanata.oddmuse
f230a64e7d
There were some modules that did not offer "or (at your option) any later version" in their license and these had to be left alone. This should solve the incorrect FSF address issue #4 on GitHub.
82 lines
2.7 KiB
Perl
82 lines
2.7 KiB
Perl
# Copyright (C) 2004, 2006 Alex Schroeder <alex@emacswiki.org>
|
|
# 2004 Sebastian Blatt <sblatt@havens.de>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
# Limits the number of parallel Oddmuse instances to
|
|
# $InstanceThrottleLimit by keeping track of the process ids in
|
|
# $InstanceThrottleDir
|
|
|
|
use strict;
|
|
use v5.10;
|
|
|
|
AddModuleDescription('throttle.pl', 'Limit Number Of Instances Running');
|
|
|
|
use File::Glob ':glob';
|
|
our ($q, $DataDir);
|
|
our ($InstanceThrottleDir, $InstanceThrottleLimit);
|
|
|
|
$InstanceThrottleDir = $DataDir."/pids"; # directory for pid files
|
|
$InstanceThrottleLimit = 2; # maximum number of parallel processes
|
|
|
|
*OldDoSurgeProtection = \&DoSurgeProtection;
|
|
*DoSurgeProtection = \&NewDoSurgeProtection;
|
|
|
|
*OldDoBrowseRequest = \&DoBrowseRequest;
|
|
*DoBrowseRequest = \&NewDoBrowseRequest;
|
|
|
|
sub NewDoSurgeProtection {
|
|
DoInstanceThrottle();
|
|
CreatePidFile();
|
|
OldDoSurgeProtection();
|
|
}
|
|
|
|
sub NewDoBrowseRequest {
|
|
OldDoBrowseRequest();
|
|
RemovePidFile();
|
|
}
|
|
|
|
# limit the script to a maximum of $InstanceThrottleLimit instances
|
|
sub DoInstanceThrottle {
|
|
my @pids = Glob($InstanceThrottleDir."/*");
|
|
# Go over all pids: validate each pid by sending signal 0, unlink
|
|
# pidfile if pid does not exist and return 0. Count the number of
|
|
# zeros (= removed files = zombies) with grep.
|
|
my $zombies = grep /^0$/,
|
|
(map {/(\d+)$/ and kill 0,$1 or Unlink($_) and 0} @pids);
|
|
if (scalar(@pids)-$zombies >= $InstanceThrottleLimit) {
|
|
ReportError(Ts('Too many instances. Only %s allowed.',
|
|
$InstanceThrottleLimit),
|
|
'503 Service Unavailable',
|
|
undef,
|
|
$q->p(T('Please try again later. Perhaps somebody is running maintenance or doing a long search. Unfortunately the site has limited resources, and so we must ask you for a bit of patience.')));
|
|
}
|
|
}
|
|
|
|
sub CreatePidFile {
|
|
CreateDir($InstanceThrottleDir);
|
|
my $data = $q->request_method . ' ' . $q->url(-path_info=>1) . "\n";
|
|
foreach my $param ($q->param) {
|
|
next if $param eq 'pwd';
|
|
$data .= "Param " . $param . "=" . $q->param($param) . "\n";
|
|
}
|
|
WriteStringToFile("$InstanceThrottleDir/$$", $data);
|
|
}
|
|
|
|
sub RemovePidFile {
|
|
my $file = "$InstanceThrottleDir/$$";
|
|
# not fatal
|
|
Unlink($file);
|
|
}
|