====== Skript patch_accounting.pl ======

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í [[http://www.faqs.org/rfcs/rfc2865.html|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.

<code perl>
# $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;
};
</code>

======  ======
 --- //[[http://staff.cesnet.cz/~semik|Jan Tomášek]] 15.09.2006 13:49// dokument převeden z www.eduroam.cz