Rework WebGUI::PerformanceProfiler to only calculate and show output

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

View file

@ -3,6 +3,7 @@
- fixed: deploying a package doesn't commit version tag with autocommit on - fixed: deploying a package doesn't commit version tag with autocommit on
- fixed rfe #76: group delete causes problems - fixed rfe #76: group delete causes problems
- fixed #10526: icalInterval in Calendar.pm - fixed #10526: icalInterval in Calendar.pm
- fixed: displaying performance profile data only to an allowed IP address.
7.7.10 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) - 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)

View file

@ -57,12 +57,14 @@ PerlSetVar whatToProfile WebGUI::Asset::Wobject
use strict; use strict;
use Time::HiRes qw(time); use Time::HiRes qw(time);
use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND); use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND);
use Apache2::Connection;
use Apache2::ServerUtil; use Apache2::ServerUtil;
use Apache2::Filter; use Apache2::Filter;
use Apache2::FilterRec; use Apache2::FilterRec;
use Apache2::RequestIO; use Apache2::RequestIO;
use Apache2::RequestRec; use Apache2::RequestRec;
use ModPerl::Util; use ModPerl::Util;
use Net::Subnets;
my @subTimes = (); my @subTimes = ();
my $depth = 0; my $depth = 0;
@ -77,12 +79,14 @@ For all other calls, adds profiler output to the file.
=cut =cut
sub handler { 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(); my $callback = ModPerl::Util::current_callback();
if($callback eq 'PerlChildInitHandler') { if($callback eq 'PerlChildInitHandler') {
return addProfilerCode(); return addProfilerCode();
} else { } else {
return output($r); return output($object);
} }
} }
@ -115,6 +119,18 @@ sub addProfilerCode {
sub output { sub output {
my $f = shift; my $f = shift;
return Apache2::Const::DECLINED unless($f->r->content_type =~ 'text/html'); 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)) { while($f->read(my $buffer, 1024)) {
my $content .= $buffer; my $content .= $buffer;
if ($content =~ /(<\/body)/i) { if ($content =~ /(<\/body)/i) {