Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • smradius/smradius
  • centiva-shail/smradius
  • nkukard/smradius
3 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 4831 additions and 1008 deletions
smradius/modules/authentication/mod_auth_chap.pm → lib/smradius/modules/authentication/mod_auth_chap.pm
View file @ b659b33b
# CHAP authentication
# Copyright (C) 2007-2015, AllWorldIT
#
# References:
# RFC1944 - PPP Challenge Handshake Authentication Protocol (CHAP)
#
# Copyright (C) 2008, AllWorldIT
#
# 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
......@@ -22,7 +21,7 @@
package mod_auth_chap;
package smradius::modules::authentication::mod_auth_chap;
use strict;
use warnings;
......@@ -32,8 +31,6 @@ use smradius::constants;
use smradius::logging;
use Digest::MD5;
use Data::Dumper;
# Exporter stuff
......@@ -88,22 +85,44 @@ sub authenticate
# Check if this is a CHAP auth
return MOD_RES_SKIP if (!defined($challenge) || !defined($password));
$server->log(LOG_DEBUG,"This is a CHAP challenge....");
print(STDERR "RECEIVED\n");
print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
print(STDERR "Password : len = ".length($password).", hex = ".unpack("H*",$password)."\n");
print(STDERR "\n\n");
$server->log(LOG_DEBUG,"[MOD_AUTH_CHAP] This is a CHAP challenge");
# Grab our own version of the password
my $ourPassword;
if (defined($user->{'Attributes'}->{'User-Password'})) {
# Operator: ==
if (defined($user->{'Attributes'}->{'User-Password'}->{'=='})) {
# Set password
$ourPassword = $user->{'Attributes'}->{'User-Password'}->{'=='}->{'Value'};
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_CHAP] No valid operators for attribute 'User-Password', ".
"supported operators are: ==");
}
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_CHAP] No 'User-Password' attribute, cannot authenticate");
return MOD_RES_NACK;
}
# print(STDERR "RECEIVED\n");
# print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
# print(STDERR "Password : len = ".length($password).", hex = ".unpack("H*",$password)."\n");
# print(STDERR "\n\n");
# Pull off the ID
my $id = substr($password,0,1);
print(STDERR "ID: ".length($id).", hex = ".unpack("H*",$id)."\n");
# print(STDERR "ID: ".length($id).", hex = ".unpack("H*",$id)."\n");
my $result = encode_chap($id,$challenge,"mytest");
# Calculate the result
my $result = encode_chap($id,$challenge,$ourPassword);
print(STDERR "CALC\n");
print(STDERR "Result : len = ".length($result).", hex = ".unpack("H*",$result)."\n");
print(STDERR "\n\n");
# print(STDERR "CALC\n");
# print(STDERR "Result : len = ".length($result).", hex = ".unpack("H*",$result)."\n");
# print(STDERR "\n\n");
# Check if the password and the result match
if ($password eq $result) {
return MOD_RES_ACK;
}
return MOD_RES_NACK;
}
......@@ -131,3 +150,4 @@ sub encode_chap
1;
# vim: ts=4
smradius/config.pm → lib/smradius/modules/authentication/mod_auth_macauth.pm
View file @ b659b33b
# SMRadius config information
# Copyright (C) 2008, AllWorldIT
# MAC Authentication
# Copyright (C) 2007-2015, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
## @class smradius::config
# Configuration handling class
package smradius::config;
package smradius::modules::authentication::mod_auth_macauth;
use strict;
use warnings;
# Modules we need
use smradius::attributes;
use smradius::constants;
use smradius::logging;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT);
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
use smradius::logging;
# Plugin info
our $pluginInfo = {
Name => "MAC Authentication",
Init => \&init,
# Authentication
Authentication_try => \&authenticate,
};
# Our vars
my $config;
## @fn Init($server)
# Initialize this module with a server object
#
# @param server Server object we need to setup
sub Init
## @internal
# Initialize module
sub init
{
my $server = shift;
}
# Setup configuration
$config = $server->{'inifile'};
my $db;
$db->{'DSN'} = $config->{'database'}{'dsn'};
$db->{'Username'} = $config->{'database'}{'username'};
$db->{'Password'} = $config->{'database'}{'password'};
$db->{'enabled'} = 0;
## @authenticate
# Try authenticate user
#
# @param server Server object
# @param user User hash
# @param packet Radius packet
#
# @return Result
sub authenticate
{
my ($server,$user,$packet) = @_;
# Check we have all the config we need
if (!defined($db->{'DSN'})) {
$server->log(LOG_NOTICE,"smradius/config.pm: No 'DSN' defined in config file for 'database'");
}
$server->{'smradius'}{'database'} = $db;
}
# This is not a MAC authentication request
if ($user->{'_UserDB'}->{'Name'} ne "SQL User Database (MAC authentication)") {
return MOD_RES_SKIP;
}
$server->log(LOG_DEBUG,"[MOD_AUTH_MACAUTH] This is a MAC authentication request");
## @fn getConfig
# Get the config hash
#
# @return Hash ref of all our config items
sub getConfig
{
return $config;
return MOD_RES_ACK;
}
1;
# vim: ts=4
smradius/modules/authentication/mod_auth_mschap.pm → lib/smradius/modules/authentication/mod_auth_mschap.pm
View file @ b659b33b
# Microsoft CHAP version 1 and 2 support
# Copyright (C) 2007-2015, AllWorldIT
#
# References:
# RFC1994 - PPP Challenge Handshake Authentication Protocol (CHAP)
# RFC2443 - Microsoft PPP CHAP Extensions
# RFC2759 - Microsoft PPP CHAP Extensions, Version 2
# RFC2548 - Microsoft Vendor-specific RADIUS Attributes
# RFC3079 - Deriving Keys for use with Microsoft Point-to-Point
# Encryption (MPPE)
#
# Copyright (C) 2008, AllWorldIT
#
# 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
......@@ -25,31 +26,33 @@
package mod_auth_mschap;
package smradius::modules::authentication::mod_auth_mschap;
use strict;
use warnings;
# Modules we need
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use Crypt::DES;
use Crypt::RC4;
use Digest::SHA1;
use Digest::SHA;
use Digest::MD4 qw( md4 );
use Digest::MD5 qw( );
# Don't use unicode
use bytes;
use Data::Dumper;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
GenerateNTResponse
ChallengeHash
NtPasswordHash
......@@ -59,8 +62,6 @@ our (@ISA,@EXPORT,@EXPORT_OK);
CheckAuthenticatorResponse
NtChallengeResponse
);
@EXPORT_OK = qw(
);
use constant {
......@@ -110,64 +111,155 @@ sub authenticate
# Return if not recognized...
return MOD_RES_SKIP if (!defined($rawChallenge) || (!defined($rawResponse) && !defined($rawResponse2)));
print(STDERR "This is a MS-CHAP challenge....\n");
$server->log(LOG_DEBUG,"[MOD_AUTH_MSCHAP] This is a MSCHAP challenge");
# Grab our own version of the password
my $unicodePassword;
if (defined($user->{'Attributes'}->{'User-Password'})) {
# Operator: ==
if (defined($user->{'Attributes'}->{'User-Password'}->{'=='})) {
# Set password
$unicodePassword = $user->{'Attributes'}->{'User-Password'}->{'=='}->{'Value'};
$unicodePassword =~ s/(.)/$1\0/g; # convert ASCII to unicaode
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_CHAP] No valid operators for attribute 'User-Password', ".
"supported operators are: ==");
}
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_CHAP] No 'User-Password' attribute, cannot authenticate");
return MOD_RES_NACK;
}
# Grab usrename
my $username = $user->{'Username'};
if (!defined($username)) {
$server->log(LOG_NOTICE,"[MOD_AUTH_CHAP] No 'Username' attribute in packet, cannot authenticate");
return MOD_RES_NACK;
}
# MSCHAPv1
if ($rawResponse) {
$server->log(LOG_DEBUG,"[MOD_AUTH_MSCHAP] This is a MSCHAPv1 challenge");
# Pull off challenge & response
my $challenge = @{$rawChallenge}[0];
my $response = substr(@{$rawResponse}[0],2);
print(STDERR "RECEIVED\n");
print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
print(STDERR "Reponse : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
print(STDERR "\n\n");
# Chop off NtResponse
my $NtResponse = substr($response,24,24);
# Generate our response
my $ourResponse = NtChallengeResponse($challenge,$unicodePassword);
print(STDERR "CHOPPED OFFF!!\n");
my $NtResponse = substr($response,24,24);
print(STDERR "NTRespons: len = ".length($NtResponse).", hex = ".unpack("H*",$NtResponse)."\n");
print(STDERR "\n\n");
# MPPE Code
##################
my $NtPasswordHash = NtPasswordHash($unicodePassword);
my $HashNtPasswordHash = HashNtPasswordHash($NtPasswordHash);
my $sendkey = pack("x8a16",$HashNtPasswordHash);
my $recvkey;
setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
'Vendor' => 311,
'Name' => 'MS-CHAP-MPPE-Keys',
'Operator' => ":=",
'Value' => $sendkey
});
##################
my $unipass = "mytest";
$unipass =~ s/(.)/$1\0/g; # convert ASCII to unicaode
my $username = "nigel";
print(STDERR "TEST\n");
my $ourResponse = NtChallengeResponse($challenge,$unipass);
print(STDERR "Calculate: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
print(STDERR "\n\n");
# Check responses match
if ($NtResponse eq $ourResponse) {
return MOD_RES_ACK;
}
# MSCHAPv2
} elsif ($rawResponse2) {
$server->log(LOG_DEBUG,"[MOD_AUTH_MSCHAP] This is a MSCHAPv2 challenge");
# Pull off challenge & response
my $challenge = @{$rawChallenge}[0];
my $ident = unpack("C", substr(@{$rawResponse2}[0],0,1));
my $response = substr(@{$rawResponse2}[0],2);
print(STDERR "RECEIVED\n");
print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
print(STDERR "Reponse : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
print(STDERR "\n\n");
print(STDERR "CHOPPED OFFF!!\n");
# Grab peer challenge and response
my $peerChallenge = substr($response,0,16);
my $NtRespnse = substr($response,24,24);
print(STDERR "Challenge: len = ".length($peerChallenge).", hex = ".unpack("H*",$peerChallenge)."\n");
print(STDERR "NTRespons: len = ".length($NtRespnse).", hex = ".unpack("H*",$NtRespnse)."\n");
print(STDERR "\n\n");
my $unipass = "mytest";
$unipass =~ s/(.)/$1\0/g; # convert ASCII to unicaode
my $username = "nigel";
my $NtResponse = substr($response,24,24);
print(STDERR "TEST\n");
# Generate our challenge and our response
my $ourChallenge = ChallengeHash($peerChallenge,$challenge,$username);
my $ourResponse = NtChallengeResponse($ourChallenge,$unipass);
print(STDERR "Calculate: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
print(STDERR "\n\n");
my $ourResponse = NtChallengeResponse($ourChallenge,$unicodePassword);
# Check response match
if ($NtResponse eq $ourResponse) {
# Generate authenticator response
my $authenticatorResponse = pack("C",$ident) . GenerateAuthenticatorResponse($unicodePassword,$ourResponse,
$peerChallenge,$challenge,$username);
# MPPE Code
################################
my $NtPasswordHash = NtPasswordHash($unicodePassword);
my $HashNtPasswordHash = HashNtPasswordHash($NtPasswordHash);
# Create master key
my $MasterKey = GetMasterKey($HashNtPasswordHash,$NtResponse);
# Create MPPE keys
my $mppe_sendKey = GetAsymmetricStartKey($MasterKey,16,1,1);
my $mppe_recvKey = GetAsymmetricStartKey($MasterKey,16,1,0);
# Generate salts ... this should be in its own module and salt_offset should be global
my $salt_offset = 0;
my $salt1 = pack("C2",(0x80 | ( (($salt_offset++) & 0x0f) << 3) |
(rand(255) & 0x07)),rand(255));
my $salt2 = pack("C2",(0x80 | ( (($salt_offset++) & 0x0f) << 3) |
(rand(255) & 0x07)),rand(255));
# Encode keys
my $mppe_sendKey_e = mppe_encode_key(
getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"),
$packet->authenticator,
$salt1,
$mppe_sendKey
);
my $mppe_recvKey_e = mppe_encode_key(
getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"),
$packet->authenticator,
$salt2,
$mppe_recvKey
);
# Finally setup arguments
setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
'Vendor' => 311,
'Name' => 'MS-MPPE-Recv-Key',
'Operator' => ":=",
'Value' => $mppe_recvKey_e
});
setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
'Vendor' => 311,
'Name' => 'MS-MPPE-Send-Key',
'Operator' => ":=",
'Value' => $mppe_sendKey_e
});
#################################
setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
'Vendor' => 311,
'Name' => 'MS-CHAP2-Success',
'Operator' => ":=",
'Value' => $authenticatorResponse
});
return MOD_RES_ACK;
}
}
return MOD_RES_SKIP;
......@@ -236,7 +328,7 @@ sub ChallengeHash
# SHA encryption
my $sha = Digest::SHA1->new();
my $sha = Digest::SHA->new();
$sha->add($PeerChallenge);
$sha->add($AuthenticatorChallenge);
$sha->add($UserName);
......@@ -453,42 +545,46 @@ sub GenerateAuthenticatorResponse
my ($Password,$NTResponse,$PeerChallenge,$AuthenticatorChallenge,$UserName) = @_;
# "Magic" constants used in response generation
# "Magic" constants used in response generation - this is in hex
my @Magic1 =
(0x4D, 0x61, 0x67, 0x69, 0x63, 0x20, 0x73, 0x65, 0x72, 0x76,
0x65, 0x72, 0x20, 0x74, 0x6F, 0x20, 0x63, 0x6C, 0x69, 0x65,
0x6E, 0x74, 0x20, 0x73, 0x69, 0x67, 0x6E, 0x69, 0x6E, 0x67,
0x20, 0x63, 0x6F, 0x6E, 0x73, 0x74, 0x61, 0x6E, 0x74);
("4D", "61", "67", "69", "63", "20", "73", "65", "72", "76",
"65", "72", "20", "74", "6F", "20", "63", "6C", "69", "65",
"6E", "74", "20", "73", "69", "67", "6E", "69", "6E", "67",
"20", "63", "6F", "6E", "73", "74", "61", "6E", "74");
my @Magic2 =
(0x50, 0x61, 0x64, 0x20, 0x74, 0x6F, 0x20, 0x6D, 0x61, 0x6B,
0x65, 0x20, 0x69, 0x74, 0x20, 0x64, 0x6F, 0x20, 0x6D, 0x6F,
0x72, 0x65, 0x20, 0x74, 0x68, 0x61, 0x6E, 0x20, 0x6F, 0x6E,
0x65, 0x20, 0x69, 0x74, 0x65, 0x72, 0x61, 0x74, 0x69, 0x6F,
0x6E);
("50", "61", "64", "20", "74", "6F", "20", "6D", "61", "6B",
"65", "20", "69", "74", "20", "64", "6F", "20", "6D", "6F",
"72", "65", "20", "74", "68", "61", "6E", "20", "6F", "6E",
"65", "20", "69", "74", "65", "72", "61", "74", "69", "6F",
"6E");
# Hash the password with MD4
my $PasswordHash = NtPasswordHash($Password);
# Now hash the hash
my $PasswordHashHash = HashNtPasswordHash($PasswordHash);
# SHA encryption
my $sha = Digest::SHA1->new();
my $sha = Digest::SHA->new();
$sha->add($PasswordHashHash);
$sha->add($NTResponse);
$sha->add(@Magic1);
foreach my $item (@Magic1) {
$sha->add(pack("H*",$item));
}
my $Digest = $sha->digest();
my $Challenge = ChallengeHash($PeerChallenge, $AuthenticatorChallenge, $UserName);
$sha = Digest::SHA1->new();
$sha = Digest::SHA->new();
$sha->add($Digest);
$sha->add($Challenge);
$sha->add(@Magic2);
foreach my $item (@Magic2) {
$sha->add(pack("H*",$item));
}
$Digest = $sha->digest();
# Encode digest and return response
my $AuthenticatorResponse = "S=" . unpack("H*",$Digest);
# Encode digest and return response, UPPERCASE response
my $AuthenticatorResponse = "S=" . uc( unpack("H*",$Digest) );
return $AuthenticatorResponse;
}
......@@ -716,4 +812,220 @@ sub NtChallengeResponse {
#
# RFC 3079
#
#GetMasterKey(
# IN 16-octet PasswordHashHash,
# IN 24-octet NTResponse,
# OUT 16-octet MasterKey )
#{
# 20-octet Digest
#
# ZeroMemory(Digest, sizeof(Digest));
#
# /*
# * SHSInit(), SHSUpdate() and SHSFinal()
# * are an implementation of the Secure Hash Standard [7].
# */
#
# SHSInit(Context);
# SHSUpdate(Context, PasswordHashHash, 16);
# SHSUpdate(Context, NTResponse, 24);
# SHSUpdate(Context, Magic1, 27);
# SHSFinal(Context, Digest);
#
# MoveMemory(MasterKey, Digest, 16);
#}
sub GetMasterKey
{
my ($PasswordHashHash,$NTResponse) = @_;
# "Magic" constants used in key derivations - in hex
my @Magic1 =
("54", "68", "69", "73", "20", "69", "73", "20", "74",
"68", "65", "20", "4d", "50", "50", "45", "20", "4d",
"61", "73", "74", "65", "72", "20", "4b", "65", "79");
my $sha = Digest::SHA->new();
$sha->add($PasswordHashHash);
$sha->add($NTResponse);
foreach my $item (@Magic1) {
$sha->add(pack("H*",$item));
}
my $Digest = $sha->digest();
# Cut off MasterKey
my $MasterKey = substr($Digest,0,16);
return $MasterKey;
}
#VOID
#GetAsymetricStartKey(
# IN 16-octet MasterKey,
# OUT 8-to-16 octet SessionKey,
# IN INTEGER SessionKeyLength,
# IN BOOLEAN IsSend,
# IN BOOLEAN IsServer )
#{
#
# 20-octet Digest;
#
# ZeroMemory(Digest, 20);
#
# if (IsSend) {
# if (IsServer) {
# s = Magic3
# } else {
# s = Magic2
# }
# } else {
# if (IsServer) {
# s = Magic2
# } else {
# s = Magic3
# }
# }
#
# /*
# * SHSInit(), SHSUpdate() and SHSFinal()
# * are an implementation of the Secure Hash Standard [7].
# */
#
# SHSInit(Context);
# SHSUpdate(Context, MasterKey, 16);
# SHSUpdate(Context, SHSpad1, 40);
# SHSUpdate(Context, s, 84);
# SHSUpdate(Context, SHSpad2, 40);
# SHSFinal(Context, Digest);
#
# MoveMemory(SessionKey, Digest, SessionKeyLength);
#}
sub GetAsymmetricStartKey
{
my ($MasterKey,$SessionKeyLength,$IsSend,$IsServer) = @_;
# "Magic" constants used in key derivations - in hex
my @Magic2 =
("4f", "6e", "20", "74", "68", "65", "20", "63", "6c", "69",
"65", "6e", "74", "20", "73", "69", "64", "65", "2c", "20",
"74", "68", "69", "73", "20", "69", "73", "20", "74", "68",
"65", "20", "73", "65", "6e", "64", "20", "6b", "65", "79",
"3b", "20", "6f", "6e", "20", "74", "68", "65", "20", "73",
"65", "72", "76", "65", "72", "20", "73", "69", "64", "65",
"2c", "20", "69", "74", "20", "69", "73", "20", "74", "68",
"65", "20", "72", "65", "63", "65", "69", "76", "65", "20",
"6b", "65", "79", "2e");
my @Magic3 =
("4f", "6e", "20", "74", "68", "65", "20", "63", "6c", "69",
"65", "6e", "74", "20", "73", "69", "64", "65", "2c", "20",
"74", "68", "69", "73", "20", "69", "73", "20", "74", "68",
"65", "20", "72", "65", "63", "65", "69", "76", "65", "20",
"6b", "65", "79", "3b", "20", "6f", "6e", "20", "74", "68",
"65", "20", "73", "65", "72", "76", "65", "72", "20", "73",
"69", "64", "65", "2c", "20", "69", "74", "20", "69", "73",
"20", "74", "68", "65", "20", "73", "65", "6e", "64", "20",
"6b", "65", "79", "2e");
# Pads used in key derivation - in hex
my @SHSpad1 =
("00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
"00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
"00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
"00", "00", "00", "00", "00", "00", "00", "00", "00", "00");
my @SHSpad2 =
("f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
"f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
"f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
"f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2");
my @s;
if ($IsSend) {
if ($IsServer) {
@s = @Magic3;
} else {
@s = @Magic2;
}
} else {
if ($IsServer) {
@s = @Magic2;
} else {
@s = @Magic3;
}
}
my $sha = Digest::SHA->new();
$sha->add($MasterKey);
foreach my $item (@SHSpad1) {
$sha->add(pack("H*",$item));
}
foreach my $item (@s) {
$sha->add(pack("H*",$item));
}
foreach my $item (@SHSpad2) {
$sha->add(pack("H*",$item));
}
my $digest = $sha->digest();
# Cut off SessionKey
my $SessionKey = substr($digest,0,$SessionKeyLength);
return $SessionKey;
}
# Function to encode a key
sub mppe_encode_key
{
my ($secret,$vector,$salt,$enckey) = @_;
# Ok, to do this we need the length of the key first
my @plain = (
16, # Length
unpack("C*",pack("a31",$enckey))
);
# Create our first digest
my $sha = Digest::MD5->new();
$sha->add($secret);
$sha->add($vector);
$sha->add($salt);
# Unpack digest for calculation
my @buf = unpack("C*",$sha->digest());
# Calculate
for(my $i=0; $i < 16; $i++) {
$plain[$i] ^= $buf[$i];
}
# Second round
$sha = Digest::MD5->new();
$sha->add($secret);
# Add the values we calculated above
for (my $i = 0; $i < 16; $i++) {
$sha->add(pack("C",$plain[$i]));
}
# Unpack digest for calculation
@buf = unpack("C*",$sha->digest());
# Calculate
for (my $i = 0; $i < 16; $i++) {
$plain[$i+16] ^= $buf[$i];
}
# Pack salt, and result
my $key = pack("a2C32",$salt,@plain);
return $key;
}
1;
# vim: ts=4
smradius/modules/authentication/mod_auth_pap.pm → lib/smradius/modules/authentication/mod_auth_pap.pm
View file @ b659b33b
# PAP
# Copyright (C) 2007-2015, AllWorldIT
#
# References:
# RFC1334 - PPP Authentication Protocols
#
# Copyright (C) 2008, AllWorldIT
#
# 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
......@@ -19,12 +18,13 @@
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package mod_auth_pap;
package smradius::modules::authentication::mod_auth_pap;
use strict;
use warnings;
# Modules we need
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use Digest::MD5;
......@@ -80,13 +80,18 @@ sub authenticate
# Check if this is PAP authentication
return MOD_RES_SKIP if (!defined($encPassword));
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_AUTH_PAP] This is a PAP authentication request");
# print(STDERR "RECEIVED\n");
# print(STDERR "User-Pass: len = ".length($encPassword).", hex = ".unpack("H*",$encPassword)."\n");
# print(STDERR "\n\n");
# FIXME - test is the radius secret, must pull it from the configuration attributes??
my $clearPassword = $packet->password("test","User-Password");
# Decode the password using the secret
my $clearPassword = $packet->password(getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"),
"User-Password");
# print(STDERR "CALC\n");
# print(STDERR "Result : len = ".length($clearPassword).", hex = ".unpack("H*",$clearPassword).", password = $clearPassword\n");
......@@ -101,7 +106,8 @@ sub authenticate
return MOD_RES_ACK;
}
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_PAP] No valid operators for attribute 'User-Password', supported operators are: ==");
$server->log(LOG_NOTICE,"[MOD_AUTH_PAP] No valid operators for attribute 'User-Password', ".
"supported operators are: ==");
}
} else {
$server->log(LOG_NOTICE,"[MOD_AUTH_PAP] No 'User-Password' attribute, cannot authenticate");
......@@ -112,3 +118,4 @@ sub authenticate
1;
# vim: ts=4
lib/smradius/modules/features/mod_feature_capping.pm 0 → 100644
View file @ b659b33b
# Capping support
# Copyright (C) 2007-2019, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::features::mod_feature_capping;
use strict;
use warnings;
# Modules we need
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::util;
use AWITPT::Util;
use List::Util qw( min );
use MIME::Lite;
use POSIX qw( floor );
# Set our version
our $VERSION = "0.0.1";
# Load exporter
use base qw(Exporter);
our @EXPORT = qw(
);
our @EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "User Capping Feature",
Init => \&init,
# Authentication hook
'Feature_Post-Authentication_hook' => \&post_auth_hook,
# Accounting hook
'Feature_Post-Accounting_hook' => \&post_acct_hook,
};
# Some constants
my $TRAFFIC_LIMIT_ATTRIBUTE = 'SMRadius-Capping-Traffic-Limit';
my $UPTIME_LIMIT_ATTRIBUTE = 'SMRadius-Capping-Uptime-Limit';
my $TRAFFIC_TOPUP_ATTRIBUTE = 'SMRadius-Capping-Traffic-Topup';
my $TIME_TOPUP_ATTRIBUTE = 'SMRadius-Capping-Uptime-Topup';
my $config;
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Defaults
$config->{'enable_mikrotik'} = 0;
$config->{'caveat_captrafzero'} = 0;
# Setup SQL queries
if (defined($scfg->{'mod_feature_capping'})) {
# Check if option exists
if (defined($scfg->{'mod_feature_capping'}{'enable_mikrotik'})) {
# Pull in config
if (defined(my $val = isBoolean($scfg->{'mod_feature_capping'}{'enable_mikrotik'}))) {
if ($val) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Mikrotik-specific vendor return attributes ENABLED");
$config->{'enable_mikrotik'} = $val;
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Value for 'enable_mikrotik' is invalid");
}
}
# Check if we have the caveat setting
if (defined(my $val = isBoolean($scfg->{'mod_feature_capping'}{'caveat_captrafzero'}))) {
if ($val) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Caveat to swap '0' and -undef- for ".
"SMRadius-Capping-Traffic-Limit ENABLED");
$config->{'caveat_captrafzero'} = $val;
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Value for 'caveat_captrafzero' is invalid");
}
}
return;
}
## @post_auth_hook($server,$user,$packet)
# Post authentication hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub post_auth_hook
{
my ($server,$user,$packet) = @_;
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] POST AUTH HOOK");
#
# Get limits from attributes
#
my $uptimeLimit = _getAttributeKeyLimit($server,$user,$UPTIME_LIMIT_ATTRIBUTE);
my $trafficLimit = _getAttributeKeyLimit($server,$user,$TRAFFIC_LIMIT_ATTRIBUTE);
# Swap around 0 and undef if we need to apply the captrafzero caveat
if ($config->{'caveat_captrafzero'}) {
if (!defined($uptimeLimit)) {
$uptimeLimit = 0;
} elsif ($uptimeLimit == 0) {
$uptimeLimit = undef;
}
if (!defined($trafficLimit)) {
$trafficLimit = 0;
} elsif ($trafficLimit == 0) {
$trafficLimit = undef;
}
}
#
# Get current traffic and uptime usage
#
my $accountingUsage = _getAccountingUsage($server,$user,$packet);
if (!defined($accountingUsage)) {
return MOD_RES_SKIP;
}
#
# Get valid traffic and uptime topups
#
# Check if there was any data returned at all
my $uptimeTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_TOPUP_ATTRIBUTE) // 0;
my $trafficTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_TOPUP_ATTRIBUTE) // 0;
#
# Set the new uptime and traffic limits (limit, if any.. + topups)
#
# Uptime..
# // is a defined operator, $a ? defined($a) : $b
my $uptimeLimitWithTopups = ($uptimeLimit // 0) + $uptimeTopupAmount;
# Traffic..
# // is a defined operator, $a ? defined($a) : $b
my $trafficLimitWithTopups = ($trafficLimit // 0) + $trafficTopupAmount;
#
# Do auto-topups for both traffic and uptime
#
my $autoTopupTrafficAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalDataUsage'},"traffic",
$trafficLimitWithTopups,1);
if (defined($autoTopupTrafficAdded)) {
$trafficLimitWithTopups += $autoTopupTrafficAdded;
}
my $autoTopupUptimeAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalSessionTime'},"uptime",
$uptimeLimitWithTopups,2);
if (defined($autoTopupUptimeAdded)) {
$uptimeLimitWithTopups += $autoTopupUptimeAdded;
}
#
# Display our usages
#
_logUsage($server,$accountingUsage->{'TotalDataUsage'},$trafficLimit,$trafficTopupAmount,'traffic');
_logUsage($server,$accountingUsage->{'TotalSessionTime'},$uptimeLimit,$uptimeTopupAmount,'uptime');
#
# Add conditional variables
#
addAttributeConditionalVariable($user,"SMRadius_Capping_TotalDataUsage",$accountingUsage->{'TotalDataUsage'});
addAttributeConditionalVariable($user,"SMRadius_Capping_TotalSessionTime",$accountingUsage->{'TotalSessionTime'});
#
# Allow for capping overrides by attribute
#
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'})) {
my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'}});
my $newLimit = $uptimeLimitWithTopups * $multiplier;
my $newSessionTime = $accountingUsage->{'TotalSessionTime'} * $multiplier;
$uptimeLimitWithTopups = $newLimit;
$accountingUsage->{'TotalSessionTime'} = $newSessionTime;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User uptime multiplier '$multiplier' changes ".
"uptime limit ('$uptimeLimitWithTopups' => '$newLimit'), ".
"uptime usage ('".$accountingUsage->{'TotalSessionTime'}."' => '$newSessionTime')"
);
}
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'})) {
my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'}});
my $newLimit = $trafficLimitWithTopups * $multiplier;
my $newDataUsage = $accountingUsage->{'TotalDataUsage'} * $multiplier;
$trafficLimitWithTopups = $newLimit;
$accountingUsage->{'TotalDataUsage'} = $newDataUsage;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User traffic multiplier '$multiplier' changes ".
"traffic limit ('$trafficLimitWithTopups' => '$newLimit'), ".
"traffic usage ('".$accountingUsage->{'TotalDataUsage'}."' => '$newDataUsage')"
);
}
#
# Check if we've exceeded our limits
#
# Uptime...
if (defined($uptimeLimit)) {
# Check session time has not exceeded what we're allowed
if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalSessionTime'}.
"min exceeds allowed limit of ".$uptimeLimitWithTopups."min");
return MOD_RES_NACK;
# Setup limits
} else {
# Check if we returning Mikrotik vattributes
# FIXME: NK - this is not mikrotik specific
if ($config->{'enable_mikrotik'}) {
# FIXME: NK - We should cap the maximum total session time to that which is already set, if something is set
# Setup reply attributes for Mikrotik HotSpots
my %attribute = (
'Name' => 'Session-Timeout',
'Operator' => '=',
'Value' => $uptimeLimitWithTopups - $accountingUsage->{'TotalSessionTime'}
);
setReplyAttribute($server,$user->{'ReplyAttributes'},\%attribute);
}
}
}
# Traffic
if (defined($trafficLimit)) {
# Capped
if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalDataUsage'}.
"Mbyte exceeds allowed limit of ".$trafficLimitWithTopups."Mbyte");
return MOD_RES_NACK;
# Setup limits
} else {
# Check if we returning Mikrotik vattributes
if ($config->{'enable_mikrotik'}) {
# Get remaining traffic
my $remainingTraffic = $trafficLimitWithTopups - $accountingUsage->{'TotalDataUsage'};
my $remainingTrafficLimit = ( $remainingTraffic % 4096 ) * 1024 * 1024;
my $remainingTrafficGigawords = floor($remainingTraffic / 4096);
# Setup reply attributes for Mikrotik HotSpots
foreach my $attrName ('Recv','Xmit','Total') {
my %attribute = (
'Vendor' => 14988,
'Name' => "Mikrotik-$attrName-Limit",
'Operator' => '=',
# Gigawords leftovers
'Value' => $remainingTrafficLimit
);
setReplyVAttribute($server,$user->{'ReplyVAttributes'},\%attribute);
%attribute = (
'Vendor' => 14988,
'Name' => "Mikrotik-$attrName-Limit-Gigawords",
'Operator' => '=',
# Gigawords
'Value' => $remainingTrafficGigawords
);
setReplyVAttribute($server,$user->{'ReplyVAttributes'},\%attribute);
}
}
}
}
return MOD_RES_ACK;
}
## @post_acct_hook($server,$user,$packet)
# Post authentication hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub post_acct_hook
{
my ($server,$user,$packet) = @_;
# We cannot cap a user if we don't have a UserDB module can we? no userdb, no cap?
return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
# User is either connecting 'START' or disconnecting 'STOP'
return MOD_RES_SKIP if ($packet->rawattr('Acct-Status-Type') ne "1" && $packet->rawattr('Acct-Status-Type') ne "3");
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] POST ACCT HOOK");
#
# Get limits from attributes
#
my $uptimeLimit = _getAttributeKeyLimit($server,$user,$UPTIME_LIMIT_ATTRIBUTE);
my $trafficLimit = _getAttributeKeyLimit($server,$user,$TRAFFIC_LIMIT_ATTRIBUTE);
# Swap around 0 and undef if we need to apply the captrafzero caveat
if ($config->{'caveat_captrafzero'}) {
if (!defined($uptimeLimit)) {
$uptimeLimit = 0;
} elsif ($uptimeLimit == 0) {
$uptimeLimit = undef;
}
if (!defined($trafficLimit)) {
$trafficLimit = 0;
} elsif ($trafficLimit == 0) {
$trafficLimit = undef;
}
}
#
# Get current traffic and uptime usage
#
#
my $accountingUsage = _getAccountingUsage($server,$user,$packet);
if (!defined($accountingUsage)) {
return MOD_RES_SKIP;
}
#
# Get valid traffic and uptime topups
#
# Check if there was any data returned at all
my $uptimeTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_TOPUP_ATTRIBUTE) // 0;
my $trafficTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_TOPUP_ATTRIBUTE) // 0;
#
# Set the new uptime and traffic limits (limit, if any.. + topups)
#
# Uptime..
# // is a defined operator, $a ? defined($a) : $b
my $uptimeLimitWithTopups = ($uptimeLimit // 0) + $uptimeTopupAmount;
# Traffic..
# // is a defined operator, $a ? defined($a) : $b
my $trafficLimitWithTopups = ($trafficLimit // 0) + $trafficTopupAmount;
#
# Do auto-topups for both traffic and uptime
#
my $autoTopupTrafficAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalDataUsage'},"traffic",
$trafficLimitWithTopups,1);
if (defined($autoTopupTrafficAdded)) {
$trafficLimitWithTopups += $autoTopupTrafficAdded;
}
my $autoTopupUptimeAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalSessionTime'},"uptime",
$uptimeLimitWithTopups,2);
if (defined($autoTopupUptimeAdded)) {
$uptimeLimitWithTopups += $autoTopupUptimeAdded;
}
#
# Display our usages
#
_logUsage($server,$accountingUsage->{'TotalDataUsage'},$trafficLimit,$trafficTopupAmount,'traffic');
_logUsage($server,$accountingUsage->{'TotalSessionTime'},$uptimeLimit,$uptimeTopupAmount,'uptime');
#
# Add conditional variables
#
# Add attribute conditionals BEFORE override
addAttributeConditionalVariable($user,"SMRadius_Capping_TotalDataUsage",$accountingUsage->{'TotalDataUsage'});
addAttributeConditionalVariable($user,"SMRadius_Capping_TotalSessionTime",$accountingUsage->{'TotalSessionTime'});
#
# Allow for capping overrides by user attribute
#
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'})) {
my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'}});
my $newLimit = $uptimeLimitWithTopups * $multiplier;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User cap uptime multiplier '$multiplier' changes limit ".
"from '$uptimeLimitWithTopups' to '$newLimit'");
$uptimeLimitWithTopups = $newLimit;
}
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'})) {
my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'}});
my $newLimit = $trafficLimitWithTopups * $multiplier;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User cap traffic multiplier '$multiplier' changes limit ".
"from '$trafficLimitWithTopups' to '$newLimit'");
$trafficLimitWithTopups = $newLimit;
}
#
# Check if we've exceeded our limits
#
# Uptime..
if (defined($uptimeLimit)) {
# Capped
if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalSessionTime'}.
"min exceeds allowed limit of ".$uptimeLimitWithTopups."min");
return MOD_RES_NACK;
}
}
# Traffic
if (defined($trafficLimit)) {
# Capped
if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalDataUsage'}.
"Mbyte exceeds allowed limit of ".$trafficLimitWithTopups."Mbyte");
return MOD_RES_NACK;
}
}
return MOD_RES_ACK;
}
## @internal
# Code snippet to grab the current attribute key limit by processing the user attributes
sub _getAttributeKeyLimit
{
my ($server,$user,$attributeKey) = @_;
# Short circuit return if we don't have the uptime key set
return if (!defined($user->{'Attributes'}->{$attributeKey}));
# Short circuit if we do not have a valid attribute operator: ':='
if (!defined($user->{'Attributes'}->{$attributeKey}->{':='})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] No valid operators for attribute '".
$user->{'Attributes'}->{$attributeKey}."'");
return;
}
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Attribute '".$attributeKey."' is defined");
# Check for valid attribute value
if (!defined($user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}) ||
$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'} !~ /^\d+$/) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Attribute '".$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}.
"' is NOT a numeric value");
return;
}
return $user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'};
}
## @internal
# Code snippet to grab the current accounting usage of a user
sub _getAccountingUsage
{
my ($server,$user,$packet) = @_;
foreach my $module (@{$server->{'module_list'}}) {
# Do we have the correct plugin?
if (defined($module->{'Accounting_getUsage'})) {
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Found plugin: '".$module->{'Name'}."'");
# Fetch users session uptime & bandwidth used
if (my $res = $module->{'Accounting_getUsage'}($server,$user,$packet)) {
return $res;
}
$server->log(LOG_ERR,"[MOD_FEATURE_CAPPING] No usage data found for user '".$user->{'Username'}."'");
}
}
return;
}
## @internal
# Code snippet to log our uptime usage
sub _logUsage
{
my ($server,$accountingUsage,$limit,$topupAmount,$type) = @_;
my $typeKey = ucfirst($type);
# Check if our limit is defined
if (defined($limit) && $limit == 0) {
$limit = '-topup-';
} else {
$limit = '-none-';
}
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Capping information [type: %s, total: %s, limit: %s, topups: %s]",
$type,$accountingUsage,$limit,$topupAmount);
return;
}
## @internal
# Function snippet to return a user attribute
sub _getConfigAttributeNumeric
{
my ($server,$user,$attributeName) = @_;
# Short circuit if the attribute does not exist
return 0 if (!defined($user->{'ConfigAttributes'}->{$attributeName}));
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Config attribute '".$attributeName."' is defined");
# Check for value
if (!defined($user->{'ConfigAttributes'}->{$attributeName}->[0])) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Config attribute '".$attributeName."' has no value");
return 0;
}
# Is it a number?
if ($user->{'ConfigAttributes'}->{$attributeName}->[0] !~ /^\d+$/) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Config attribute '".$user->{'ConfigAttributes'}->{$attributeName}->[0].
"' is NOT a numeric value");
return 0;
}
return $user->{'ConfigAttributes'}->{$attributeName}->[0];
}
## @internal
# Function snippet to return a attribute
sub _getAttribute
{
my ($server,$user,$attributeName) = @_;
# Check the attribute exists
return if (!defined($user->{'Attributes'}->{$attributeName}));
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' is defined");
# Check the required operator is present in this case :=
if (!defined($user->{'Attributes'}->{$attributeName}->{':='})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no ':=' operator");
return;
}
# Check the operator value is defined...
if (!defined($user->{'Attributes'}->{$attributeName}->{':='}->{'Value'})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no value");
return;
}
return $user->{'Attributes'}->{$attributeName}->{':='}->{'Value'};
}
## @internal
# Function which impelments our auto-topup functionality
sub _doAutoTopup
{
my ($server,$user,$accountingUsage,$type,$usageLimit,$topupType) = @_;
my $scfg = $server->{'inifile'};
# Get the key, which has the first letter uppercased
my $typeKey = ucfirst($type);
# Booleanize the attribute and check if its enabled
if (my $enabled = booleanize(_getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Enabled"))) {
$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups for %s is enabled',$type);
} else {
$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] AutoTopups for %s is not enabled',$type);
return;
}
# Do sanity checks on the auto-topup amount
my $autoTopupAmount = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Amount");
if (!defined($autoTopupAmount)) {
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Amount must have a value',$typeKey);
return;
}
if (!isNumber($autoTopupAmount)){
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Amount must be a number and be > 0, instead it was '.
'\'%s\', IGNORING SMRadius-AutoTopup-%s-Enabled',$typeKey,$autoTopupAmount,$typeKey);
return;
}
# Do sanity checks on the auto-topup threshold
my $autoTopupThreshold = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Threshold");
if (defined($autoTopupThreshold) && !isNumber($autoTopupThreshold)){
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Threshold must be a number and be > 0, instead it was '.
'\'%s\', IGNORING SMRadius-AutoTopup-%s-Threshold',$typeKey,$autoTopupAmount,$typeKey);
$autoTopupThreshold = undef;
}
# Check that if the auto-topup limit is defined, that it is > 0
my $autoTopupLimit = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Limit");
if (defined($autoTopupLimit) && !isNumber($autoTopupLimit)) {
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Limit must be a number and be > 0, instead it was '.
'\'%s\', IGNORING SMRadius-AutoTopup-%s-Enabled',$typeKey,$autoTopupAmount,$typeKey);
return;
}
# Pull in ahow many auto-topups were already added
my $autoTopupsAdded = _getConfigAttributeNumeric($server,$user,"SMRadius-Capping-$typeKey-AutoTopup") // 0;
# Default to an auto-topup threshold of the topup amount divided by two if none has been provided
$autoTopupThreshold //= floor($autoTopupAmount / 2);
# Check if we're still within our usage limit and return
if (($usageLimit + $autoTopupsAdded - $accountingUsage) > $autoTopupThreshold) {
$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s: CHECK => usageLimit(%s) + autoTopupsAdded(%s) - '.
'accountingUsage(%s) < autoTopupThreshold(%s) = not eligble for auto-topup yet',$typeKey,
$usageLimit,$autoTopupsAdded,$accountingUsage,$autoTopupThreshold);
return;
} else {
$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s: CHECK => usageLimit(%s) + autoTopupsAdded(%s) - '.
'accountingUsage(%s) < autoTopupThreshold(%s) = eligble, processing',$typeKey,
$usageLimit,$autoTopupsAdded,$accountingUsage,$autoTopupThreshold);
}
# Check the difference between our accounting usage and our usage limit
my $usageDelta = $accountingUsage - $usageLimit;
# Make sure our delta is at least 0
$usageDelta = 0 if ($usageDelta < 0);
# Calculate how many topups are needed
my $autoTopupsRequired = floor($usageDelta / $autoTopupAmount) + 1;
# Default the topups to add to the number required
my $autoTopupsToAdd = $autoTopupsRequired;
# If we have an auto-topup limit, recalculate how many we must add... maybe it exceeds
if (defined($autoTopupLimit)) {
my $autoTopupsAllowed = floor(($autoTopupLimit - $autoTopupsAdded) / $autoTopupAmount);
$autoTopupsToAdd = min($autoTopupsRequired,$autoTopupsAllowed);
# We cannot add a negative amount of auto-topups, if we have a negative amount, we have hit our limit
$autoTopupsToAdd = 0 if ($autoTopupsToAdd < 0);
}
# Total topup amount
my $autoTopupsToAddAmount = $autoTopupsToAdd * $autoTopupAmount;
# The datetime now
my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
# Use truncate to set all values after 'month' to their default values
my $thisMonth = $now->clone()->truncate( to => "month" );
# This month, in string form
my $thisMonth_str = $thisMonth->strftime("%Y-%m-%d");
# Next month..
my $nextMonth = $thisMonth->clone()->add( months => 1 );
my $nextMonth_str = $nextMonth->strftime("%Y-%m-%d");
# Lets see if a module accepts to add a topup
my $res;
foreach my $module (@{$server->{'module_list'}}) {
# Do we have the correct plugin?
if (defined($module->{'Feature_Config_Topop_add'})) {
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Found plugin: '".$module->{'Name'}."'");
# Try add topup
$res = $module->{'Feature_Config_Topop_add'}($server,$user,$thisMonth_str,$nextMonth_str,
($topupType | 4),$autoTopupAmount);
# Skip to end if we added a topup
if ($res == MOD_RES_ACK) {
my $topupsRemaining = $autoTopupsToAdd - 1;
while ($topupsRemaining > 0) {
# Try add another topup
$res = $module->{'Feature_Config_Topop_add'}($server,$user,$thisMonth_str,$nextMonth_str,
($topupType | 4),$autoTopupAmount);
$topupsRemaining--;
}
last;
}
}
}
# If not, return undef
if (!defined($res) || $res != MOD_RES_ACK) {
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] Auto-Topup(s) cannot be added, no module replied with ACK');
return;
}
$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] Auto-Topups added [type: %s, threshold: %s, amount: %s, required: %s, limit: %s, added: %s]',
$type,$autoTopupThreshold,$autoTopupAmount,$autoTopupsRequired,$autoTopupLimit,$autoTopupsToAdd);
# Grab notify destinations
my $notify;
if (!defined($notify = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Notify"))) {
$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify destination is not specified, NOT notifying');
goto END;
}
$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify destination is \'%s\'',$notify);
# Grab notify template
my $notifyTemplate;
if (!defined($notifyTemplate = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-NotifyTemplate"))) {
$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify template is not specified, NOT notifying');
goto END;
}
# NOTE: $autoTopupToAdd and autoTopupsToAddAmount will be 0 if no auto-topups were added
# Create variable hash to pass to TT
my $variables = {
'user' => {
'ID' => $user->{'ID'},
'username' => $user->{'Username'},
},
'usage' => {
'total' => $accountingUsage,
'limit' => $usageLimit,
},
'autotopup' => {
'amount' => $autoTopupAmount,
'limit' => $autoTopupLimit,
'added' => $autoTopupsAdded,
'toAdd' => $autoTopupsToAdd,
'toAddAmount' => $autoTopupsToAddAmount,
},
};
# Split off notification targets
my @notificationTargets = split(/[,;\s]+/,$notify);
foreach my $notifyTarget (@notificationTargets) {
# Parse template
my ($notifyMsg,$error) = quickTemplateToolkit($notifyTemplate,{
%{$variables},
'notify' => { 'target' => $notifyTarget }
});
# Check if we have a result, if not, report the error
if (!defined($notifyMsg)) {
my $errorMsg = $error->info();
$errorMsg =~ s/\r?\n/\\n/g;
$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] AutoTopups notify template parsing failed: %s',$errorMsg);
next;
}
my %messageHeaders = ();
# Split message into lines
my @lines = split(/\r?\n/,$notifyMsg);
while (defined($lines[0]) && (my $line = $lines[0]) =~ /(\S+): (.*)/) {
my ($header,$value) = ($1,$2);
$messageHeaders{$header} = $value;
# Remove line
shift(@lines);
# Last if our next line is undefined
last if (!defined($lines[0]));
# If the next line is blank, remove it, and continue below
if ($lines[0] =~ /^\s*$/) {
# Remove blank line
shift(@lines);
last;
}
}
# Create message
my $msg = MIME::Lite->new(
'Type' => 'multipart/mixed',
'Date' => $now->strftime('%a, %d %b %Y %H:%M:%S %z'),
%messageHeaders
);
# Attach body
$msg->attach(
'Type' => 'TEXT',
'Encoding' => '8bit',
'Data' => join("\n",@lines),
);
# Send email
my $smtpServer = $scfg->{'server'}{'smtp_server'} // 'localhost';
eval { $msg->send("smtp",$smtpServer); };
if (my $error = $@) {
$server->log(LOG_WARN,"[MOD_FEATURE_CAPPING] Email sending failed: '%s'",$error);
}
}
END:
return $autoTopupsToAddAmount;
}
1;
# vim: ts=4
lib/smradius/modules/features/mod_feature_fup.pm 0 → 100644
View file @ b659b33b
# FUP support
# Copyright (C) 2007-2019, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::features::mod_feature_fup;
use strict;
use warnings;
# Modules we need
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::util;
use AWITPT::Util;
use List::Util qw( min );
use MIME::Lite;
use POSIX qw( floor );
# Set our version
our $VERSION = "0.0.1";
# Load exporter
use base qw(Exporter);
our @EXPORT = qw(
);
our @EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "User FUP Feature",
Init => \&init,
# Authentication hook
'Feature_Post-Authentication_hook' => \&post_auth_hook,
# Accounting hook
'Feature_Post-Accounting_hook' => \&post_acct_hook,
};
# Some constants
my $FUP_PERIOD_ATTRIBUTE = 'SMRadius-FUP-Period';
my $FUP_TRAFFIC_THRESHOLD_ATTRIBUTE = 'SMRadius-FUP-Traffic-Threshold';
my $config;
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Defaults
$config->{'enable_mikrotik'} = 0;
# Setup SQL queries
if (defined($scfg->{'mod_feature_fup'})) {
# Check if option exists
if (defined($scfg->{'mod_feature_fup'}{'enable_mikrotik'})) {
# Pull in config
if (defined(my $val = isBoolean($scfg->{'mod_feature_fup'}{'enable_mikrotik'}))) {
if ($val) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Mikrotik-specific vendor return attributes ENABLED");
$config->{'enable_mikrotik'} = $val;
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Value for 'enable_mikrotik' is invalid");
}
}
}
return;
}
## @post_auth_hook($server,$user,$packet)
# Post authentication hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub post_auth_hook
{
my ($server,$user,$packet) = @_;
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] POST AUTH HOOK");
#
# Get threshold from attributes
#
my $fupPeriod = _getAttributeKeyNumeric($server,$user,$FUP_PERIOD_ATTRIBUTE);
my $trafficThreshold = _getAttributeKeyNumeric($server,$user,$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE);
# If we have no FUP period, skip
if (!defined($fupPeriod)) {
return MOD_RES_SKIP;
};
# If we have no traffic threshold, display an info message and skip
if (!defined($trafficThreshold)) {
$server->log(LOG_INFO,"[MOD_FEATURE_FUP] User has a '$FUP_PERIOD_ATTRIBUTE' defined, but NOT a ".
"'$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE' attribute, aborting FUP checks.");
return MOD_RES_SKIP;
};
#
# Get current traffic and uptime usage
#
my $accountingUsage = _getAccountingUsage($server,$user,$packet,$fupPeriod);
if (!defined($accountingUsage)) {
return MOD_RES_SKIP;
}
#
# Display our FUP info
#
_logUsage($server,$fupPeriod,$accountingUsage->{'TotalDataUsage'},$trafficThreshold);
#
# Check if the user has exceeded the FUP
#
my $fupExceeded = ($accountingUsage->{'TotalDataUsage'} > $trafficThreshold) ? 1 : 0;
#
# Add conditional variables
#
addAttributeConditionalVariable($user,"SMRadius_FUP",$fupExceeded);
return MOD_RES_ACK;
}
## @post_acct_hook($server,$user,$packet)
# Post authentication hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub post_acct_hook
{
my ($server,$user,$packet) = @_;
# We cannot cap a user if we don't have a UserDB module can we? no userdb, no cap?
return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
# User is either connecting 'START' or disconnecting 'STOP'
return MOD_RES_SKIP if ($packet->rawattr('Acct-Status-Type') ne "1" && $packet->rawattr('Acct-Status-Type') ne "3");
$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] POST ACCT HOOK");
#
# Get threshold from attributes
#
my $fupPeriod = _getAttributeKeyNumeric($server,$user,$FUP_PERIOD_ATTRIBUTE);
my $trafficThreshold = _getAttributeKeyNumeric($server,$user,$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE);
# If we have no FUP period, skip
if (!defined($fupPeriod)) {
return MOD_RES_SKIP;
};
# If we have no traffic threshold, display an info message and skip
if (!defined($trafficThreshold)) {
$server->log(LOG_INFO,"[MOD_FEATURE_FUP] User has a '$FUP_PERIOD_ATTRIBUTE' defined, but NOT a ".
"'$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE' attribute, aborting FUP checks.");
return MOD_RES_SKIP;
};
#
# Get current traffic and uptime usage
#
my $accountingUsage = _getAccountingUsage($server,$user,$packet,$fupPeriod);
if (!defined($accountingUsage)) {
return MOD_RES_SKIP;
}
#
# Display our FUP info
#
_logUsage($server,$fupPeriod,$accountingUsage->{'TotalDataUsage'},$trafficThreshold);
#
# Check if the user has exceeded the FUP
#
my $fupExceeded = ($accountingUsage->{'TotalDataUsage'} > $trafficThreshold) ? 1 : 0;
#
# Add conditional variables
#
addAttributeConditionalVariable($user,"SMRadius_FUP",$fupExceeded);
return MOD_RES_ACK;
}
## @internal
# Code snippet to grab the current uptime limit by processing the user attributes
sub _getAttributeKeyNumeric
{
my ($server,$user,$attributeKey) = @_;
# Short circuit return if we don't have the uptime key set
return if (!defined($user->{'Attributes'}->{$attributeKey}));
# Short circuit if we do not have a valid attribute operator: ':='
if (!defined($user->{'Attributes'}->{$attributeKey}->{':='})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] No valid operators for attribute '".
$user->{'Attributes'}->{$attributeKey}."'");
return;
}
$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] Attribute '".$attributeKey."' is defined");
# Check for valid attribute value
if (!defined($user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}) ||
$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'} !~ /^\d+$/) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Attribute '".$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}.
"' is NOT a numeric value");
return;
}
return $user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'};
}
## @internal
# Code snippet to grab the accounting usage of a user for a specific period
sub _getAccountingUsage
{
my ($server,$user,$packet,$period) = @_;
foreach my $module (@{$server->{'module_list'}}) {
# Do we have the correct plugin?
if (defined($module->{'Accounting_getUsage'})) {
$server->log(LOG_INFO,"[MOD_FEATURE_FUP] Found plugin: '".$module->{'Name'}."'");
# Fetch users session uptime & bandwidth used for a specific period
if (my $res = $module->{'Accounting_getUsage'}($server,$user,$packet,$period)) {
return $res;
}
$server->log(LOG_ERR,"[MOD_FEATURE_FUP] No usage data found for user '".$user->{'Username'}."'");
}
}
return;
}
## @internal
# Code snippet to log our FUP information
sub _logUsage
{
my ($server,$period,$total,$threshold) = @_;
$server->log(LOG_INFO,"[MOD_FEATURE_FUP] FUP information [period: %s days, total: %s, threshold: %s]",
$period,$total,$threshold);
return;
}
## @internal
# Function snippet to return a attribute
sub _getAttribute
{
my ($server,$user,$attributeName) = @_;
# Check the attribute exists
return if (!defined($user->{'Attributes'}->{$attributeName}));
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' is defined");
# Check the required operator is present in this case :=
if (!defined($user->{'Attributes'}->{$attributeName}->{':='})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no ':=' operator");
return;
}
# Check the operator value is defined...
if (!defined($user->{'Attributes'}->{$attributeName}->{':='}->{'Value'})) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no value");
return;
}
return $user->{'Attributes'}->{$attributeName}->{':='}->{'Value'};
}
1;
# vim: ts=4
lib/smradius/modules/features/mod_feature_update_user_stats_sql.pm 0 → 100644
View file @ b659b33b
# Support for updating of user stats
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::features::mod_feature_update_user_stats_sql;
use strict;
use warnings;
# Modules we need
use smradius::constants;
use AWITPT::DB::DBLayer;
use smradius::logging;
use smradius::util;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "Update User Stats",
Init => \&init,
# Accounting hook
'Feature_Post-Accounting_hook' => \&updateUserStats
};
# Module config
my $config;
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Enable support for database
$server->log(LOG_NOTICE,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Enabling database support");
if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Enabling database support.");
$server->{'smradius'}->{'database'}->{'enabled'} = 1;
}
# Default configs...
$config->{'update_user_stats_query'} = '
UPDATE
@TP@users
SET
PeriodKey = %{query.PeriodKey},
TotalTraffic = %{query.TotalTraffic},
TotalUptime = %{query.TotalUptime},
NASIdentifier = %{request.NAS-Identifier},
LastAcctUpdate = now()
WHERE
Username = %{user.Username}
';
# Setup SQL queries
if (defined($scfg->{'mod_feature_update_user_stats_sql'})) {
# Pull in queries
if (defined($scfg->{'mod_feature_update_user_stats_sql'}->{'update_user_stats_query'}) &&
$scfg->{'mod_feature_update_user_stats_sql'}->{'update_user_stats_query'} ne "") {
if (ref($scfg->{'mod_feature_update_user_stats_sql'}->{'update_user_stats_query'}) eq "ARRAY") {
$config->{'update_user_stats_query'} = join(' ',
@{$scfg->{'mod_feature_update_user_stats_sql'}->{'update_user_stats_query'}});
} else {
$config->{'update_user_stats_query'} = $scfg->{'mod_feature_update_user_stats_sql'}->{'update_user_stats_query'};
}
}
}
}
## @updateUserStats($server,$user,$packet)
# Post authentication hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub updateUserStats
{
my ($server,$user,$packet) = @_;
# Skip MAC authentication
return MOD_RES_SKIP if (defined($user->{'_UserDB'}->{'Name'}) &&
$user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] UPDATE USER STATS HOOK");
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Current PeriodKey
my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
$template->{'query'}->{'PeriodKey'} = $now->strftime("%Y-%m");
# Loop with plugins to find anything supporting getting of usage
my $accountingUsage;
foreach my $module (@{$server->{'module_list'}}) {
# Do we have the correct plugin?
if ($module->{'Accounting_getUsage'}) {
$server->log(LOG_INFO,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Found plugin: '".$module->{'Name'}."'");
# Fetch users session uptime & bandwidth used
my $res = $module->{'Accounting_getUsage'}($server,$user,$packet);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] No usage data found for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
}
$accountingUsage = $res;
}
}
# Add to our template hash
$template->{'query'}->{'TotalTraffic'} = $accountingUsage->{'TotalDataUsage'};
$template->{'query'}->{'TotalUptime'} = $accountingUsage->{'TotalSessionTime'};
# Replace template entries
my (@dbDoParams) = templateReplace($config->{'update_user_stats_query'},$template);
# Perform query
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Database query failed: ".AWITPT::DB::DBLayer::error());
return;
}
return MOD_RES_ACK;
}
1;
# vim: ts=4
lib/smradius/modules/features/mod_feature_user_stats.pm 0 → 100644
View file @ b659b33b
# Support for updating user data
# Copyright (C) 2007-2011, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::features::mod_feature_user_stats;
use strict;
use warnings;
# Modules we need
use smradius::constants;
use AWITPT::DB::DBLayer;
use smradius::logging;
use smradius::util;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "User Stats",
Init => \&init,
# Accounting hook
'Feature_Post-Accounting_hook' => \&updateUserStats,
# 'Feature_Post-Accounting_hook' => \&getUserStats
};
## @internal
# Initialize module
sub init
{
my $server = shift;
}
## @updateUserStats($server,$user,$packet)
# Post accounting hook
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub updateUserStats
{
my ($server,$user,$packet) = @_;
# We cannot cap a user if we don't have a UserDB module can we? no userdb, no means to store info?
return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_FEATURE_UPDATE_USER_STATS] UPDATE USER STATS HOOK");
# Variables we are going to set
my $currentUsage;
# Loop with plugins to find anything supporting getting of usage
foreach my $module (@{$server->{'module_list'}}) {
# Do we have the correct plugin?
if ($module->{'Accounting_getUsage'}) {
$server->log(LOG_INFO,"[MOD_USERS_DATA] Found plugin: '".$module->{'Name'}."'");
# Fetch users session uptime & bandwidth used
my $res = $module->{'Accounting_getUsage'}($server,$user,$packet);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] No usage data found for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
}
$currentUsage = $res;
}
}
# Do we have the correct plugin?
if ($user->{'_UserDB'}->{'Users_data_set'}) {
$server->log(LOG_INFO,"[MOD_USERS_DATA] Found plugin: '".$user->{'_UserDB'}->{'Name'}."'");
# Set user traffic usage
my $res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
'mod_feature_user_stats','CurrentMonthTotalTraffic',
$currentUsage->{'TotalDataUsage'}
);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store current month traffic usage for user '"
.$user->{'Username'}."'");
return MOD_RES_SKIP;
}
# Set user uptime usage
$res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
'mod_feature_user_stats','CurrentMonthTotalUptime',
$currentUsage->{'TotalSessionTime'}
);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store current month uptime usage for user '"
.$user->{'Username'}."'");
return MOD_RES_SKIP;
}
# Set NAS-Identifier
if (defined(my $NASIdentifier = $packet->rawattr('NAS-Identifier'))) {
$res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
'mod_feature_user_stats','NAS-Identifier',
$NASIdentifier
);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store NAS-Identifier for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
}
}
# Set Framed-IP-Address
if (defined(my $framedIPAddress = $packet->rawattr('Framed-IP-Address'))) {
$res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
'mod_feature_user_stats','Framed-IP-Address',
$framedIPAddress
);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store Framed-IP-Address for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
}
}
# Set user FUP state
# NK: Perhaps this should be moved to the mod_feature_fup module?
my $fupState = $user->{'AttributeConditionalVariables'}->{"SMRadius_FUP"};
if (defined($fupState)) {
$fupState = $fupState->[0];
} else {
$fupState = "-1";
}
$res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
'mod_feature_fup','State',
$fupState
);
if (!defined($res)) {
$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store FUP state for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
}
}
return MOD_RES_ACK;
}
1;
# vim: ts=4
lib/smradius/modules/features/mod_feature_validity.pm 0 → 100644
View file @ b659b33b
# Validity support
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::features::mod_feature_validity;
use strict;
use warnings;
# Modules we need
use smradius::constants;
use smradius::logging;
use smradius::util;
use DateTime;
use Date::Parse;
# Exporter stuff
use base qw(Exporter);
our @EXPORT = qw(
);
our @EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "User Validity Feature",
Init => \&init,
# Authentication hook
'Feature_Post-Authentication_hook' => \&checkValidity,
'Feature_Post-Accounting_hook' => \&checkValidity
};
# Some constants
my $VALID_FROM_KEY = 'SMRadius-Validity-ValidFrom';
my $VALID_TO_KEY = 'SMRadius-Validity-ValidTo';
my $VALID_WINDOW_KEY = 'SMRadius-Validity-ValidWindow';
## @internal
# Initialize module
sub init
{
my $server = shift;
}
## @checkValidity($server,$user,$packet)
# Check Validity based on date
#
# @param server Server object
# @param user User data
# @param packet Radius packet
#
# @return Result
sub checkValidity
{
my ($server,$user,$packet) = @_;
# We cannot cap a user if we don't have a UserDB module can we? no userdb, no validity?
return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] POST AUTH HOOK");
my ($validFrom,$validTo,$validWindow);
# Get validity start date
if (defined($user->{'Attributes'}->{$VALID_FROM_KEY})) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] '".$VALID_FROM_KEY."' is defined");
# Operator: :=
if (defined($user->{'Attributes'}->{$VALID_FROM_KEY}->{':='})) {
# Is it formatted as a date?
if ($user->{'Attributes'}->{$VALID_FROM_KEY}->{':='}->{'Value'} =~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
$validFrom = $user->{'Attributes'}->{$VALID_FROM_KEY}->{':='}->{'Value'};
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] '".$user->{'Attributes'}->{$VALID_FROM_KEY}->{':='}->{'Value'}.
"' is NOT in ISO standard format 'YYYY-MM-DD'");
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] No valid operators for attribute '$VALID_FROM_KEY'");
} # if (defined($user->{'Attributes'}->{$VALID_FROM_KEY}->{':='})) {
} # if (defined($user->{'Attributes'}->{$VALID_FROM_KEY})) {
# Get validity end date
if (defined($user->{'Attributes'}->{$VALID_TO_KEY})) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] '".$VALID_TO_KEY."' is defined");
# Operator: :=
if (defined($user->{'Attributes'}->{$VALID_TO_KEY}->{':='})) {
# Is it formatted as a date?
if ($user->{'Attributes'}->{$VALID_TO_KEY}->{':='}->{'Value'} =~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
$validTo = $user->{'Attributes'}->{$VALID_TO_KEY}->{':='}->{'Value'};
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] '".$user->{'Attributes'}->{$VALID_TO_KEY}->{':='}->{'Value'}.
"' is NOT an ISO standard format 'YYYY-MM-DD'");
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] No valid operators for attribute '$VALID_TO_KEY'");
} # if (defined($user->{'Attributes'}->{$VALID_TO_KEY}->{':='})) {
} # if (defined($user->{'Attributes'}->{$VALID_TO_KEY})) {
# Get validity window
if (defined($user->{'Attributes'}->{$VALID_WINDOW_KEY})) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] '".$VALID_WINDOW_KEY."' is defined");
# Operator: :=
if (defined($user->{'Attributes'}->{$VALID_WINDOW_KEY}->{':='})) {
# Is it a number?
if ($user->{'Attributes'}->{$VALID_WINDOW_KEY}->{':='}->{'Value'} =~ /^\d+$/) {
$validWindow = $user->{'Attributes'}->{$VALID_WINDOW_KEY}->{':='}->{'Value'};
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] '".$user->{'Attributes'}->{$VALID_WINDOW_KEY}->{':='}->{'Value'}.
"' is NOT an integer");
}
} else {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] No valid operators for attribute '$VALID_WINDOW_KEY'");
} # if (defined($user->{'Attributes'}->{$VALID_WINDOW_KEY}->{':='})) {
} # if (defined($user->{'Attributes'}->{$VALID_WINDOW_KEY})) {
# Now ...
my $now = $user->{'_Internal'}->{'Timestamp-Unix'};
# Do we have a begin date?
if (defined($validFrom)) {
# Convert string to datetime
my $validFrom_unixtime = str2time($validFrom,$server->{'smradius'}->{'event_timezone'});
if (!defined($validFrom_unixtime)) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] Date conversion failed on '%s'",$validFrom);
# If current time before start of valid pariod
} elsif ($now < $validFrom_unixtime) {
my $pretty_dt = DateTime->from_epoch( epoch => $validFrom_unixtime )->strftime('%Y-%m-%d %H:%M:%S');
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid start date: '%s', rejecting",$pretty_dt);
# Date not within valid period, must be disconnected
return MOD_RES_NACK;
} # if (!defined($validFrom_unixtime)) {
} # if (defined($validFrom)) {
# Do we have an end date?
if (defined($validTo)) {
# Convert string to datetime
my $validTo_unixtime = str2time($validTo,$server->{'smradius'}->{'event_timezone'});
if (!defined($validTo_unixtime)) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Date conversion failed on '%s'",$validTo);
# If current time after start of valid pariod
} elsif ($now > $validTo_unixtime) {
my $pretty_dt = DateTime->from_epoch( epoch => $validTo_unixtime )->strftime('%Y-%m-%d %H:%M:%S');
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid end date: '%s', rejecting",$pretty_dt);
# Date not within valid period, must be disconnected
return MOD_RES_NACK;
} # if (!defined($validTo_unixtime)) {
} # if (defined($validTo)) {
# Do we have a validity window
if (defined($validWindow)) {
# Check first if we have the ability to support this feature
if (defined($user->{'_UserDB'}->{'Users_data_get'})) {
# Fetch users_data for first login
if (defined(my $res = $user->{'_UserDB'}->{'Users_data_get'}($server,$user,'global','FirstLogin'))) {
# Check if this user should be disconnected
if (defined($validWindow) && defined($res)) {
my $validUntil = $validWindow + $res->{'Value'};
# If current time after start of valid pariod
if ($now > $validUntil) {
my $pretty_dt = DateTime->from_epoch( epoch => $validUntil )->strftime('%Y-%m-%d %H:%M:%S');
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid window end date: '%s', ".
"rejecting",$pretty_dt);
# Date not within valid window, must be disconnected
return MOD_RES_NACK;
}
}
} else {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] No users_data 'global/FirstLogin' found for user '%s'",
$user->{'Username'});
} # if (defined(my $res = $module->{'Users_data_get'}($server,$user,'global','FirstLogin'))) {
} else {
$server->log(LOG_WARN,"[MOD_FEATURE_VALIDITY] UserDB module '%s' does not support 'users_data'. Therefore no ".
"support for Validity Window feature",$user->{'_UserDB'}->{'Name'});
} # if (defined($user->{'_UserDB'}->{'Users_data_get'})) {
}
return MOD_RES_ACK;
}
1;
# vim: ts=4
lib/smradius/modules/system/mod_config_sql.pm 0 → 100644
View file @ b659b33b
# SQL config database support
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::system::mod_config_sql;
use strict;
use warnings;
# Modules we need
use smradius::constants;
use smradius::logging;
use AWITPT::DB::DBLayer;
use AWITPT::Cache;
use AWITPT::NetIP;
use AWITPT::Util;
use smradius::util;
use smradius::attributes;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "SQL Config Database",
Init => \&init,
# User database
Config_get => \&getConfig,
};
# Module config
my $config;
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Enable support for database
if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Enabling database support.");
$server->{'smradius'}->{'database'}->{'enabled'} = 1;
}
# Default configs...
$config->{'get_config_realm_id_query'} = '
SELECT
ID
FROM
@TP@realms
WHERE
Name = ?
';
$config->{'get_config_realm_attributes_query'} = '
SELECT
Name,
Operator,
Value
FROM
@TP@realm_attributes
WHERE
RealmID = ?
';
$config->{'get_config_accesslist_query'} = '
SELECT
@TP@clients.AccessList,
@TP@clients.ID
FROM
@TP@clients,
@TP@clients_to_realms
WHERE
@TP@clients.ID = @TP@clients_to_realms.ClientID
AND @TP@clients_to_realms.RealmID = ?
';
$config->{'get_config_client_attributes_query'} = '
SELECT
Name,
Operator,
Value
FROM
@TP@client_attributes
WHERE
ClientID = ?
';
# Setup SQL queries
if (defined($scfg->{'mod_config_sql'})) {
# Pull in queries
if (defined($scfg->{'mod_config_sql'}->{'get_config_realm_id_query'}) &&
$scfg->{'mod_config_sql'}->{'get_config_realm_id_query'} ne "") {
if (ref($scfg->{'mod_config_sql'}->{'get_config_realm_id_query'}) eq "ARRAY") {
$config->{'get_config_realm_id_query'} = join(' ',@{$scfg->{'mod_config_sql'}->{'get_config_realm_id_query'}});
} else {
$config->{'get_config_realm_id_query'} = $scfg->{'mod_config_sql'}->{'get_config_realm_id_query'};
}
}
if (defined($scfg->{'mod_config_sql'}->{'get_config_realm_attributes_query'}) &&
$scfg->{'mod_config_sql'}->{'get_config_realm_attributes_query'} ne "") {
if (ref($scfg->{'mod_config_sql'}->{'get_config_realm_attributes_query'}) eq "ARRAY") {
$config->{'get_config_realm_attributes_query'} = join(' ',@{$scfg->{'mod_config_sql'}->{'get_config_realm_attributes_query'}});
} else {
$config->{'get_config_realm_attributes_query'} = $scfg->{'mod_config_sql'}->{'get_config_realm_attributes_query'};
}
}
if (defined($scfg->{'mod_config_sql'}->{'get_config_accesslist_query'}) &&
$scfg->{'mod_config_sql'}->{'get_config_accesslist_query'} ne "") {
if (ref($scfg->{'mod_config_sql'}->{'get_config_accesslist_query'}) eq "ARRAY") {
$config->{'get_config_accesslist_query'} = join(' ',@{$scfg->{'mod_config_sql'}->{'get_config_accesslist_query'}});
} else {
$config->{'get_config_accesslist_query'} = $scfg->{'mod_config_sql'}->{'get_config_accesslist_query'};
}
}
if (defined($scfg->{'mod_config_sql'}->{'get_config_client_attributes_query'}) &&
$scfg->{'mod_config_sql'}->{'get_config_client_attributes_query'} ne "") {
if (ref($scfg->{'mod_config_sql'}->{'get_config_client_attributes_query'}) eq "ARRAY") {
$config->{'get_config_client_attributes_query'} = join(' ',@{$scfg->{'mod_config_sql'}->{'get_config_client_attributes_query'}});
} else {
$config->{'get_config_client_attributes_query'} = $scfg->{'mod_config_sql'}->{'get_config_client_attributes_query'};
}
}
}
}
## @getConfig
# Try to get a config
#
# @param server Server object
# @param user User
# @param packet Radius packet
#
# @return Result
sub getConfig
{
my ($server,$user,$packet) = @_;
# Default realm...
my $realmName = '<DEFAULT>';
my $realmID;
# Get default realm ID
$server->log(LOG_DEBUG,"Processing DEFAULT realm attributes");
my $sth = DBSelect($config->{'get_config_realm_id_query'},$realmName);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get default realm ID: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Set realm ID
my $row;
if ($sth->rows == 1) {
$row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID));
$realmID = $row->{'ID'};
}
DBFreeRes($sth);
# Get default realm attributes
if (defined($realmID)) {
$sth = DBSelect($config->{'get_config_realm_attributes_query'},$realmID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get default realm config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Add any default realm attributes to config attributes
while (my $row = $sth->fetchrow_hashref()) {
processConfigAttribute($server,$user,hashifyLCtoMC($row, qw(Name Operator Value)));
}
DBFreeRes($sth);
}
# Extract realm from username
if (defined($user->{'Username'}) && $user->{'Username'} =~ /^\S+(?:@(\S+))?$/) {
my $userRealm = $1 // "";
$server->log(LOG_DEBUG,"Processing attributes for realm '$userRealm'");
$sth = DBSelect($config->{'get_config_realm_id_query'},$userRealm);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get realm config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Fetch realm ID
if ($sth->rows == 1) {
$row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID));
$realmID = $row->{'ID'};
DBFreeRes($sth);
# User realm attributes
$sth = DBSelect($config->{'get_config_realm_attributes_query'},$realmID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get realm config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Add any realm attributes to config attributes
while (my $row = $sth->fetchrow_hashref()) {
processConfigAttribute($server,$user,hashifyLCtoMC($row, qw(Name Operator Value)));
}
DBFreeRes($sth);
$realmName = $userRealm;
}
}
# Reject if there is no realm
if (!defined($realmID)) {
$server->log(LOG_DEBUG,"No realm configured, rejecting");
return MOD_RES_NACK;
}
$server->log(LOG_DEBUG,"Realm '$realmName' has ID '$realmID'");
# Get client name
my $clientID;
# Check Cache
my $doCheck = 1;
my ($cres,$val) = cacheGetComplexKeyPair('mod_config_sql',"access/".$server->{'server'}{'peeraddr'});
if (defined($val)) {
# Check if cache expired
if ($user->{'_Internal'}->{'Timestamp-Unix'} - $val->{'timestamp'} < 60) {
# Check if we were allowed access
if (defined($val->{'allowed'})) {
$clientID = $val->{'allowed'};
$server->log(LOG_INFO,"(CACHED) Got client ID '$clientID' from cache, bypassing accesslist check");
$doCheck = 0;
} else {
$server->log(LOG_INFO,"(CACHED) Peer Address '".$server->{'server'}{'peeraddr'}."' not found in access list");
}
}
}
# Do check
if ($doCheck) {
$server->log(LOG_DEBUG,"Processing access list for realm '$realmName'");
$sth = DBSelect($config->{'get_config_accesslist_query'},$realmID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Grab peer address object
my $peerAddrObj = AWITPT::NetIP->new($server->{'server'}{'peeraddr'});
# Check if we know this client
my @accessList;
while (my $row = $sth->fetchrow_hashref()) {
my $res = hashifyLCtoMC($row, qw(AccessList ID));
# Split off allowed sources, comma separated
@accessList = ();
@accessList = split(',',$res->{'AccessList'});
# Loop with what we get and check if we have match
foreach my $range (@accessList) {
my $rangeObj = AWITPT::NetIP->new($range);
# Check for match
if ($peerAddrObj->is_within($rangeObj)) {
$clientID = $res->{'ID'};
$server->log(LOG_INFO,"(SETCACHE) Got client ID '$clientID' from DB");
last;
}
}
}
DBFreeRes($sth);
if (!defined($clientID)) {
$server->log(LOG_NOTICE,"Peer Address '".$server->{'server'}{'peeraddr'}."' not found in access list");
return MOD_RES_NACK;
}
# Setup cached data
my %cacheData;
$cacheData{'allowed'} = $clientID;
$cacheData{'timestamp'} = $user->{'_Internal'}->{'Timestamp-Unix'};
cacheStoreComplexKeyPair('mod_config_sql',"access/".$server->{'server'}{'peeraddr'},\%cacheData);
}
# Get client attributes
$server->log(LOG_DEBUG,"Processing client attributes for '$clientID'");
if (defined($clientID)) {
my $sth = DBSelect($config->{'get_config_client_attributes_query'},$clientID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get default config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Add to config attributes
while (my $row = $sth->fetchrow_hashref()) {
processConfigAttribute($server,$user,hashifyLCtoMC($row, qw(Name Operator Value)));
}
DBFreeRes($sth);
}
return MOD_RES_ACK;
}
1;
# vim: ts=4
lib/smradius/modules/system/mod_config_sql_topups.pm 0 → 100644
View file @ b659b33b
# Topup support
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::system::mod_config_sql_topups;
use strict;
use warnings;
# Modules we need
use smradius::constants;
use smradius::logging;
use AWITPT::DB::DBLayer;
use AWITPT::Util;
use smradius::util;
use smradius::attributes;
use POSIX qw(ceil);
use DateTime;
use Date::Parse;
use Math::BigInt;
use Math::BigFloat;
# Exporter stuff
use base qw(Exporter);
our @EXPORT = qw(
);
our @EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "SQL Topup Config",
Init => \&init,
# Cleanup run by smadmin
CleanupOrder => 80,
Cleanup => \&cleanup,
# User database
Config_get => \&getTopups,
# Topups
Feature_Config_Topop_add => \&addTopup,
};
# Module config
my $config;
# Helper functions
sub _isTrafficTopup { my $val = shift; return ($val & 1) == 1; }
sub _isUptimeTopup { my $val = shift; return ($val & 2) == 2; }
sub _isAutoTopup { my $val = shift; return ($val & 4) == 4; }
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Enable support for database
if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Enabling database support.");
$server->{'smradius'}->{'database'}->{'enabled'} = 1;
}
# Default configs...
$config->{'get_topups_summary_query'} = '
SELECT
@TP@topups_summary.Balance,
@TP@topups.Type,
@TP@topups.ID
FROM
@TP@topups_summary,
@TP@topups,
@TP@users
WHERE
@TP@topups.ID = @TP@topups_summary.TopupID
AND @TP@topups.UserID = @TP@users.ID
AND @TP@topups_summary.PeriodKey = ?
AND @TP@topups.Depleted = 0
AND @TP@users.Username = ?
';
$config->{'get_topups_query'} = '
SELECT
@TP@topups.ID,
@TP@topups.Type,
@TP@topups.Value
FROM
@TP@topups,
@TP@users
WHERE
@TP@topups.UserID = @TP@users.ID
AND @TP@topups.ValidFrom = ?
AND @TP@topups.ValidTo >= ?
AND @TP@topups.Depleted = 0
AND @TP@users.Username = ?
';
$config->{'topups_add_query'} = '
INSERT INTO
@TP@topups
(
UserID,
Timestamp,
ValidFrom,
ValidTo,
Type,
Value,
Depleted
)
VALUES
(
%{user.ID},
%{query.Timestamp},
%{query.ValidFrom},
%{query.ValidTo},
%{query.Type},
%{query.Value},
%{query.Depleted}
)
';
# Setup SQL queries
if (defined($scfg->{'mod_config_sql_topups'})) {
# Pull in queries
if (defined($scfg->{'mod_config_sql_topups'}->{'get_topups_summary_query'}) &&
$scfg->{'mod_config_sql_topups'}->{'get_topups_summary_query'} ne "") {
if (ref($scfg->{'mod_config_sql_topups'}->{'get_topups_summary_query'}) eq "ARRAY") {
$config->{'get_topups_summary_query'} = join(' ',@{$scfg->{'mod_config_sql_topups'}->{'get_topups_summary_query'}});
} else {
$config->{'get_topups_summary_query'} = $scfg->{'mod_config_sql_topups'}->{'get_topups_summary_query'};
}
}
if (defined($scfg->{'mod_config_sql_topups'}->{'get_topups_query'}) &&
$scfg->{'mod_config_sql_topups'}->{'get_topups_query'} ne "") {
if (ref($scfg->{'mod_config_sql_topups'}->{'get_topups_query'}) eq "ARRAY") {
$config->{'get_topups_query'} = join(' ',@{$scfg->{'mod_config_sql_topups'}->{'get_topups_query'}});
} else {
$config->{'get_topups_query'} = $scfg->{'mod_config_sql_topups'}->{'get_topups_query'};
}
}
if (defined($scfg->{'mod_config_sql_topups'}->{'topups_add_query'}) &&
$scfg->{'mod_config_sql_topups'}->{'topups_add_query'} ne "") {
if (ref($scfg->{'mod_config_sql_topups'}->{'topups_add_query'}) eq "ARRAY") {
$config->{'topups_add_query'} = join(' ',@{$scfg->{'mod_config_sql_topups'}->{'topups_add_query'}});
} else {
$config->{'topups_add_query'} = $scfg->{'mod_config_sql_topups'}->{'topups_add_query'};
}
}
}
}
## @getTopups
# Try to get topup information
#
# @param server Server object
# @param user User
# @param packet Radius packet
#
# @return Result
sub getTopups
{
my ($server,$user,$packet) = @_;
# Fetch all summaries
my $trafficSummaries = {
'traffic' => 0,
'uptime' => 0,
'traffic-topup' => 0,
'uptime-topup' => 0,
'traffic-auto' => 0,
'uptime-auto' => 0,
};
# Check to see if we have a username
my $username = $user->{'Username'};
# Skip this module if we don't have a username
if (!defined($username)) {
return MOD_RES_SKIP;
}
# Make time for month begin
my $now = DateTime->from_epoch( epoch => $user->{'_Internal'}->{'Timestamp-Unix'} );
my $thisMonth = DateTime->new( year => $now->year, month => $now->month, day => 1 );
# Format period key
my $periodKey = $thisMonth->strftime("%Y-%m");
# Query database
my $sth = DBSelect($config->{'get_topups_summary_query'},$periodKey,$username);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get topup information: %s",AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(Balance Type ID))) {
_trafficSummaryAdd($trafficSummaries,$row,'Balance');
}
DBFreeRes($sth);
# Query database
$sth = DBSelect($config->{'get_topups_query'},$thisMonth->ymd,$now->ymd,$username);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get topup information: %s",AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Fetch all new topups
my (@trafficTopups,@uptimeTopups);
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Type Value))) {
_trafficSummaryAdd($trafficSummaries,$row,'Value');
}
DBFreeRes($sth);
# Save configuration for the user
processConfigAttribute($server,$user,{ 'Name' => 'SMRadius-Capping-Traffic-Topup',
'Operator' => ':=', 'Value' => $trafficSummaries->{'traffic'} });
processConfigAttribute($server,$user,{ 'Name' => 'SMRadius-Capping-Uptime-Topup',
'Operator' => ':=', 'Value' => $trafficSummaries->{'uptime'} });
processConfigAttribute($server,$user,{ 'Name' => 'SMRadius-Capping-Traffic-AutoTopup',
'Operator' => ':=', 'Value' => $trafficSummaries->{'traffic-auto'} });
processConfigAttribute($server,$user,{ 'Name' => 'SMRadius-Capping-Uptime-AutoTopup',
'Operator' => ':=', 'Value' => $trafficSummaries->{'uptime-auto'} });
return MOD_RES_ACK;
}
# Topup summary function
sub cleanup
{
my ($server,$runForDate) = @_;
# The datetime now
my $now = DateTime->from_epoch(epoch => $runForDate)->set_time_zone($server->{'smradius'}->{'event_timezone'});
# Use truncate to set all values after 'month' to their default values
my $thisMonth = $now->clone()->truncate( to => "month" );
# Format this month period key
my $curPeriodKey = $thisMonth->strftime("%Y-%m");
# Last month..
my $lastMonth = $thisMonth->clone()->subtract( months => 1 );
my $prevPeriodKey = $lastMonth->strftime("%Y-%m");
# Next month..
my $nextMonth = $thisMonth->clone()->add( months => 1 );
my $unix_nextMonth = $nextMonth->epoch();
# Get a timestamp for this user
my $depletedTimestamp = $now->strftime('%Y-%m-%d %H:%M:%S');
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Generating list of users");
# TODO - be more dynamic, we may not be using SQL users
# Get all usernames
my $sth = DBSelect('SELECT ID, Username FROM @TP@users');
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select users: ".
AWITPT::DB::DBLayer::error());
return;
}
# Create hash of usernames
my %users;
while (my $user = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Username))) {
$users{$user->{'ID'}} = $user->{'Username'};
}
# Finished for now
DBFreeRes($sth);
# Start of multiple queries
DBBegin();
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Removing all old topup summaries");
# Remove topup summaries
# NK: MYSQL SPECIFIC
$sth = DBDo('
DELETE FROM
@TP@topups_summary
WHERE
STR_TO_DATE(PeriodKey,"%Y-%m") >= ?',
$curPeriodKey
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to delete topup summaries: ".
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
# Undeplete topups
$sth = DBDo('
UPDATE
@TP@topups
SET
Depleted = 0,
SMAdminDepletedOn = NULL
WHERE
SMAdminDepletedOn >= ?', $thisMonth->ymd()
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to undeplete topups: ".AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Retrieving accounting summaries");
# Undeplete topup summaries
$sth = DBDo('
UPDATE
@TP@topups_summary
SET
Depleted = 0,
SMAdminDepletedOn = NULL
WHERE
SMAdminDepletedOn >= ?', $thisMonth->ymd()
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to retrieve accounting summaries: ".
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
# Loop through users
foreach my $userID (keys %users) {
my $username = $users{$userID};
# TODO - in future we must be more dynamic, we may not be using SQL accunting
# Get traffic and uptime usage for last month
my $sth = DBSelect('
SELECT
TotalInput,
TotalOutput,
TotalSessionTime
FROM
@TP@accounting_summary
WHERE
PeriodKey = ?
AND Username = ?
',
$prevPeriodKey,$username
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select accounting summary record: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Our usage hash
my %usageTotals;
$usageTotals{'TotalSessionTime'} = Math::BigInt->new(0);
$usageTotals{'TotalDataUsage'} = Math::BigInt->new(0);
# Pull in usage and add up
if (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
qw(TotalSessionTime TotalInput TotalOutput)
)) {
# Look for session time
if (defined($row->{'TotalSessionTime'}) && $row->{'TotalSessionTime'} > 0) {
$usageTotals{'TotalSessionTime'}->badd($row->{'TotalSessionTime'});
}
# Add input usage if we have any
if (defined($row->{'TotalInput'}) && $row->{'TotalInput'} > 0) {
$usageTotals{'TotalDataUsage'}->badd($row->{'TotalInput'});
}
# Add output usage if we have any
if (defined($row->{'TotalOutput'}) && $row->{'TotalOutput'} > 0) {
$usageTotals{'TotalDataUsage'}->badd($row->{'TotalOutput'});
}
}
DBFreeRes($sth);
# Log the summary
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Username '%s', PeriodKey '%s', TotalSessionTime '%s', ".
" TotalDataUsage '%s'",$username,$prevPeriodKey,$usageTotals{'TotalSessionTime'}->bstr(),
$usageTotals{'TotalDataUsage'}->bstr(), $usageTotals{'TotalDataUsage'}->bstr());
# Get user traffic and uptime limits from group attributes
# FIXME - Support for realm config
$sth = DBSelect('
SELECT
@TP@group_attributes.Name, @TP@group_attributes.Operator, @TP@group_attributes.Value
FROM
@TP@group_attributes, @TP@users_to_groups
WHERE
@TP@group_attributes.GroupID = @TP@users_to_groups.GroupID
AND @TP@users_to_groups.UserID = ?
',
$userID
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select group usage caps: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Store limits in capRecord hash
my %capRecord;
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(Name Operator Value))) {
if (defined($row->{'Name'})) {
if ($row->{'Name'} eq 'SMRadius-Capping-Traffic-Limit') {
if (defined($row->{'Operator'}) && $row->{'Operator'} eq ':=') {
if (defined($row->{'Value'}) && $row->{'Value'} =~ /^[\d]+$/) {
$capRecord{'TrafficLimit'} = $row->{'Value'};
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => SMRadius-Capping-Traffic-Limit ".
"value invalid for user '".$username."'");
}
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Incorrect '".$row->{'Name'}."' operator '"
.$row->{'Operator'}."' used for user '".$username."'");
}
}
if ($row->{'Name'} eq 'SMRadius-Capping-Uptime-Limit') {
if (defined($row->{'Operator'}) && $row->{'Operator'} eq ':=') {
if (defined($row->{'Value'}) && $row->{'Value'} =~ /^[\d]+$/) {
$capRecord{'UptimeLimit'} = $row->{'Value'};
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => SMRadius-Capping-Uptime-Limit value ".
"invalid for user '".$username."'");
}
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Incorrect '".$row->{'Name'}."' operator '"
.$row->{'Operator'}."' used for user '".$username."'");
}
}
}
}
# Finished for now
DBFreeRes($sth);
# Get user traffic and uptime limits from user attributes
$sth = DBSelect('
SELECT
Name, Operator, Value
FROM
@TP@user_attributes
WHERE
UserID = ?
',
$userID
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select user usage caps: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Store limits in capRecord hash
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(Name Operator Value))) {
if (defined($row->{'Name'})) {
if ($row->{'Name'} eq 'SMRadius-Capping-Traffic-Limit') {
if (defined($row->{'Operator'}) && $row->{'Operator'} eq ':=') {
if (defined($row->{'Value'}) && $row->{'Value'} =~ /^[\d]+$/) {
$capRecord{'TrafficLimit'} = $row->{'Value'};
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => SMRadius-Capping-Traffic-Limit value ".
"invalid for user '".$username."'");
}
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Incorrect '".$row->{'Name'}."' operator '"
.$row->{'Operator'}."' used for user '".$username."'");
}
}
if ($row->{'Name'} eq 'SMRadius-Capping-Uptime-Limit') {
if (defined($row->{'Operator'}) && $row->{'Operator'} eq ':=') {
if (defined($row->{'Value'}) && $row->{'Value'} =~ /^[\d]+$/) {
$capRecord{'UptimeLimit'} = $row->{'Value'};
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => SMRadius-Capping-Uptime-Limit value ".
"invalid for user '".$username."'");
}
} else {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Incorrect '".$row->{'Name'}."' operator '"
.$row->{'Operator'}."' used for user '".$username."'");
}
}
}
}
# Finished for now
DBFreeRes($sth);
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => CAP: ".
"SMRadius-Capping-Traffic-Limit '%s', SMRadius-Capping-Uptime-Limit '%s'",
$capRecord{'TrafficLimit'} ? $capRecord{'TrafficLimit'} : "-",
$capRecord{'UptimeLimit'} ? $capRecord{'TrafficLimit'} : "-"
);
# Get users topups that are still valid from topups_summary, must not be depleted
$sth = DBSelect('
SELECT
@TP@topups_summary.TopupID,
@TP@topups_summary.Balance,
@TP@topups.ValidTo,
@TP@topups.Type
FROM
@TP@topups_summary, @TP@topups
WHERE
@TP@topups_summary.Depleted = 0
AND @TP@topups.Depleted = 0
AND @TP@topups_summary.TopupID = @TP@topups.ID
AND @TP@topups.UserID = ?
AND @TP@topups_summary.PeriodKey = ?
ORDER BY
@TP@topups.Timestamp
',
$userID, $prevPeriodKey
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topup summaries: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Add previous valid topups to lists
my @trafficSummary = ();
my @uptimeSummary = ();
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(TopupID Balance Value ValidTo Type))) {
if (defined($row->{'ValidTo'})) {
# Convert string to unix time
my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
# Process traffic topup
if (_isTrafficTopup($row->{'Type'})) {
push(@trafficSummary, {
TopupID => $row->{'TopupID'},
Balance => $row->{'Balance'},
ValidTo => $unix_validTo,
Type => $row->{'Type'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC SUMMARY TOPUP: ".
"ID '%s', Balance '%s', ValidTo '%s'",
$row->{'TopupID'},
$row->{'Balance'},
DateTime->from_epoch(epoch => $unix_validTo)->strftime("%F")
);
# Process uptime topup
} elsif (_isUptimeTopup($row->{'Type'})) {
push(@uptimeSummary, {
TopupID => $row->{'TopupID'},
Balance => $row->{'Balance'},
ValidTo => $unix_validTo,
Type => $row->{'Type'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME SUMMARY TOPUP: ".
"ID '%s', Balance '%s', ValidTo '%s'",
$$row->{'TopupID'},
$row->{'Balance'},
DateTime->from_epoch(epoch => $unix_validTo)->strftime("%F")
);
}
}
}
# Finished for now
DBFreeRes($sth);
# Get topups from last month
$sth = DBSelect('
SELECT
ID, Value, Type, ValidTo
FROM
@TP@topups
WHERE
Depleted = 0
AND UserID = ?
AND ValidFrom = ?
AND ValidTo >= ?
ORDER BY
Timestamp
',
$userID,$lastMonth,$thisMonth
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topups: ".AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Loop with the topups and push them into arrays
my (@trafficTopups,@uptimeTopups);
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Value Type ValidTo))) {
# Convert string to unix time
my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
# If this is a traffic topup ...
if (_isTrafficTopup($row->{'Type'})) {
push(@trafficTopups, {
ID => $row->{'ID'},
Value => $row->{'Value'},
ValidTo => $unix_validTo
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC TOPUP: ".
"ID '%s', Balance '%s', ValidTo '%s'",
$row->{'ID'},
$row->{'Value'},
DateTime->from_epoch(epoch => $unix_validTo)->strftime("%F")
);
# Or a uptime topup...
} elsif (_isUptimeTopup($row->{'Type'})) {
push(@uptimeTopups, {
ID => $row->{'ID'},
Value => $row->{'Value'},
ValidTo => $unix_validTo
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME TOPUP: ".
"ID '%s', Balance '%s', ValidTo '%s'",
$row->{'ID'},
$row->{'Value'},
DateTime->from_epoch(epoch => $unix_validTo)->strftime("%F")
);
}
}
# Finished for now
DBFreeRes($sth);
# List of summaries depleted
my @depletedSummary = ();
my @depletedTopups = ();
# Summaries to be edited/repeated
my @summaryTopups = ();
# Calculate excess usage if necessary
my $trafficOverUsage = 0;
if (defined($capRecord{'TrafficLimit'}) && $capRecord{'TrafficLimit'} > 0) {
$trafficOverUsage = $usageTotals{'TotalDataUsage'} - $capRecord{'TrafficLimit'};
} elsif (!(defined($capRecord{'TrafficLimit'}))) {
$trafficOverUsage = $usageTotals{'TotalDataUsage'};
}
# User has started using topup bandwidth..
if ($trafficOverUsage > 0) {
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC OVERAGE: $trafficOverUsage");
# Sort topups first expiring first
my @sortedTrafficSummary = sort { $a->{'ValidTo'} cmp $b->{'ValidTo'} } @trafficSummary;
# Loop with previous topups, setting them depleted or repeating as necessary
foreach my $summaryItem (@sortedTrafficSummary) {
# Summary has not been used, if valid add to list to be repeated
if ($trafficOverUsage <= 0 && $summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $summaryItem->{'Balance'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC SUMMARY UNUSED: ".
"TOPUPID '%s', Balance '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'},
);
# Topup summary depleted
} elsif ($summaryItem->{'Balance'} <= $trafficOverUsage) {
push(@depletedSummary, $summaryItem->{'TopupID'});
push(@depletedTopups, $summaryItem->{'TopupID'});
# Excess traffic remaining
$trafficOverUsage -= $summaryItem->{'Balance'};
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC SUMMARY DEPLETED: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'},
$trafficOverUsage
);
# Topup summary still alive
} else {
my $trafficRemaining = $summaryItem->{'Balance'} - $trafficOverUsage;
if ($summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $trafficRemaining
});
}
$trafficOverUsage = 0;
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC SUMMARY USAGE: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$summaryItem->{'TopupID'},
$trafficRemaining,
$trafficOverUsage
);
}
}
# Sort topups first expiring first
my @sortedTrafficTopups = sort { $a->{'ValidTo'} cmp $b->{'ValidTo'} } @trafficTopups;
# Loop with topups, setting them depleted or adding summary as necessary
foreach my $topup (@sortedTrafficTopups) {
# Topup has not been used, if valid add to summary
if ($trafficOverUsage <= 0 && $topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $topup->{'Value'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC TOPUP UNUSED: ".
"TOPUPID '%s', Balance '%s'",
$topup->{'ID'},
$topup->{'Value'}
);
# Topup depleted
} elsif ($topup->{'Value'} <= $trafficOverUsage) {
push(@depletedTopups, $topup->{'ID'});
# Excess traffic remaining
$trafficOverUsage -= $topup->{'Value'};
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC TOPUP DEPLETED: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$topup->{'ID'},
$topup->{'Value'},
$trafficOverUsage
);
# Topup still alive
} else {
# Check if this summary exists in the list
my $trafficRemaining = $topup->{'Value'} - $trafficOverUsage;
if ($topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $trafficRemaining
});
}
$trafficOverUsage = 0;
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC TOPUP USAGE: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$topup->{'ID'},
$trafficRemaining,
$trafficOverUsage
);
}
}
# User has not used up cap but may have topups to carry over
} else {
# Check for summaries
foreach my $summaryItem (@trafficSummary) {
# Add summary
if ($summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $summaryItem->{'Balance'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC SUMMARY CARRY: ".
"TOPUPID '%s', Balance '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'}
);
}
}
# Check for topups
foreach my $topup (@trafficTopups) {
# Add to summaries
if ($topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $topup->{'Value'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => TRAFFIC TOPUP CARRY: ".
"TOPUPID '%s', Balance '%s'",
$topup->{'ID'},
$topup->{'Value'}
);
}
}
}
# Calculate excess usage if necessary
my $uptimeOverUsage = 0;
if (defined($capRecord{'UptimeLimit'}) && $capRecord{'UptimeLimit'} > 0) {
$uptimeOverUsage = $usageTotals{'TotalSessionTime'} - $capRecord{'UptimeLimit'};
} elsif (!(defined($capRecord{'UptimeLimit'}))) {
$uptimeOverUsage = $usageTotals{'TotalSessionTime'};
}
# User has started using topup uptime..
if ($uptimeOverUsage > 0) {
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME OVERAGE: $uptimeOverUsage");
# Sort topups first expiring first
my @sortedUptimeSummary = sort { $a->{'ValidTo'} cmp $b->{'ValidTo'} } @uptimeSummary;
# Loop with previous topups, setting them depleted or repeating as necessary
foreach my $summaryItem (@sortedUptimeSummary) {
# Summary has not been used, if valid add to list to be repeated
if ($uptimeOverUsage <= 0 && $summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $summaryItem->{'Balance'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME SUMMARY UNUSED: ".
"TOPUPID '%s', Balance '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'},
);
# Topup summary depleted
} elsif ($summaryItem->{'Balance'} <= $uptimeOverUsage) {
push(@depletedSummary, $summaryItem->{'TopupID'});
push(@depletedTopups, $summaryItem->{'TopupID'});
# Excess uptime remaining
$uptimeOverUsage -= $summaryItem->{'Balance'};
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME SUMMARY DEPLETED: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'},
$uptimeOverUsage
);
# Topup summary still alive
} else {
my $uptimeRemaining = $summaryItem->{'Balance'} - $uptimeOverUsage;
if ($summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $uptimeRemaining
});
}
$uptimeOverUsage = 0;
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME SUMMARY USAGE: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$summaryItem->{'TopupID'},
$uptimeRemaining,
$uptimeOverUsage
);
}
}
# Sort topups first expiring first
my @sortedUptimeTopups = sort { $a->{'ValidTo'} cmp $b->{'ValidTo'} } @uptimeTopups;
# Loop with topups, setting them depleted or adding summary as necessary
foreach my $topup (@sortedUptimeTopups) {
# Topup has not been used, if valid add to summary
if ($uptimeOverUsage <= 0 && $topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $topup->{'Value'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME TOPUP UNUSED: ".
"TOPUPID '%s', Balance '%s'",
$topup->{'ID'},
$topup->{'Value'}
);
# Topup depleted
} elsif ($topup->{'Value'} <= $uptimeOverUsage) {
push(@depletedTopups, $topup->{'ID'});
# Excess uptime remaining
$uptimeOverUsage -= $topup->{'Value'};
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME TOPUP DEPLETED: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$topup->{'ID'},
$topup->{'Value'},
$uptimeOverUsage
);
# Topup still alive
} else {
my $uptimeRemaining = $topup->{'Value'} - $uptimeOverUsage;
if ($topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $uptimeRemaining
});
}
$uptimeOverUsage = 0;
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME TOPUP USAGE: ".
"TOPUPID '%s', Balance '%s', Overage Left '%s'",
$topup->{'ID'},
$uptimeRemaining,
$uptimeOverUsage
);
}
}
# User has not used up cap but may have topups to carry over
} else {
# Check for summaries
foreach my $summaryItem (@uptimeSummary) {
# Add summary
if ($summaryItem->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $summaryItem->{'TopupID'},
PeriodKey => $curPeriodKey,
Balance => $summaryItem->{'Balance'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME SUMMARY CARRY: ".
"TOPUPID '%s', Balance '%s'",
$summaryItem->{'TopupID'},
$summaryItem->{'Balance'}
);
}
}
# Check for topups
foreach my $topup (@uptimeTopups) {
# Check if summary exists
if ($topup->{'ValidTo'} >= $unix_nextMonth) {
push(@summaryTopups, {
ID => $topup->{'ID'},
PeriodKey => $curPeriodKey,
Balance => $topup->{'Value'}
});
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => UPTIME TOPUP CARRY: ".
"TOPUPID '%s', Balance '%s'",
$topup->{'ID'},
$topup->{'Value'}
);
}
}
}
# Loop through summary topups
foreach my $summaryTopup (@summaryTopups) {
# Create topup summaries
$sth = DBDo('
INSERT INTO
@TP@topups_summary (TopupID,PeriodKey,Balance)
VALUES
(?,?,?)
',
$summaryTopup->{'ID'},$curPeriodKey,$summaryTopup->{'Balance'}
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to create topup summary: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => CREATE TOPUP SUMMARY: ".
"TOPUPID '%s', Balance '%s'",
$summaryTopup->{'ID'},
$summaryTopup->{'Balance'}
);
}
# Loop through topups that are depleted
foreach my $topupID (@depletedTopups) {
# Set users depleted topups
$sth = DBSelect('
UPDATE
@TP@topups
SET
Depleted = 1,
SMAdminDepletedOn = ?
WHERE
ID = ?
',
$depletedTimestamp,$topupID
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to deplete topup: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => DEPLETED TOPUP: ".
"TOPUPID '%s'",
$topupID
);
}
# Loop through topup summary items that are depleted
foreach my $topupID (@depletedSummary) {
# Set users depleted topup summaries
$sth = DBSelect('
UPDATE
@TP@topups_summary
SET
Depleted = 1,
SMAdminDepletedOn = ?
WHERE
TopupID = ?
',
$depletedTimestamp,$topupID
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to update topups_summary: ".
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => DEPLETED TOPUP SUMMARY: ".
"TOPUPID '%s'",
$topupID
);
}
}
# Finished
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Topups have been updated and summaries created");
DBCommit();
return;
FAIL_ROLLBACK:
DBRollback();
$server->log(LOG_NOTICE,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Database has been rolled back, no records updated");
return;
}
## @addTopup
# Create a topup
#
# @param server Server object
# @param user User
# @param packet Radius packet
#
# @return Result
sub addTopup
{
my ($server,$user,$validFrom,$validTo,$type,$value) = @_;
# Build template
my $template;
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
$template->{'query'}->{'Timestamp'} = $now->strftime('%F %T');
$template->{'query'}->{'ValidFrom'} = $validFrom;
$template->{'query'}->{'ValidTo'} = $validTo;
$template->{'query'}->{'Type'} = $type;
$template->{'query'}->{'Value'} = $value;
$template->{'query'}->{'Depleted'} = 0;
# Replace template entries
my @dbDoParams = templateReplace($config->{'topups_add_query'},$template);
# Insert into database
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Failed to insert topup record: %s",AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
return MOD_RES_ACK;
}
## @internal
# Function snippet to add up traffic summaries based on topup types
sub _trafficSummaryAdd
{
my ($trafficSummaries,$topup,$key) = @_;
# First we add up NON-autotopup's
if (!_isAutoTopup($topup->{'Type'})) {
# Add the topup amount to the appropriate hash entry
if (_isTrafficTopup($topup->{'Type'})) {
$trafficSummaries->{'traffic'} += $topup->{$key};
} elsif (_isUptimeTopup($topup->{'Type'})) {
$trafficSummaries->{'uptime'} += $topup->{$key};
}
# Next we add up auto-topups
} else {
if (_isTrafficTopup($topup->{'Type'})) {
# Add to traffic summary list
$trafficSummaries->{'traffic-auto'} += $topup->{$key};
} elsif (_isUptimeTopup($topup->{'Type'})) {
# Add to uptime summary list
$trafficSummaries->{'uptime-auto'} += $topup->{$key};
}
}
return;
}
1;
# vim: ts=4
lib/smradius/modules/system/mod_config_test.pm 0 → 100644
View file @ b659b33b
# Test user database
# Copyright (C) 2007-2011, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::system::mod_config_test;
use strict;
use warnings;
# Modules we need
use smradius::constants;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "Test Config Database",
Init => \&init,
# User database
Config_get => \&configGet,
};
## @internal
# Initialize module
sub init
{
my $server = shift;
}
## @configGet
# Try to get a config result
#
# @param server Server object
# @param user User
# @param packet Radius packet
#
# @return Result
sub configGet
{
my ($server,$user,$packet) = @_;
my $userConfig = {
'ConfigAttributes' => [
{
'Name' => 'SMRadius-Config-Secret',
'Operator' => '==',
'Value' => '12345'
}
]
};
return $userConfig;
}
1;
# vim: ts=4
smradius/modules/userdb/mod_userdb_sql.pm → lib/smradius/modules/userdb/mod_userdb_macauth_sql.pm
View file @ b659b33b
# SQL user database support
# SQL user database support for mac authentication
# Copyright (C) 2007-2016, AllWorldIT
#
# Copyright (C) 2008-2009, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package mod_userdb_sql;
package smradius::modules::userdb::mod_userdb_macauth_sql;
use strict;
use warnings;
# Modules we need
use AWITPT::Cache;
use AWITPT::DB::DBLayer;
use AWITPT::Util;
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::dblayer;
use smradius::util;
use smradius::attributes;
# Exporter stuff
require Exporter;
......@@ -41,9 +42,9 @@ our (@ISA,@EXPORT,@EXPORT_OK);
# Plugin info
our $pluginInfo = {
Name => "SQL User Database",
Name => "SQL User Database (MAC authentication)",
Init => \&init,
# User database
User_find => \&find,
User_get => \&get,
......@@ -62,95 +63,120 @@ sub init
# Enable support for database
if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Enabling database support.");
$server->log(LOG_NOTICE,"[MOD_USERDB_MACAUTH_SQL] Enabling database support.");
$server->{'smradius'}->{'database'}->{'enabled'} = 1;
}
# Default configs...
$config->{'userdb_find_query'} = '
SELECT
ID
FROM
@TP@users
WHERE
UserName = %{authentication.User-Name}
$config->{'userdb_macauth_find_query'} = '
SELECT
user_attributes.ID,
user_attributes.Operator, user_attributes.Disabled,
users.Username, users.Disabled AS UserDisabled
FROM
@TP@user_attributes, @TP@users
WHERE
user_attributes.Name = "Calling-Station-Id"
AND user_attributes.Value = %{user.MACAddress}
AND users.ID = user_attributes.UserID
';
$config->{'userdb_get_group_attributes_query'} = '
SELECT
group_attributes.Name, group_attributes.Operator, group_attributes.Value
FROM
@TP@group_attributes, @TP@users_to_groups
WHERE
users_to_groups.UserID = %{user.ID}
AND group_attributes.GroupID = users_to_groups.GroupID
';
$config->{'userdb_get_user_attributes_query'} = '
SELECT
Name, Operator, Value
FROM
@TP@user_attributes
WHERE
UserID = %{user.ID}
';
# Setup SQL queries
if (defined($scfg->{'mod_userdb_sql'})) {
if (defined($scfg->{'mod_userdb_macauth_sql'})) {
# Pull in queries
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_find_query'}) &&
$scfg->{'mod_userdb_sql'}->{'userdb_find_query'} ne "") {
$config->{'userdb_find_query'} = $scfg->{'mod_userdb_sql'}->{'userdb_find_query'};
if (defined($scfg->{'mod_userdb_macauth_sql'}->{'userdb_macauth_find_query'}) &&
$scfg->{'mod_userdb_macauth_sql'}->{'userdb_macauth_find_query'} ne "") {
if (ref($scfg->{'mod_userdb_macauth_sql'}->{'userdb_macauth_find_query'}) eq "ARRAY") {
$config->{'userdb_macauth_find_query'} = join(' ', @{$scfg->{'mod_userdb_macauth_sql'}->{'userdb_macauth_find_query'}});
} else {
$config->{'userdb_macauth_find_query'} = $scfg->{'mod_userdb_macauth_sql'}->{'userdb_macauth_find_query'};
}
}
}
}
## @find
# Try find a user
#
# @param server Server object
# @param user User
# @param user SMRadius user hash
# @li Username Username of the user we want
# @param packet Radius packet
#
# @return Result
# @return _UserDB_Data Hash of db query, this is stored in the $user->{'_UserDB_Data'} hash item
sub find
{
my ($server,$user,$packet) = @_;
# Only valid for authentication
if ($packet->code ne "Access-Request") {
return MOD_RES_SKIP;
}
# Check if this could be a MAC auth attempt
if (!($user->{'Username'} =~ /^(?:[0-9a-fA-F]{2}[:-]){5}[0-9a-fA-F]{2}$/)) {
return MOD_RES_SKIP;
}
# Standardize the MAC address
my $macAddress;
($macAddress = $user->{'Username'}) =~ s/-/:/g;
$server->log(LOG_DEBUG,"[MOD_USERDB_MACAUTH_SQL] Possible MAC authentication '$macAddress'");
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'authentication'}->{$attr} = $packet->rawattr($attr)
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
$template->{'user'} = $user;
# Add MAC address details
$template->{'user'}->{'MACAddress'} = $macAddress;
# Replace template entries
my @dbDoParams = templateReplace($config->{'userdb_find_query'},$template);
my @dbDoParams = templateReplace($config->{'userdb_macauth_find_query'},$template);
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_USERDB_SQL] Failed to find user data: ".smradius::dblayer::Error());
$server->log(LOG_ERR,"[MOD_USERDB_MACAUTH_SQL] Failed to find data for MAC address: ".AWITPT::DB::DBLayer::error());
return MOD_RES_SKIP;
}
# Check if we got a result, if we did not NACK
my $rows = $sth->rows();
if ($rows > 1) {
$server->log(LOG_ERR,"[MOD_USERDB_SQL] More than one result returned for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
} elsif ($rows < 1) {
$server->log(LOG_DEBUG,"[MOD_USERDB_SQL] User '".$user->{'Username'}."' not found in database");
if ($rows < 1) {
$server->log(LOG_DEBUG,"[MOD_USERDB_MACAUTH_SQL] MAC address '".$user->{'Username'}."' not found in database");
return MOD_RES_SKIP;
}
# Grab record data
my $row = $sth->fetchrow_hashref();
my $macDisabled;
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Operator Username Disabled UserDisabled))) {
# We only support ||= attributes
if ($row->{'Operator'} ne '||=') {
$server->log(LOG_DEBUG,"[MOD_USERDB_MACAUTH_SQL] MAC authentication only supports operator '||=', but '".
$row->{'Operator'}."' found for user '".$row->{'Username'}."'");
}
# Dont use disabled user
if (!defined($macDisabled)) {
$macDisabled = (isBoolean($row->{'Disabled'}) || isBoolean($row->{'UserDisabled'}));
} else {
# If MAC is disabled, just set ... worst case it can still be disabled
if ($macDisabled) {
$macDisabled = (!isBoolean($row->{'Disabled'}) && !isBoolean($row->{'UserDisabled'}));
}
}
}
if (defined($macDisabled) && $macDisabled) {
$server->log(LOG_DEBUG,"[MOD_USERDB_MACAUTH_SQL] MAC address '".$user->{'Username'}."' is disabled");
return MOD_RES_SKIP;
}
DBFreeRes($sth);
return (MOD_RES_ACK,$row);
return (MOD_RES_ACK,undef);
}
......@@ -158,10 +184,12 @@ sub find
# Try to get a user
#
# @param server Server object
# @param user User
# @param user Server $user hash
# @param packet Radius packet
#
# @return Result
# @return User attributes hash
# @li Attributes Radius attribute hash
# @li VAttributes Radius vendor attribute hash
sub get
{
my ($server,$user,$packet) = @_;
......@@ -169,50 +197,25 @@ sub get
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'authentication'}->{$attr} = $packet->rawattr($attr)
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
$template->{'user'}->{'Username'} = $user->{'Username'};
$template->{'user'}->{'ID'} = $user->{'_UserDB_Data'}->{'id'};
# Attributes to return
my %attributes = ();
my %vattributes = ();
# Replace template entries
my @dbDoParams = templateReplace($config->{'userdb_get_group_attributes_query'},$template);
# Query database
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get group attributes: ".smradius::dblayer::Error());
return -1;
}
# Loop with group attributes
while (my $row = $sth->fetchrow_hashref()) {
addAttribute($server,\%attributes,hashifyLCtoMC($row,qw(Name Operator Value)));
}
DBFreeRes($sth);
# Replace template entries again
@dbDoParams = templateReplace($config->{'userdb_get_user_attributes_query'},$template);
# Query database
$sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get user attributes: ".smradius::dblayer::Error());
return -1;
}
# Loop with group attributes
while (my $row = $sth->fetchrow_hashref()) {
addAttribute($server,\%attributes,hashifyLCtoMC($row,qw(Name Operator Value)));
}
DBFreeRes($sth);
my $ret;
$ret->{'Attributes'} = \%attributes;
$ret->{'VAttributes'} = \%vattributes;
return \%attributes;
return $ret;
}
1;
# vim: ts=4
lib/smradius/modules/userdb/mod_userdb_sql.pm 0 → 100644
View file @ b659b33b
# SQL user database support
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::modules::userdb::mod_userdb_sql;
use strict;
use warnings;
# Modules we need
use AWITPT::Cache;
use AWITPT::DB::DBLayer;
use AWITPT::Util;
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::util;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);
# Plugin info
our $pluginInfo = {
Name => "SQL User Database",
Init => \&init,
# User database
User_find => \&find,
User_get => \&get,
# Users data
Users_data_set => \&data_set,
Users_data_get => \&data_get,
# Cleanup run by smadmin
CleanupOrder => 95,
Cleanup => \&cleanup
};
# Module config
my $config;
## @internal
# Initialize module
sub init
{
my $server = shift;
my $scfg = $server->{'inifile'};
# Enable support for database
if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Enabling database support.");
$server->{'smradius'}->{'database'}->{'enabled'} = 1;
}
# Default configs...
$config->{'userdb_find_query'} = '
SELECT
ID, Disabled
FROM
@TP@users
WHERE
Username = %{user.Username}
';
$config->{'userdb_get_group_attributes_query'} = '
SELECT
@TP@group_attributes.Name, @TP@group_attributes.Operator, @TP@group_attributes.Value
FROM
@TP@group_attributes, @TP@users_to_groups
WHERE
@TP@users_to_groups.UserID = %{user.ID}
AND @TP@group_attributes.GroupID = @TP@users_to_groups.GroupID
AND @TP@group_attributes.Disabled = 0
';
$config->{'userdb_get_user_attributes_query'} = '
SELECT
Name, Operator, Value
FROM
@TP@user_attributes
WHERE
UserID = %{user.ID}
AND Disabled = 0
';
$config->{'users_data_set_query'} = '
INSERT INTO
@TP@users_data (UserID, LastUpdated, Name, Value)
VALUES
(
%{user.ID},
%{query.LastUpdated},
%{query.Name},
%{query.Value}
)
';
$config->{'users_data_update_query'} = '
UPDATE
@TP@users_data
SET
LastUpdated = %{query.LastUpdated},
Value = %{query.Value}
WHERE
UserID = %{user.ID}
AND Name = %{query.Name}
';
$config->{'users_data_get_query'} = '
SELECT
LastUpdated, Name, Value
FROM
@TP@users_data
WHERE
UserID = %{user.ID}
AND Name = %{query.Name}
';
$config->{'users_data_delete_query'} = '
DELETE FROM
@TP@users_data
WHERE
UserID = %{user.ID}
AND Name = %{query.Name}
';
# Default cache time for user data
$config->{'userdb_data_cache_time'} = 300;
# Setup SQL queries
if (defined($scfg->{'mod_userdb_sql'})) {
# Pull in queries
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_find_query'}) &&
$scfg->{'mod_userdb_sql'}->{'userdb_find_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'userdb_find_query'}) eq "ARRAY") {
$config->{'userdb_find_query'} = join(' ', @{$scfg->{'mod_userdb_sql'}->{'userdb_find_query'}});
} else {
$config->{'userdb_find_query'} = $scfg->{'mod_userdb_sql'}->{'userdb_find_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}) &&
$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}) eq "ARRAY") {
$config->{'userdb_get_group_attributes_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}});
} else {
$config->{'userdb_get_group_attributes_query'} =
$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'}) &&
$scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'}) eq "ARRAY") {
$config->{'userdb_get_user_attributes_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'}});
} else {
$config->{'userdb_get_user_attributes_query'} =
$scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'users_data_set_query'}) &&
$scfg->{'mod_userdb_sql'}->{'users_data_set_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'users_data_set_query'}) eq "ARRAY") {
$config->{'users_data_set_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'users_data_set_query'}});
} else {
$config->{'users_data_set_query'} = $scfg->{'mod_userdb_sql'}->{'users_data_set_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'users_data_update_query'}) &&
$scfg->{'mod_userdb_sql'}->{'users_data_update_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'users_data_update_query'}) eq "ARRAY") {
$config->{'users_data_update_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'users_data_update_query'}});
} else {
$config->{'users_data_update_query'} = $scfg->{'mod_userdb_sql'}->{'users_data_update_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'users_data_get_query'}) &&
$scfg->{'mod_userdb_sql'}->{'users_data_get_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'users_data_get_query'}) eq "ARRAY") {
$config->{'users_data_get_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'users_data_get_query'}});
} else {
$config->{'users_data_get_query'} = $scfg->{'mod_userdb_sql'}->{'users_data_get_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'users_data_delete_query'}) &&
$scfg->{'mod_userdb_sql'}->{'users_data_delete_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'users_data_delete_query'}) eq "ARRAY") {
$config->{'users_data_delete_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'users_data_delete_query'}});
} else {
$config->{'users_data_delete_query'} = $scfg->{'mod_userdb_sql'}->{'users_data_delete_query'};
}
}
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_data_cache_time'})) {
if (defined(my $val = isBoolean($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'}))) {
# If val is true, we default to the default anyway
# We're disabled
if (!$val) {
$config->{'userdb_data_cache_time'} = undef;
}
# We *could* have a value...
} elsif ($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'} =~ /^[0-9]+$/) {
$config->{'userdb_data_cache_time'} = $scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'};
} else {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Value for 'userdb_data_cache_time' is invalid");
}
}
}
# Log this for info sake
if (defined($config->{'userdb_data_cache_time'})) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Users data caching ENABLED, cache time is %ds.",
$config->{'userdb_data_cache_time'});
} else {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Users caching DISABLED");
}
}
## @find
# Try find a user
#
# @param server Server object
# @param user SMRadius user hash
# @li Username Username of the user we want
# @param packet Radius packet
#
# @return _UserDB_Data Hash of db query, this is stored in the $user->{'_UserDB_Data'} hash item
sub find
{
my ($server,$user,$packet) = @_;
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
# Add user details, not user ID is available here as thats what we are retrieving
$template->{'user'}->{'Username'} = $user->{'Username'};
# Replace template entries
my @dbDoParams = templateReplace($config->{'userdb_find_query'},$template);
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_USERDB_SQL] Failed to find user data: ".AWITPT::DB::DBLayer::error());
return MOD_RES_SKIP;
}
# Check if we got a result, if we did not NACK
my $rows = $sth->rows();
if ($rows > 1) {
$server->log(LOG_ERR,"[MOD_USERDB_SQL] More than one result returned for user '".$user->{'Username'}."'");
return MOD_RES_SKIP;
} elsif ($rows < 1) {
$server->log(LOG_DEBUG,"[MOD_USERDB_SQL] User '".$user->{'Username'}."' not found in database");
return MOD_RES_SKIP;
}
# Grab record data
my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Disabled));
# Dont use disabled user
my $res = isBoolean($row->{'Disabled'});
if ($res) {
$server->log(LOG_DEBUG,"[MOD_USERDB_SQL] User '".$user->{'Username'}."' is disabled");
return MOD_RES_SKIP;
}
DBFreeRes($sth);
return (MOD_RES_ACK,$row);
}
## @get
# Try to get a user
#
# @param server Server object
# @param user Server $user hash
# @param packet Radius packet
#
# @return User attributes hash
# @li Attributes Radius attribute hash
# @li VAttributes Radius vendor attribute hash
sub get
{
my ($server,$user,$packet) = @_;
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
# Replace template entries
my @dbDoParams = templateReplace($config->{'userdb_get_group_attributes_query'},$template);
# Query database
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get group attributes: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
# Loop with group attributes
while (my $row = $sth->fetchrow_hashref()) {
addAttribute($server,$user,hashifyLCtoMC($row,qw(Name Operator Value)));
}
DBFreeRes($sth);
# Replace template entries again
@dbDoParams = templateReplace($config->{'userdb_get_user_attributes_query'},$template);
# Query database
$sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get user attributes: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
# Loop with user attributes
while (my $row = $sth->fetchrow_hashref()) {
addAttribute($server,$user,hashifyLCtoMC($row,qw(Name Operator Value)));
}
DBFreeRes($sth);
return RES_OK;
}
## @data_set
# Set user data
#
# @param server Server object
# @param user Server $user hash
# @param module Module that is variable pertains to
# @param name Variable name
# @param value Variable value
#
# @return RES_OK on success, RES_ERROR on error
sub data_set
{
my ($server, $user, $module, $name, $value) = @_;
# Build template
my $template;
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
# Last updated time would be now
$template->{'query'}->{'LastUpdated'} = $user->{'_Internal'}->{'Timestamp'};
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
$template->{'query'}->{'Value'} = $value;
# Replace template entries
my @dbDoParams = templateReplace($config->{'users_data_update_query'},$template);
# Query database
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to update users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
# If we updated *something* ...
if ($sth eq "0E0") {
@dbDoParams = templateReplace($config->{'users_data_set_query'},$template);
# Insert
$sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to set users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
}
# If we using caching, cache the result of this set
if (defined($config->{'userdb_data_cache_time'})) {
# Build hash to store
my %data;
$data{'CachedUntil'} = $user->{'_Internal'}->{'Timestamp-Unix'} + $config->{'userdb_data_cache_time'};
$data{'LastUpdated'} = $user->{'_Internal'}->{'Timestamp'};
$data{'Module'} = $module;
$data{'Name'} = $name;
$data{'Value'} = $value;
# Cache the result
cacheStoreComplexKeyPair('mod_userdb_sql(users_data)',
sprintf('%s/%s/%s',$module,$user->{'_UserDB_Data'}->{'ID'},$name),
\%data
);
}
return RES_OK;
}
## @data_get
# Get user data
#
# @param server Server object
# @param user UserDB hash we got from find()
# @param module Module that is variable pertains to
# @param name Variable name
#
# @return Users data hash
# @li LastUpdated Time of last update
# @li Name Variable Name
# @li Value Variable Value
sub data_get
{
my ($server, $user, $module, $name) = @_;
# Build template
my $template;
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
# If we using caching, check how old the result is
if (defined($config->{'userdb_data_cache_time'})) {
my ($res,$val) = cacheGetComplexKeyPair('mod_userdb_sql(data_get)',
sprintf('%s/%s/%s',$module,$user->{'_UserDB_Data'}->{'ID'},$name)
);
if (defined($val) && $val->{'CachedUntil'} > $user->{'_Internal'}->{'Timestamp-Unix'}) {
return $val;
}
}
# Replace template entries
my @dbDoParams = templateReplace($config->{'users_data_get_query'},$template);
# Query database
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
# Fetch user data
my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(LastUpdated Name Value));
# If there is no result, just return undef
return if (!defined($row));
# If there is data, go through the long process of continuing ...
my %data;
$data{'LastUpdated'} = $row->{'LastUpdated'};
$data{'Module'} = $module;
$data{'Name'} = $row->{'Name'};
$data{'Value'} = $row->{'Value'};
# If we using caching and got here, it means that we must cache the result
if (defined($config->{'userdb_data_cache_time'})) {
$data{'CachedUntil'} = $user->{'_Internal'}->{'Timestamp-Unix'} + $config->{'userdb_data_cache_time'};
# Cache the result
cacheStoreComplexKeyPair('mod_userdb_sql(users_data)',
sprintf('%s/%s/%s',$module,$user->{'_UserDB_Data'}->{'ID'},$name),
\%data
);
}
return \%data;
}
# Clean up of old user variables
sub cleanup
{
my ($server,$runForDate,$resetUserData) = @_;
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => Removing old user data");
# Begin operation
DBBegin();
# Perform query
my $sth = DBDo('
DELETE FROM
@TP@users_data
WHERE UserID NOT IN
(
SELECT ID FROM users
)
');
# Error and rollback
if (!$sth) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => Database has been rolled back, no data deleted");
DBRollback();
return;
}
if ($resetUserData) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => Resetting user data counters");
# Perform query
my $sth = DBDo('
UPDATE
@TP@users_data
SET
Value = 0
WHERE
Name = '.DBQuote('CurrentMonthTotalTraffic').'
OR Name = '.DBQuote('CurrentMonthTotalUptime').'
');
# Error and rollback
if (!$sth) {
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => Database has been rolled back, no data reset");
DBRollback();
return;
}
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => User data counters have been reset");
}
# Commit
DBCommit();
$server->log(LOG_NOTICE,"[MOD_USERDB_SQL] Cleanup => Old user data cleaned up");
}
1;
# vim: ts=4
smradius/modules/userdb/mod_userdb_test.pm → lib/smradius/modules/userdb/mod_userdb_test.pm
View file @ b659b33b
# Test user database
#
# Copyright (C) 2008, AllWorldIT
# Copyright (C) 2007-2011, AllWorldIT
#
# 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
......@@ -92,8 +91,8 @@ sub get
{
my ($server,$user,$packet) = @_;
my $userDetails = {
# Attributes to return
my $attributes = {
'ClearPassword' => 'doap',
'Attributes' => [
{
......@@ -114,10 +113,17 @@ sub get
]
};
my %vattributes = ();
my $ret;
$ret->{'Attributes'} = $attributes;
$ret->{'VAttributes'} = \%vattributes;
return $ret;
return $userDetails;
}
1;
# vim: ts=4
lib/smradius/util.pm 0 → 100644
View file @ b659b33b
# SMRadius Utility Functions
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
=encoding utf8
=head1 NAME
smradius::util - SMRadius utils
=head1 SYNOPSIS
my ($str,@vals) = templateReplace("SELECT * FROM abc WHERE %{abc} = ?",{ 'abc' => "some value" });
my $str = quickTemplateToolkit('someval is "[% someval %]"',{ 'someval' = "hello world" });
=head1 DESCRIPTION
The smradius::util class provides utility classes for SMRadius.
=cut
package smradius::util;
use parent qw(Exporter);
use strict;
use warnings;
our (@EXPORT_OK,@EXPORT);
@EXPORT_OK = qw(
);
@EXPORT = qw(
templateReplace
quickTemplateToolkit
);
use Template;
=head1 METHODS
The following utility methods are available.
=cut
=head2 templateReplace
my ($str,@vals) = templateReplace("SELECT * FROM abc WHERE %{abc} = ?",{ 'abc' => "some value" });
The C<templatereplace> method is used to replace variables with a placeholder. This is very useful for SQL templates. The values
are returned in the second and subsequent array items.
=over
=back
=cut
# Replace hashed variables with placeholders and return an array with the values.
sub templateReplace
{
my ($string,$hashref,$placeholder) = @_;
my @valueArray = ();
$placeholder //= '?';
# Replace blanks
while (my ($entireMacro,$section,$item,$default) = ($string =~ /(\%\{([a-z]+)\.([a-z0-9\-]+)(?:=([^\}]*))?\})/i )) {
# Replace macro with ? or the placeholder if specified
# We also quote the entireMacro
$string =~ s/\Q$entireMacro\E/$placeholder/;
# Get value to substitute
my $value = (defined($hashref->{$section}) && defined($hashref->{$section}->{$item})) ?
$hashref->{$section}->{$item} : $default;
# Add value onto our array
push(@valueArray,$value);
}
return ($string, @valueArray);
}
=head2 quickTemplateToolkit
my $str = quickTemplateToolkit('someval is "[% someval %]"',{ 'someval' = "hello world" });
The C<quickTemplateToolkit> is a quick and easy template toolkit function.
=over
=back
=cut
# Replace hashed variables with placeholders and return an array with the values.
sub quickTemplateToolkit
{
my ($string,$variables) = @_;
# This is the config we're going to pass to Template
my $config = {
# Our include path built below
INCLUDE_PATH => [ ],
};
# Create template engine
my $tt = Template->new($config);
# Process the template and output to our OUTPUT_PATH
my $output = "";
if (!(my $res = $tt->process(\$string, $variables, \$output))) {
return (undef,$tt->error());
}
return $output;
}
1;
__END__
=head1 AUTHORS
Nigel Kukard E<lt>nkukard@lbsd.netE<gt>
=head1 BUGS
All bugs should be reported via the project issue tracker
L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues/>.
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2007-2016, AllWorldIT
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 3 of the License, or
(at your option) any later version.
=head1 SEE ALSO
L<Template>.
=cut
smradius/version.pm → lib/smradius/version.pm
View file @ b659b33b
# AWRadius version package
# Copyright (C) 2008, AllWorldIT
# Copyright (C) 2007, Nigel Kukard <nkukard@lbsd.net>
#
# SMRadius version package
# Copyright (C) 2007-2016, AllWorldIT
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
......@@ -28,13 +27,21 @@ require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
$VERSION
VERSION
);
@EXPORT_OK = qw(
);
our $VERSION = "1.0.1";
sub VERSION { return $VERSION };
use constant {
VERSION => "0.0.1",
};
# vim: ts=4
1;
# vim: ts=4
smradius/cache.pm deleted 100644 → 0
View file @ 35ca5a3b
# Caching engine
# Copyright (C) 2007 Nigel Kukard <nkukard@lbsd.net>
# Copyright (C) 2008, LinuxRulz
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::cache;
use strict;
use warnings;
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
cacheStoreKeyPair
cacheGetKeyPair
);
use Cache::FastMmap;
# Cache stuff
my $cache_type = "FastMmap";
my $cache;
# Our current error message
my $error = "";
# Set current error message
# Args: error_message
sub setError
{
my $err = shift;
my ($package,$filename,$line) = caller;
my (undef,undef,undef,$subroutine) = caller(1);
# Set error
$error = "$subroutine($line): $err";
}
# Return current error message
# Args: none
sub Error
{
my $err = $error;
# Reset error
$error = "";
# Return error
return $err;
}
# Initialize cache
sub Init
{
my $server = shift;
my $ch;
# Create Cache
$ch = Cache::FastMmap->new(
'page_size' => 2048,
'num_pages' => 1000,
'raw_values' => 1,
'unlink_on_exit' => 1,
);
# Stats
$ch->set('Cache/Stats/Hit',0);
$ch->set('Cache/Stats/Miss',0);
# Set server vars
$server->{'cache_engine'}{'handle'} = $ch;
};
# Destroy cache
sub Destroy
{
my $server = shift;
};
# Connect child to cache
sub connect
{
my $server = shift;
$cache = $server->{'cache_engine'}{'handle'};
}
# Disconnect child from cache
sub disconnect
{
my $server = shift;
}
# Store keypair in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
# Value - Item value
sub cacheStoreKeyPair
{
my ($cacheName,$key,$value) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in store");
return -1;
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' store");
return -1;
}
if (!defined($value)) {
setError("Value not defined for cache '$cacheName' key '$key' store");
return -1;
}
# If we're not caching just return
return 0 if ($cache_type eq 'none');
# Store
$cache->set("$cacheName/$key",$value);
return 0;
}
# Get data from key in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
sub cacheGetKeyPair
{
my ($cacheName,$key) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in get");
return (-1);
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' get");
return (-1);
}
# If we're not caching just return
if ($cache_type eq 'none') {
return (0,undef);
}
# Check and count
my $res = $cache->get("$cacheName/$key");
if ($res) {
$cache->get_and_set('Cache/Stats/Hit',sub { return ++$_[1]; });
} else {
$cache->get_and_set('Cache/Stats/Miss',sub { return ++$_[1]; });
}
return (0,$res);
}
# Return cache hit ratio
sub getHitRatio
{
my $res;
# Get counter
$res = $cache->get('Cache/Stats/Hit');
return $res;
}
# Return cache miss ratio
sub getMissRatio
{
my $res;
# Get counter
$res = $cache->get('Cache/Stats/Miss');
return $res;
}
1;
# vim: ts=4
smradius/dbilayer.pm deleted 100644 → 0
View file @ 35ca5a3b
# Database independent layer module
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
# Copyright (C) 2008, LinuxRulz
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::dbilayer;
use strict;
use warnings;
use smradius::config;
use DBI;
my $internalError = "";
sub internalErr
{
my $error = $internalError;
$internalError = "";
return $error;
}
# Initialize class and return a fully connected object
sub Init
{
my $server = shift;
my $dbconfig = $server->{'smradius'}->{'database'};
# Check if we created
my $dbh = smradius::dbilayer->new($dbconfig->{'DSN'},$dbconfig->{'Username'},$dbconfig->{'Password'},$dbconfig->{'TablePrefix'});
return undef if (!defined($dbh));
return $dbh;
}
# Constructor
sub new
{
my ($class,$dsn,$username,$password,$table_prefix) = @_;
# Iternals
my $self = {
_dbh => undef,
_error => undef,
_dsn => undef,
_username => undef,
_password => undef,
_table_prefix => "",
_in_transaction => undef,
};
# Set database parameters
if (defined($dsn)) {
$self->{_dsn} = $dsn;
$self->{_username} = $username;
$self->{_password} = $password;
$self->{_table_prefix} = $table_prefix if (defined($table_prefix) && $table_prefix ne "");
} else {
$internalError = "Invalid DSN given";
return undef;
}
# Create...
bless $self, $class;
return $self;
}
# Return current error message
# Args: none
sub Error
{
my ($self) = @_;
my $err = $self->{_error};
# Reset error
$self->{_error} = "";
# Return error
return $err;
}
# Return connection to database
# Args: none
sub connect
{
my ($self) = @_;
$self->{_dbh} = DBI->connect($self->{_dsn}, $self->{_username}, $self->{_password}, {
'AutoCommit' => 1,
'PrintError' => 0,
'FetchHashKeyName' => 'NAME_lc'
});
# Connect to database if we have to, check if we ok
if (!$self->{_dbh}) {
$self->{_error} = "Error connecting to database: $DBI::errstr";
return -1;
}
# Apon connect we are not in a transaction
$self->{_in_transaction} = 0;
return 0;
}
# Check database connection
# Args: none
sub _check
{
my $self = shift;
# If we not in a transaction try connect
if ($self->{_in_transaction} == 0) {
# Try ping
if (!$self->{_dbh}->ping()) {
# Disconnect & reconnect
$self->{_dbh}->disconnect();
$self->connect();
}
}
}
# Return database selection results...
# Args: <select statement>
sub select
{
my ($self,$query,@params) = @_;
$self->_check();
# # Build single query instead of using binding of params
# # not all databases support binding, and not all support all
# # the places we use ?
# $query =~ s/\?/%s/g;
# # Map each element in params to the quoted value
# $query = sprintf($query,
# map { $self->quote($_) } @params
# );
#use Data::Dumper; print STDERR Dumper($query);
# Prepare query
my $sth;
if (!($sth = $self->{_dbh}->prepare($query))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
# Check for execution error
# if (!$sth->execute()) {
if (!$sth->execute(@params)) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Perform a command
# Args: <command statement>
sub do
{
my ($self,$command,@params) = @_;
$self->_check();
# # Build single command instead of using binding of params
# # not all databases support binding, and not all support all
# # the places we use ?
# $command =~ s/\?/%s/g;
# # Map each element in params to the quoted value
# $command = sprintf($command,
# map { $self->quote($_) } @params
# );
#use Data::Dumper; print STDERR Dumper($command);
# Prepare query
my $sth;
# if (!($sth = $self->{_dbh}->do($command))) {
if (!($sth = $self->{_dbh}->do($command,undef,@params))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Function to get last insert id
# Args: <table> <column>
sub lastInsertID
{
my ($self,$table,$column) = @_;
# Get last insert id
my $res;
if (!($res = $self->{_dbh}->last_insert_id(undef,undef,$table,$column))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to begin a transaction
# Args: none
sub begin
{
my ($self) = @_;
$self->_check();
$self->{_in_transaction}++;
# Don't really start transaction if we more than 1 deep
if ($self->{_in_transaction} > 1) {
return 1;
}
# Begin
my $res;
if (!($res = $self->{_dbh}->begin_work())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to commit a transaction
# Args: none
sub commit
{
my ($self) = @_;
# Reduce level
$self->{_in_transaction}--;
# If we not at top level, return success
if ($self->{_in_transaction} > 0) {
return 1;
}
# Reset transaction depth to 0
$self->{_in_transaction} = 0;
# Commit
my $res;
if (!($res = $self->{_dbh}->commit())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to rollback a transaction
# Args: none
sub rollback
{
my ($self) = @_;
# If we at top level, return success
if ($self->{_in_transaction} < 1) {
return 1;
}
$self->{_in_transaction} = 0;
# Rollback
my $res;
if (!($res = $self->{_dbh}->rollback())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to quote a database variable
# Args: <stuff to quote>
sub quote
{
my ($self,$stuff) = @_;
return $self->{_dbh}->quote($stuff);
}
# Function to cleanup DB query
# Args: <sth>
sub free
{
my ($self,$sth) = @_;
if ($sth) {
$sth->finish();
}
}
# Function to return the table prefix
sub table_prefix
{
my $self = shift;
return $self->{_table_prefix};
}
1;
# vim: ts=4
smradius/dblayer.pm deleted 100644 → 0
View file @ 35ca5a3b
# Common database layer module
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
# Copyright (C) 2008, LinuxRulz
#
# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::dblayer;
use strict;
use warnings;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
DBConnect
DBSelect
DBDo
DBLastInsertID
DBBegin
DBCommit
DBRollback
DBQuote
DBFreeRes
DBSelectNumResults
hashifyLCtoMC
);
use smradius::config;
use smradius::dbilayer;
# Database handle
my $dbh = undef;
# Our current error message
my $error = "";
# Set current error message
# Args: error_message
sub setError
{
my $err = shift;
my ($package,$filename,$line) = caller;
my (undef,undef,undef,$subroutine) = caller(1);
# Set error
$error = "$subroutine($line): $err";
}
# Return current error message
# Args: none
sub Error
{
my $err = $error;
# Reset error
$error = "";
# Return error
return $err;
}
# Initialize database handle
# Args: <database handle>
sub setHandle
{
my $handle = shift;
$dbh = $handle;
}
# Return database selection results...
# Args: <select statement>
sub DBSelect
{
my ($query,@params) = @_;
my $table_prefix = $dbh->table_prefix();
# Replace table prefix macro
$query =~ s/\@TP\@/$table_prefix/g;
# Prepare query
my $sth;
if (!($sth = $dbh->select($query,@params))) {
setError("Error executing select '$query': ".$dbh->Error());
return undef;
}
return $sth;
}
# Perform a command
# Args: <command statement>
sub DBDo
{
my ($command,@params) = @_;
my $table_prefix = $dbh->table_prefix();
# Replace table prefix macro
$command =~ s/\@TP\@/$table_prefix/g;
# Prepare query
my $sth;
if (!($sth = $dbh->do($command,@params))) {
setError("Error executing command '$command': ".$dbh->Error());
return undef;
}
return $sth;
}
# Function to get last insert id
# Args: <table> <column>
sub DBLastInsertID
{
my ($table,$column) = @_;
my $res;
if (!($res = $dbh->lastInsertID(undef,undef,$table,$column))) {
setError("Error getting last inserted id: ".$dbh->Error());
return undef;
}
return $res;
}
# Function to begin a transaction
# Args: none
sub DBBegin
{
my $res;
if (!($res = $dbh->begin())) {
setError("Error beginning transaction: ".$dbh->Error());
return undef;
}
return $res;
}
# Function to commit a transaction
# Args: none
sub DBCommit
{
my $res;
if (!($res = $dbh->commit())) {
setError("Error committing transaction: ".$dbh->Error());
return undef;
}
return $res;
}
# Function to rollback a transaction
# Args: none
sub DBRollback
{
my $res;
if (!($res = $dbh->rollback())) {
setError("Error rolling back transaction: ".$dbh->Error());
return undef;
}
return $res;
}
# Function to quote a database variable
# Args: <stuff to quote>
sub DBQuote
{
my $stuff = shift;
return $dbh->quote($stuff);
}
# Function to cleanup DB query
# Args: <sth>
sub DBFreeRes
{
my $sth = shift;
if ($sth) {
$sth->finish();
}
}
#
# Value Added Functions
#
# Function to get table prefix
sub DBTablePrefix
{
return $dbh->table_prefix();
}
# Return how many results came up from the specific SELECT query
# Args: <select statement>
sub DBSelectNumResults
{
my $query = shift;
# Prepare query
my $sth;
if (!($sth = $dbh->select("SELECT COUNT(*) AS num_results $query"))) {
setError("Error executing select: ".$dbh->Error());
return undef;
}
# Grab row
my $row = $sth->fetchrow_hashref();
if (!defined($row)) {
setError("Failed to get results from a select: ".$dbh->Error());
return undef;
}
# Pull number
my $num_results = $row->{'num_results'};
$sth->finish();
return $num_results;
}
# Convert a lower case array to mixed case
sub hashifyLCtoMC
{
my ($record,@entries) = @_;
# If we undefined, return
return undef if (!defined($record));
my $res;
# Loop with each item, assign from lowecase database record to our result
foreach my $entry (@entries) {
$res->{$entry} = $record->{lc($entry)};
}
return $res;
}
1;
# vim: ts=4