2 # This program is free software; you can redistribute it and/or modify
3 # it under the terms of the GNU General Public License as published by
4 # the Free Software Foundation; either version 2 of the License, or
5 # (at your option) any later version.
7 # This program is distributed in the hope that it will be useful,
8 # but WITHOUT ANY WARRANTY; without even the implied warranty of
9 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 # GNU General Public License for more details.
12 # You should have received a copy of the GNU General Public License
13 # along with this program; if not, write to the Free Software
14 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
16 # Copyright 2002 The FreeRADIUS server project
17 # Copyright 2002 Boian Jordanov <bjordanov@orbitel.bg>
21 # Example code for use with rlm_perl
23 # You can use every module that comes with your perl distribution!
28 # This is very important ! Without this script will not get the filled hashesh from main.
29 use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
32 # This is hash wich hold original request from radius
34 # In this hash you add values that will be returned to NAS.
36 #This is for check items
40 # This the remapping of return values
42 use constant RLM_MODULE_REJECT=> 0;# /* immediately reject the request */
43 use constant RLM_MODULE_FAIL=> 1;# /* module failed, don't reply */
44 use constant RLM_MODULE_OK=> 2;# /* the module is OK, continue */
45 use constant RLM_MODULE_HANDLED=> 3;# /* the module handled the request, so stop. */
46 use constant RLM_MODULE_INVALID=> 4;# /* the module considers the request invalid. */
47 use constant RLM_MODULE_USERLOCK=> 5;# /* reject the request (user is locked out) */
48 use constant RLM_MODULE_NOTFOUND=> 6;# /* user not found */
49 use constant RLM_MODULE_NOOP=> 7;# /* module succeeded without doing anything */
50 use constant RLM_MODULE_UPDATED=> 8;# /* OK (pairs modified) */
51 use constant RLM_MODULE_NUMCODES=> 9;# /* How many return codes there are */
53 # Function to handle authorize
55 # For debugging purposes only
56 # &log_request_attributes;
58 # Here's where your authorization code comes
59 # You can call another function from here:
65 # Function to handle authenticate
67 # For debugging purposes only
68 # &log_request_attributes;
70 if ($RAD_REQUEST{'User-Name'} =~ /^baduser/i) {
71 # Reject user and tell him why
72 $RAD_REPLY{'Reply-Message'} = "Denied access by rlm_perl function";
73 return RLM_MODULE_REJECT;
75 # Accept user and set some attribute
76 $RAD_REPLY{'h323-credit-amount'} = "100";
81 # Function to handle preacct
83 # For debugging purposes only
84 # &log_request_attributes;
89 # Function to handle accounting
91 # For debugging purposes only
92 # &log_request_attributes;
94 # You can call another subroutine from here
100 # Function to handle checksimul
102 # For debugging purposes only
103 # &log_request_attributes;
105 return RLM_MODULE_OK;
108 # Function to handle pre_proxy
110 # For debugging purposes only
111 # &log_request_attributes;
113 return RLM_MODULE_OK;
116 # Function to handle post_proxy
118 # For debugging purposes only
119 # &log_request_attributes;
121 return RLM_MODULE_OK;
124 # Function to handle post_auth
126 # For debugging purposes only
127 # &log_request_attributes;
129 return RLM_MODULE_OK;
132 # Function to handle xlat
134 # For debugging purposes only
135 # &log_request_attributes;
137 # Loads some external perl and evaluate it
138 my ($filename,$a,$b,$c,$d) = @_;
139 &radiusd::radlog(1, "From xlat $filename ");
140 &radiusd::radlog(1,"From xlat $a $b $c $d ");
142 open FH, $filename or die "open '$filename' $!";
146 my $eval = qq{ sub handler{ $sub;} };
148 eval {main->handler;};
151 # Function to handle detach
153 # For debugging purposes only
154 # &log_request_attributes;
157 &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
161 # Some functions that can be called from other functions
165 # Some code goes here
168 sub log_request_attributes {
169 # This shouldn't be done in production environments!
170 # This is only meant for debugging!
171 for (keys %RAD_REQUEST) {
172 &radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");