# Copyright (C) 2004, 2006 Alex Schroeder # 2004 Sebastian Blatt # # 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 2 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, write to the # Free Software Foundation, Inc. # 59 Temple Place, Suite 330 # Boston, MA 02111-1307 USA # Limits the number of parallel Oddmuse instances to # $InstanceThrottleLimit by keeping track of the process ids in # $InstanceThrottleDir $ModulesDescription .= '

$Id: throttle.pl,v 1.6 2006/10/21 18:51:40 as Exp $

'; use vars qw($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; }