oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rework WebGUI::PerformanceProfiler to only calculate and show output

Browse source 
to a certain IP address.
This commit is contained in:
Colin Kuskie 2009-06-15 22:32:59 +00:00
parent d710fde1f2
commit 7cfc771354
2 changed files with 19 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

1
docs/changelog/7.x.x.txt
View file

@ -3,6 +3,7 @@
- fixed: deploying a package doesn't commit version tag with autocommit on
- fixed rfe #76: group delete causes problems
- fixed #10526: icalInterval in Calendar.pm
- fixed: displaying performance profile data only to an allowed IP address.
7.7.10
- Made a change to LDAP auth that adds an OR to that query so that it also searches for a row with fieldData REGEXP '^uid=(value-from-ldap-directory-server),'. (Wes Morgan)

20
lib/WebGUI/PerformanceProfiler.pm
View file

@ -57,12 +57,14 @@ PerlSetVar whatToProfile WebGUI::Asset::Wobject
use strict;
use Time::HiRes qw(time);
use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND);
use Apache2::Connection;
use Apache2::ServerUtil;
use Apache2::Filter;
use Apache2::FilterRec;
use Apache2::RequestIO;
use Apache2::RequestRec;
use ModPerl::Util;
use Net::Subnets;
my @subTimes = ();
my $depth = 0;
@ -77,12 +79,14 @@ For all other calls, adds profiler output to the file.
=cut
sub handler {
my $r = shift;
##This method does double duty as a ChildInitHandler and as an Output filter.
##therefore we don't know what kind of object we get.
my $object = shift;
my $callback = ModPerl::Util::current_callback();
if($callback eq 'PerlChildInitHandler') {
return addProfilerCode();
} else {
return output($r);
return output($object);
}
}
@ -115,6 +119,18 @@ sub addProfilerCode {
sub output {
my $f = shift;
return Apache2::Const::DECLINED unless($f->r->content_type =~ 'text/html');
my $server = Apache2::ServerUtil->server;
my $sn = $server->dir_config('ProfileSubnet');
my $subnet = [ $sn ];
if ($sn) {
my $conn = $f->c;
my $ipAddress = $conn->remote_ip;
my $net = Net::Subnets->new();
$net->subnets($subnet);
if (!$net->check(\$ipAddress)) {
return Apache2::Const::DECLINED;
}
}
while($f->read(my $buffer, 1024)) {
my $content .= $buffer;
if ($content =~ /(<\/body)/i) {