Very special handler

[Tobias Wagener]

Hello,

my config:
  Apache/2.2.16 (Debian) 
  mod_ssl/2.2.16 
  OpenSSL/0.9.8o 
  mod_apreq2-20090110/2.7.1 
  mod_perl/2.0.4 
  Perl/v5.10.1

I have a very large project based on mod_perl and sometimes a process
is running "wild". But I can't identify which one it is, because on my
development plattform this does not happend, only on the productive
system.

So I write a small handler (see below) which I init with
PerlChildInitHandler    Handler::SigUSR2->childInit
<VirtualHost ...>
  PerlTransHandler        Handler::SigUSR2->requestInit
</VirtualHost>

With this handler I can send a kill -USR2 <PID> to the apache2
process that's running "wild" and the sighandler writes the
URI to the apache error_log.

My question is now, if someone who knows linux/apache/mod_perl better
than me, can take a look at the handler and can tell me if this is
dangerous or time consuming. On my development system I can't regocnize
anything that took longer or so, but before transfering this code
to the productiv system I will be sure, that nothing can happen.

Or, perhaps, someone can tell me another way to get the request 
an apache process is currently handling.

Thanks for your help!

Regards Tobias

------------------------ code here ---------------------

package Handler::SigUSR2;

# Created: 2010-09-03 08:13:42
# SVN: $Id$

use strict;
use utf8;
use Apache2::RequestUtil;
use POSIX qw(SIGUSR2);

sub childInit {
  # Ignore SIGUSR2 by default
  my( $mask )   = POSIX::SigSet->new( SIGUSR2 );
  my( $action ) = POSIX::SigAction->new( sub{}, $mask );
  my( $old )    = POSIX::SigAction->new();
  POSIX::sigaction(SIGUSR2, $action, $old );
}

sub requestInit {
  # on request redirect SIGUSR2 to "requestCleanup"
  my( $type )   = shift;
  my( $req )    = shift;
  my( $self )   = bless [], $type;
  my( $mask )   = POSIX::SigSet->new( SIGUSR2 );
  my( $action ) = POSIX::SigAction->new(
              sub { $self->writeRequest(); }, $mask );
  my( $old )    = POSIX::SigAction->new();
  POSIX::sigaction(SIGUSR2, $action, $old );
  $req->push_handlers(PerlCleanupHandler => sub{ $self->requestCleanup });
  push( @$self, $req, $old );
  Apache2::Const::OK();
}

sub requestCleanup {
  # after request redirect SIGUSR2 to old "ignore" method
  my( $self ) = shift;
  POSIX::sigaction(SIGUSR2, $self->[1]);
  Apache2::Const::OK();
}

sub writeRequest {
  # print URI to STDERR
  # perhaps "args" or something can also be applied
  my( $self ) = shift;
  my( $req )  = $self->[0];
  printf STDERR "SIGUSR2[%s][%s]\n", $$, $req->uri;
}

1;