Další zajímavou ukázkou toho, co lze pomocí hooků v Radiatoru dokázat, je tento skript který je nasazen na národním RADIUS serveru.

Skript opravuje chybu, kdy v Access-Accept paketu je jen uživatelské jméno a nikoliv realm. To spůsobí, že všechna AP, která respektují RFC 2865, pak posílají accounting bez realmu, skript v případě potřeby doplňuje hodnotu User-Name v Access-Accept paketu o realm. Je známo že tímto problémem trpí některé instalace FreeRadiusu.

# $Id: patch_accounting.pl,v 1.1 2006/02/27 13:14:46 semik Exp $
 
sub {
  my $p = ${$_[0]};   # proxy reply packet (Access-Accepted received from the HI)
  my $rp = ${$_[1]};  # reply packet to NAS (Access-Acceped to be sent to the VI)
  my $op = ${$_[2]};  # original request packet (Access-Request produced in the VI)
  my $sp = ${$_[3]};  # packet sent to proxy (we don't need this one)
 
  my $inner_ident;
  my $outer_ident;
 
  my $outer_user;
  my $outer_realm;
  my $inner_user;
  my $inner_realm;
 
  # only triggers for access-accepted packets
  if ($p->code eq 'Access-Accept') {
    $outer_ident = $op->get_attr('User-Name');
    $inner_ident = $p->get_attr('User-Name');
 
    # we only need to check if the reply packet includes one new user-name
    if ($inner_ident) {
      &main::log($main::LOG_DEBUG, "patch-accounting.pl: OuterIdent = $outer_ident; InnerIdent = $inner_ident");
 
      if ($outer_ident !~ /^(.+)\@(.+)$/) {
        # The Outer User-Name attribute is not in <user>@<realm> form
        # This isn't supposed to happen. With bad outher identity the
        # packet should not reach the proxy and should not reach a
        # access-accepted stage but... you never now :)
 
        &main::log($main::LOG_DEBUG, "patch-accounting.pl: Bad Outer Identity - REJECTING");
        $$op = $main::REJECT;
        return;
      }
 
      &main::log($main::LOG_DEBUG, "patch-accounting.pl: Outer Identity OK");
      $outer_user = $1; $outer_realm = $2;
 
      if ($inner_ident =~ /(.+)\@(.+)$/) {
        $inner_user = $1; $inner_realm = $2;
 
        if ($outer_realm ne $inner_realm) {
          # the inner user-name's realm does not match the outer identity realm
          # Action: change the realm from the user-name attr to the outer realm
 
          my $newuser = "$inner_user\@$outer_realm";
 
          &main::log($main::LOG_DEBUG,
                     "patch-accounting.pl: WARNING: Inner Realm <> Outer Realm, ".
                     "patching User-Name: $inner_ident => $newuser");
          $rp->change_attr('User-Name', $newuser);
        } else {
          #&main::log($main::LOG_DEBUG, "patch-accounting.pl: Inner Identity OK");
        };
      } else {
        # the returned User-Name attribute is not in <user>@<realm> form
        # Action: delete the returned attribute
 
        # Semik: I don't agree! I think we sould simply add realm to
        # inner identity.
 
        my $newuser = "$inner_ident\@$outer_realm";
 
        &main::log($main::LOG_DEBUG, "patch-accounting.pl: WARNING: Inner identity ".
                   "without realm, patching User-Name by outer realm: $inner_ident => $newuser");
        $rp->change_attr('User-Name', $newuser);
      };
    } else {
      # the access-accepted packet does not have a Use-Name attribute
      # (notheing should be done - just log it?)
 
      # Semik: How about patching packet with have no inner identity?
      # How they looks in accouning?
 
      &main::log($main::LOG_DEBUG, "No Inner Identity for $outer_ident");
    };
  };
 
  return;
};

— Jan Tomášek 15.09.2006 13:49 dokument převeden z www.eduroam.cz