src/modules/rlm_perl/example.pl

   1 #  This program is free software; you can redistribute it and/or modify
   2 #  it under the terms of the GNU General Public License as published by
   3 #  the Free Software Foundation; either version 2 of the License, or
   4 #  (at your option) any later version.
   5 #
   6 #  This program is distributed in the hope that it will be useful,
   7 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   8 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   9 #  GNU General Public License for more details.
  10 #
  11 #  You should have received a copy of the GNU General Public License
  12 #  along with this program; if not, write to the Free Software
  13 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  14 #
  15 #  Copyright 2002  The FreeRADIUS server project
  16 #  Copyright 2002  Boian Jordanov <bjordanov@orbitel.bg>
  17 #
  18 #
  19 #You can use every module that comes with your perl distribution
  20
  21 use strict;
  22 # use ...
  23 # This is very important ! Without this script will not get the filled hashesh from main.
  24 use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
  25 use Data::Dumper;
  26
  27 # This is hash wich hold original request from radius
  28 #my %RAD_REQUEST;
  29 # In this hash you add values that will be returned to NAS.
  30 #my %RAD_REPLY;
  31 #This is for check items
  32 #my %RAD_CHECK;
  33
  34 #
  35 # This the remaping of return values
  36 #
  37         use constant    RLM_MODULE_REJECT=>    0;#  /* immediately reject the request */
  38         use constant    RLM_MODULE_FAIL=>      1;#  /* module failed, don't reply */
  39         use constant    RLM_MODULE_OK=>        2;#  /* the module is OK, continue */
  40         use constant    RLM_MODULE_HANDLED=>   3;#  /* the module handled the request, so stop. */
  41         use constant    RLM_MODULE_INVALID=>   4;#  /* the module considers the request invalid. */
  42         use constant    RLM_MODULE_USERLOCK=>  5;#  /* reject the request (user is locked out) */
  43         use constant    RLM_MODULE_NOTFOUND=>  6;#  /* user not found */
  44         use constant    RLM_MODULE_NOOP=>      7;#  /* module succeeded without doing anything */
  45         use constant    RLM_MODULE_UPDATED=>   8;#  /* OK (pairs modified) */
  46         use constant    RLM_MODULE_NUMCODES=>  9;#  /* How many return codes there are */
  47
  48 sub accounting
  49 {
  50         for (keys %RAD_REQUEST) {
  51                 # This is for test only
  52                 &radiusd::radlog(1, "rlm_perl:: $_ = $RAD_REQUEST{$_} ");
  53         }
  54
  55         #
  56         # You can call another subroutine from here
  57         #
  58
  59         &test_call;
  60
  61         #
  62         # Add something to reply.
  63         #
  64
  65         return RLM_MODULE_OK;
  66 }
  67
  68 sub test_call
  69 {
  70         #
  71         # Some code goes here
  72         #
  73
  74 }
  75
  76 #
  77 # This is authentication
  78 #
  79 #
  80 sub authenticate
  81 {
  82         # Do something
  83         # Authenticate the request !
  84         #
  85         # Return some info to NAS
  86
  87         $RAD_REPLY{'h323-credit-amount'} = "100";
  88
  89         #...
  90         #
  91
  92         return RLM_MODULE_OK;
  93 }
  94 sub detach
  95 {
  96                 &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
  97 }
  98
  99 #
 100 # This is xlate function wich loads some external perl and evaluate it.
 101 #
 102 sub xlat
 103 {
 104
 105       my ($filename,$a,$b,$c,$d) = @_;
 106
 107       &radiusd::radlog(1, "From xlat $filename ");
 108       &radiusd::radlog(1,"From xlat $a $b $c $d ");
 109       local *FH;
 110       open FH, $filename or die "open '$filename' $!";
 111       local($/) = undef;
 112       my $sub = <FH>;
 113       close FH;
 114       my $eval = qq{ sub handler{ $sub;} };
 115       eval $eval;
 116       eval {main->handler;};
 117
 118 }