Created
March 6, 2013 18:57
-
-
Save anonymous/5102003 to your computer and use it in GitHub Desktop.
/root/script.pl
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# | |
# 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! | |
# | |
use strict; | |
# use ... | |
# This is very important ! Without this script will not get the filled hashesh from main. | |
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK); | |
use Data::Dumper; | |
use IPC::Open2; | |
use DBI; | |
use IO::Handle; | |
# 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 the remapping of return values | |
# | |
use constant RLM_MODULE_REJECT=> 0;# /* immediately reject the request */ | |
use constant RLM_MODULE_FAIL=> 1;# /* module failed, don't reply */ | |
use constant RLM_MODULE_OK=> 2;# /* the module is OK, continue */ | |
use constant RLM_MODULE_HANDLED=> 3;# /* the module handled the request, so stop. */ | |
use constant RLM_MODULE_INVALID=> 4;# /* the module considers the request invalid. */ | |
use constant RLM_MODULE_USERLOCK=> 5;# /* reject the request (user is locked out) */ | |
use constant RLM_MODULE_NOTFOUND=> 6;# /* user not found */ | |
use constant RLM_MODULE_NOOP=> 7;# /* module succeeded without doing anything */ | |
use constant RLM_MODULE_UPDATED=> 8;# /* OK (pairs modified) */ | |
use constant RLM_MODULE_NUMCODES=> 9;# /* How many return codes there are */ | |
# 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; | |
#} | |
sub authorize() { | |
&radiusd::radlog(1,"here"); | |
my $dsn = "DBI:mysql:database=radius;host=127.0.0.1;port=3306" ; | |
my $dbh = DBI->connect($dsn, 'user','password') ; | |
my $sth = $dbh->prepare('SELECT * FROM radacct WHERE acctstoptime IS NULL'); | |
$sth->execute(); | |
my $x = 0; | |
&radiusd::radlog(1,"now here"); | |
while (my @results = $sth->fetchrow_array()) { | |
&radiusd::radlog(1,"LOOP!"); | |
&radiusd::radlog(1,"Calling-Station-Id = " . $RAD_REQUEST{'Calling-Station-Id'}); | |
&radiusd::radlog(1,"results = " . $results[17]); | |
if ($RAD_REQUEST{'Calling-Station-Id'} == $results[17]) { | |
my $secret = $dbh->prepare('SELECT secret FROM nas WHERE nasipaddress = "' . $results[5] . '"'); | |
$secret->execute(); | |
my @secret_results = $secret->fetchrow_array(); | |
my $stdin = IO::Handle->new; | |
my $stdout = IO::Handle->new; | |
my $stderr = IO::Handle->new; | |
my $pid = open2($stdout, $stdin, "radclient", $results[5].":3799", "disconnect", $secret_results[0]); | |
$stdin->print("User-Name = " . $results[3]); | |
my $error = $stderr->getline; | |
if ($error != '') { | |
$RAD_REPLY{'Reply-Message'} = $error; | |
&radiusd::radlog(4,$error); | |
close($pid); | |
return RLM_MODULE_NOOP; | |
} | |
close($pid); | |
$RAD_REPLY{'User-Name'} = $results[3]; | |
&radiusd::radlog(1,"changed username"); | |
return RLM_MODULE_OK; | |
} | |
} | |
&radiusd::radlog(1,"returning noop"); | |
return RLM_MODULE_NOOP; | |
} | |
# 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 | |
$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(1, "From xlat $filename "); | |
&radiusd::radlog(1,"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; | |
# Do some logging. | |
&radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done."); | |
} | |
# | |
# 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(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}"); | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment