summaryrefslogtreecommitdiffstats
path: root/raddb/mods-config/perl/example.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--raddb/mods-config/perl/example.pl230
1 files changed, 230 insertions, 0 deletions
diff --git a/raddb/mods-config/perl/example.pl b/raddb/mods-config/perl/example.pl
new file mode 100644
index 0000000..f00b17b
--- /dev/null
+++ b/raddb/mods-config/perl/example.pl
@@ -0,0 +1,230 @@
+
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+#
+# Copyright 2002 The FreeRADIUS server project
+# Copyright 2002 Boian Jordanov <bjordanov@orbitel.bg>
+#
+
+#
+# Example code for use with rlm_perl
+#
+# You can use every module that comes with your perl distribution!
+#
+# If you are using DBI and do some queries to DB, please be sure to
+# use the CLONE function to initialize the DBI connection to DB.
+#
+
+use strict;
+use warnings;
+
+# use ...
+use Data::Dumper;
+
+# Bring the global hashes into the package scope
+our (%RAD_REQUEST, %RAD_REPLY, %RAD_CHECK, %RAD_STATE, %RAD_PERLCONF);
+
+# This is hash wich hold original request from radius
+#my %RAD_REQUEST;
+# In this hash you add values that will be returned to NAS.
+#my %RAD_REPLY;
+#This is for check items
+#my %RAD_CHECK;
+# This is the session-sate
+#my %RAD_STATE;
+# This is configuration items from "config" perl module configuration section
+#my %RAD_PERLCONF;
+
+# Multi-value attributes are mapped to perl arrayrefs.
+#
+# update request {
+# Filter-Id := 'foo'
+# Filter-Id += 'bar'
+# }
+#
+# This results to the following entry in %RAD_REQUEST:
+#
+# $RAD_REQUEST{'Filter-Id'} = [ 'foo', 'bar' ];
+#
+# Likewise, you can assign an arrayref to return multi-value attributes
+
+#
+# This the remapping of return values
+#
+use constant {
+ RLM_MODULE_REJECT => 0, # immediately reject the request
+ RLM_MODULE_OK => 2, # the module is OK, continue
+ RLM_MODULE_HANDLED => 3, # the module handled the request, so stop
+ RLM_MODULE_INVALID => 4, # the module considers the request invalid
+ RLM_MODULE_USERLOCK => 5, # reject the request (user is locked out)
+ RLM_MODULE_NOTFOUND => 6, # user not found
+ RLM_MODULE_NOOP => 7, # module succeeded without doing anything
+ RLM_MODULE_UPDATED => 8, # OK (pairs modified)
+ RLM_MODULE_NUMCODES => 9 # How many return codes there are
+};
+
+# Same as src/include/log.h
+use constant {
+ L_AUTH => 2, # Authentication message
+ L_INFO => 3, # Informational message
+ L_ERR => 4, # Error message
+ L_WARN => 5, # Warning
+ L_PROXY => 6, # Proxy messages
+ L_ACCT => 7, # Accounting messages
+ L_DBG => 16, # Only displayed when debugging is enabled
+ L_DBG_WARN => 17, # Warning only displayed when debugging is enabled
+ L_DBG_ERR => 18, # Error only displayed when debugging is enabled
+ L_DBG_WARN_REQ => 19, # Less severe warning only displayed when debugging is enabled
+ L_DBG_ERR_REQ => 20, # Less severe error only displayed when debugging is enabled
+};
+
+# Global variables can persist across different calls to the module.
+#
+#
+# {
+# my %static_global_hash = ();
+#
+# sub post_auth {
+# ...
+# }
+# ...
+# }
+
+
+# Function to handle authorize
+sub authorize {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ # Here's where your authorization code comes
+ # You can call another function from here:
+ &test_call;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle authenticate
+sub authenticate {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ if ($RAD_REQUEST{'User-Name'} =~ /^baduser/i) {
+ # Reject user and tell him why
+ $RAD_REPLY{'Reply-Message'} = "Denied access by rlm_perl function";
+ return RLM_MODULE_REJECT;
+ } else {
+ # Accept user and set some attribute
+ if (&radiusd::xlat("%{client:group}") eq 'UltraAllInclusive') {
+ # User called from NAS with unlim plan set, set higher limits
+ $RAD_REPLY{'h323-credit-amount'} = "1000000";
+ } else {
+ $RAD_REPLY{'h323-credit-amount'} = "100";
+ }
+ return RLM_MODULE_OK;
+ }
+}
+
+# Function to handle preacct
+sub preacct {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle accounting
+sub accounting {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ # You can call another subroutine from here
+ &test_call;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle checksimul
+sub checksimul {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle pre_proxy
+sub pre_proxy {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle post_proxy
+sub post_proxy {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle post_auth
+sub post_auth {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ return RLM_MODULE_OK;
+}
+
+# Function to handle xlat
+sub xlat {
+ # For debugging purposes only
+# &log_request_attributes;
+
+ # Loads some external perl and evaluate it
+ my ($filename,$a,$b,$c,$d) = @_;
+ &radiusd::radlog(L_DBG, "From xlat $filename ");
+ &radiusd::radlog(L_DBG,"From xlat $a $b $c $d ");
+ local *FH;
+ open FH, $filename or die "open '$filename' $!";
+ local($/) = undef;
+ my $sub = <FH>;
+ close FH;
+ my $eval = qq{ sub handler{ $sub;} };
+ eval $eval;
+ eval {main->handler;};
+}
+
+# Function to handle detach
+sub detach {
+ # For debugging purposes only
+# &log_request_attributes;
+}
+
+#
+# Some functions that can be called from other functions
+#
+
+sub test_call {
+ # Some code goes here
+}
+
+sub log_request_attributes {
+ # This shouldn't be done in production environments!
+ # This is only meant for debugging!
+ for (keys %RAD_REQUEST) {
+ &radiusd::radlog(L_DBG, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
+ }
+}
+