In order to remove some faked attributes, I would have found a
PostProcessingHook useful, and added it since it wasn't there
already. The patch against Radiator-2.18 is appended so that it might
be considered for inclusion in the next release.
The documentation for this:
6.15.x PostProcessingHook</H4>
<P CLASS="BodyAfterHead">
<A NAME="pgfId=398636">
</A>
This optional parameter allows you to define a Perl function that will be called
during packet processing. PostProcessingHook is called for each reply immediately
before it is sent to the client, after all PostAuthHooks and after log files are
written. A reference to the current request is passed as the first arg
ument, and a reference to the reply packet is passed as the second argument.</P>
[... code is compiled ...]
PostProcessingHook can be an arbitrarily complicated Perl function, that might run
external processes, consult databases, change the contents of the current reply or
many other things.</P>
<PRE CLASS="Code"><A NAME="pgfId=398639"> </A>
# Remove a faked attribute from the reply
PostProcessingHook sub { ${$_[1]}->delete_attr(`My-Realm');}</PRE>
diff -r -c Radiator-2.18/Radius/Handler.pm
Radiator-2.18.postprocessinghook/Radius/Handler.pm
*** Radiator-2.18/Radius/Handler.pm Fri Mar 9 00:13:12 2001
--- Radiator-2.18.postprocessinghook/Radius/Handler.pm Mon Apr 9 20:26:51 2001
***************
*** 116,121 ****
--- 116,122 ----
'SessionDatabase' => 'string',
'HandleAscendAccessEventRequest' => 'flag',
'PreProcessingHook' => 'hook',
+ 'PostProcessingHook' => 'hook',
'PreAuthHook' => 'hook',
'PostAuthHook' => 'hook',
'RewriteFunction' => 'hook') && return 1;
***************
*** 506,511 ****
--- 507,513 ----
{
my ($self, $p, $rp, $handled, $reason) = @_;
+ my $do_reply = 0;
if ($p->code eq 'Access-Request')
{
my $name = $p->getUserName;
***************
*** 514,520 ****
&main::log($main::LOG_DEBUG, "Access accepted for $name");
$self->authlog($main::ACCEPT, '', $p, $rp);
$rp->set_code('Access-Accept');
! $p->{Client}->replyTo($rp, $p);
}
elsif ($handled == $main::REJECT
|| $handled == $main::REJECT_IMMEDIATE)
--- 516,522 ----
&main::log($main::LOG_DEBUG, "Access accepted for $name");
$self->authlog($main::ACCEPT, '', $p, $rp);
$rp->set_code('Access-Accept');
! $do_reply = 1;
}
elsif ($handled == $main::REJECT
|| $handled == $main::REJECT_IMMEDIATE)
***************
*** 525,538 ****
$rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE,
$self->{RejectHasReason} ?
$reason : 'Request Denied');
!
! $p->{Client}->replyTo($rp, $p);
}
elsif ($handled == $main::CHALLENGE)
{
&main::log($main::LOG_DEBUG, "Access challenged for $name: $reason");
$rp->set_code('Access-Challenge');
! $p->{Client}->replyTo($rp, $p);
}
else
{
--- 527,539 ----
$rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE,
$self->{RejectHasReason} ?
$reason : 'Request Denied');
! $do_reply = 1;
}
elsif ($handled == $main::CHALLENGE)
{
&main::log($main::LOG_DEBUG, "Access challenged for $name: $reason");
$rp->set_code('Access-Challenge');
! $do_reply = 1;
}
else
{
***************
*** 559,565 ****
{
&main::log($main::LOG_DEBUG, "Accounting accepted");
$rp->set_code('Accounting-Response');
! $p->{Client}->replyTo($rp, $p);
}
elsif ($handled == $main::IGNORE)
{
--- 560,566 ----
{
&main::log($main::LOG_DEBUG, "Accounting accepted");
$rp->set_code('Accounting-Response');
! $do_reply = 1;
}
elsif ($handled == $main::IGNORE)
{
***************
*** 574,590 ****
{
&main::log($main::LOG_DEBUG, "Disconnect-Request accepted");
$rp->set_code('Disconnect-Request-ACKed');
! $p->{Client}->replyTo($rp, $p);
}
elsif ($handled == $main::REJECT
|| $handled == $main::REJECT_IMMEDIATE)
{
&main::log($main::LOG_INFO, "Disconnect-Request rejected: $reason");
$rp->set_code('Disconnect-Request-NAKed');
! $p->{Client}->replyTo($rp, $p);
}
}
# Ignore anything else
}
#####################################################################
--- 575,605 ----
{
&main::log($main::LOG_DEBUG, "Disconnect-Request accepted");
$rp->set_code('Disconnect-Request-ACKed');
! $do_reply = 1;
}
elsif ($handled == $main::REJECT
|| $handled == $main::REJECT_IMMEDIATE)
{
&main::log($main::LOG_INFO, "Disconnect-Request rejected: $reason");
$rp->set_code('Disconnect-Request-NAKed');
! $do_reply = 1;
}
}
# Ignore anything else
+ # send reply if requested
+ if ($do_reply) {
+ # Call the PostProcessingHook, if there is one
+ if (defined $self->{PostProcessingHook})
+ {
+ # We use an eval so an error in the hook wont
+ # kill us.
+ eval{ &{$self->{PostProcessingHook}}(\$p, \$rp); };
+ &main::log($main::LOG_ERR,
+ "Error in PostProcessingHook(): $@")
+ if $@;
+ }
+ $p->{Client}->replyTo($rp, $p);
+ }
}
#####################################################################
