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 2341 additions and 465 deletions
lib/smradius/client.pm 0 → 100644
View file @ b659b33b
# Radius client
# 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::client;
use strict;
use warnings;
use base qw(AWITPT::Object);
use Getopt::Long qw( GetOptionsFromArray );
use IO::Select;
use IO::Socket;
use smradius::version;
use smradius::Radius::Packet;
# Check Config::IniFiles is instaslled
if (!eval {require Config::IniFiles; 1;}) {
print STDERR "You're missing Config::IniFiles, try 'apt-get install libconfig-inifiles-perl'\n";
exit 1;
}
# Run the client
sub run
{
my ($self,@methodArgs) = @_;
# Instantiate if we're not already instantiated
$self = $self->new() if (!ref($self));
# The hash we're going to return
my $ret = { };
print(STDERR "SMRadClient v".VERSION." - Copyright (c) 2007-2019, AllWorldIT\n");
print(STDERR "\n");
# Set defaults
my $cfg;
$cfg->{'config_file'} = "/etc/smradiusd.conf";
# Grab runtime arguments
my @runArgs = @methodArgs ? @methodArgs : @ARGV;
# Parse command line params
my $cmdline;
%{$cmdline} = ();
if (!GetOptionsFromArray(
\@runArgs,
\%{$cmdline},
"config:s",
"raddb:s",
"listen:s",
"help",
)) {
print(STDERR "ERROR: Error parsing commandline arguments");
return 1;
}
# Check for some args
if ($cmdline->{'help'}) {
displayHelp();
return 0;
}
# Make sure we only have 2 additional args
if (@runArgs < 3) {
print(STDERR "ERROR: Invalid number of arguments\n");
displayHelp();
return 1;
}
if (!defined($cmdline->{'raddb'}) || $cmdline->{'raddb'} eq "") {
print(STDERR "ERROR: No raddb directory specified!\n");
displayHelp();
return 1;
}
# Get variables we need
my $server = shift(@runArgs);
my $type = shift(@runArgs);
$self->{'secret'} = shift(@runArgs);
# Validate type
if (!defined($type) || ( $type ne "acct" && $type ne "auth" && $type ne "disconnect")) {
print(STDERR "ERROR: Invalid packet type specified!\n");
displayHelp();
return 1;
}
print(STDERR "\n");
# Time to start loading the dictionary
print(STDERR "Loading dictionaries...");
my $raddb = smradius::Radius::Dictionary->new();
# Look for files in the dir
my $DIR;
if (!opendir($DIR, $cmdline->{'raddb'})) {
print(STDERR "ERROR: Cannot open '".$cmdline->{'raddb'}."': $!");
return 1;
}
my @raddb_files = readdir($DIR);
# And load the dictionary
foreach my $df (@raddb_files) {
my $df_fn = $cmdline->{'raddb'}."/$df";
# Load dictionary
if (!$raddb->readfile($df_fn)) {
print(STDERR "Failed to load dictionary '$df_fn': $!");
}
print(STDERR ".");
}
print(STDERR "\n");
# Decide what type of packet this is
my $port;
my $pkt_code;
if ($type eq "acct") {
$port = 1813;
$pkt_code = "Accounting-Request";
} elsif ($type eq "auth") {
$port = 1812;
$pkt_code = "Access-Request";
} elsif ($type eq "disconnect") {
$port = 1813;
$pkt_code = "Disconnect-Request";
}
print(STDERR "\nRequest:\n");
printf(STDERR " > Secret => '%s'\n",$self->{'secret'});
# Build packet
$self->{'packet'} = smradius::Radius::Packet->new($raddb);
$self->{'packet'}->set_code($pkt_code);
# Generate identifier
my $ident = int(rand(32768));
$self->{'packet'}->set_identifier($ident);
print(STDERR " > Identifier: $ident\n");
# Generate authenticator number
my $authen = int(rand(32768));
$self->{'packet'}->set_authenticator($authen);
print(STDERR " > Authenticator: $ident\n");
# Pull in attributes from STDIN if we're not being called as a function
if (!@runArgs) {
while (my $line = <STDIN>) {
$self->addAttributesFromString($line);
}
}
# Pull in attributes from commandline
while (my $line = shift(@runArgs)) {
$self->addAttributesFromString($line);
}
# Create UDP packet
my $udp_packet = $self->{'packet'}->pack();
# Create socket to send packet out on
my $sockTimeout = "10"; # 10 second timeout
my $sock = IO::Socket::INET->new(
PeerAddr => $server,
PeerPort => $port,
Type => SOCK_DGRAM,
Proto => 'udp',
Timeout => $sockTimeout,
);
if (!$sock) {
print(STDERR "ERROR: Failed to create socket\n");
return 1;
}
my $sock2;
# Check if we must listen on another IP/port
if (defined($cmdline->{'listen'}) && $cmdline->{'listen'} ne "") {
print(STDERR "Creating second socket\n");
# Check the details we were provided
my ($localAddr,$localPort) = split(/:/,$cmdline->{'listen'});
if (!defined($localPort)) {
print(STDERR "ERROR: The format for --listen is IP:Port\n");
return 1;
}
$sock2 = IO::Socket::INET->new(
LocalAddr => $localAddr,
LocalPort => $localPort,
Type => SOCK_DGRAM,
Proto => 'udp',
Timeout => $sockTimeout,
);
if (!$sock2) {
print(STDERR "ERROR: Failed to create second socket\n");
return 1;
}
}
# Check if we sent the packet...
if (!$sock->send($udp_packet)) {
print(STDERR "ERROR: Failed to send data on socket\n");
return 1;
}
# And time for the response
print(STDERR "\nResponse:\n");
# Once sent, we need to get a response back
my $rsock = IO::Select->new($sock);
if (!$rsock) {
print(STDERR "ERROR: Failed to select response data on socket\n");
return 1;
}
# Check if we can read a response after the select()
if (!$rsock->can_read($sockTimeout)) {
print(STDERR "ERROR: Failed to receive response data on socket\n");
return 1;
}
# Read packet
$sock->recv($udp_packet, 65536);
if (!$udp_packet) {
print(STDERR "ERROR: Receive response data failed on socket: $!\n");
return 1;
}
# Parse packet
my $pkt = smradius::Radius::Packet->new($raddb,$udp_packet);
print(STDERR " > Authenticated: ". (defined(auth_req_verify($udp_packet,$self->{'secret'},$authen)) ? "yes" : "no") ."\n");
print(STDERR $pkt->str_dump());
# Setup response
$ret->{'request'} = $self->hashedPacket($self->{'packet'});
$ret->{'response'} = $self->hashedPacket($pkt);
my $udp_packet2;
if (defined($sock2)) {
my $rsock2 = IO::Select->new($sock2);
if (!$rsock2) {
print(STDERR "ERROR: Failed to select response data on socket2\n");
return 1;
}
# Check if we can read a response after the select()
if (!$rsock2->can_read($sockTimeout)) {
print(STDERR "ERROR: Failed to receive response data on socket2\n");
return 1;
}
# Read packet
my $udp_packet2;
$sock2->recv($udp_packet2, 65536);
if (!$udp_packet2) {
print(STDERR "ERROR: Receive response data failed on socket2: $!\n");
return 1;
}
my $pkt2 = smradius::Radius::Packet->new($raddb,$udp_packet2);
print(STDERR $pkt2->str_dump());
# Save the packet we got
$ret->{'listen'}->{'response'} = $self->hashedPacket($pkt2);
}
# If we were called as a function, return hashed version of the response packet
if (@methodArgs) {
return $ret;
}
return 0;
}
# Return a hashed version of the packet
sub hashedPacket
{
my ($self,$pkt) = @_;
my $res = {};
$res->{'code'} = $pkt->code();
$res->{'identifier'} = $pkt->identifier();
foreach my $attrName (sort $pkt->attributes()) {
my $attrVal = $pkt->rawattr($attrName);
$res->{'attributes'}->{$attrName} = $attrVal;
}
foreach my $attrVendor ($pkt->vendors()) {
foreach my $attrName ($pkt->vsattributes($attrVendor)) {
$res->{'vattributes'}->{$attrVendor}->{$attrName} = $pkt->vsattr($attrVendor,$attrName);
}
}
return $res;
}
# Allow adding attribute from a string
sub addAttributesFromString
{
my ($self,$line) = @_;
# Remove EOL
chomp($line);
# Split on , and newline
my @rawAttributes = split(/[,\n]+/,$line);
foreach my $attr (@rawAttributes) {
# Pull off attribute name & value
my ($name,$value) = ($attr =~ /\s*(\S+)\s*=\s?(.+)/);
$self->addAttribute($name,$value);
}
return;
}
# Add attribute to packet
sub addAttribute
{
my ($self,$name,$value) = @_;
# Add to packet
print(STDERR " > Adding '$name' => '$value'\n");
if ($name eq "User-Password") {
$self->{'packet'}->set_password($value,$self->{'secret'});
} else {
$self->{'packet'}->set_attr($name,$value);
}
return;
}
# Display help
sub displayHelp {
print(STDERR<<EOF);
Usage: $0 [args] <server> <acct|auth|disconnect> <secret> [ATTR=VALUE,...]
--raddb=<DIR> Directory where the radius dictionary files are
EOF
return;
}
1;
# vim: ts=4
smradius/config.pm → lib/smradius/config.pm
View file @ b659b33b
......@@ -25,11 +25,13 @@ use warnings;
# Exporter stuff
use base qw(Exporter);
our (@EXPORT);
@EXPORT = qw(
our @EXPORT = qw(
);
our @EXPORT_OK = qw(
);
use AWITPT::Util;
use smradius::logging;
......@@ -70,10 +72,8 @@ sub Init
# Should we use the packet timestamp?
if (defined($config->{'radius'}{'use_packet_timestamp'})) {
if ($config->{'radius'}{'use_packet_timestamp'} =~ /^\s*(yes|true|1)\s*$/i) {
$server->{'smradius'}{'use_packet_timestamp'} = 1;
} elsif ($config->{'radius'}{'use_packet_timestamp'} =~ /^\s*(no|false|0)\s*$/i) {
$server->{'smradius'}{'use_packet_timestamp'} = 0;
if (defined(my $val = isBoolean($config->{'radius'}{'use_packet_timestamp'}))) {
$server->{'smradius'}{'use_packet_timestamp'} = $val;
} else {
$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'use_packet_timestamp' is invalid");
}
......@@ -83,10 +83,8 @@ sub Init
# Should we use abuse prevention?
if (defined($config->{'radius'}{'use_abuse_prevention'})) {
if ($config->{'radius'}{'use_abuse_prevention'} =~ /^\s*(yes|true|1)\s*$/i) {
$server->{'smradius'}{'use_abuse_prevention'} = 1;
} elsif ($config->{'radius'}{'use_abuse_prevention'} =~ /^\s*(no|false|0)\s*$/i) {
$server->{'smradius'}{'use_abuse_prevention'} = 0;
if (defined(my $val = isBoolean($config->{'radius'}{'use_abuse_prevention'}))) {
$server->{'smradius'}{'use_abuse_prevention'} = $val;
} else {
$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'use_abuse_prevention' is invalid");
}
......
smradius/constants.pm → lib/smradius/constants.pm
View file @ b659b33b
......@@ -20,14 +20,13 @@
## @class smradius::constants
# SMRadius constants package
package smradius::constants;
use base qw(Exporter);
use strict;
use warnings;
# Exporter stuff
use base qw(Exporter);
our (@EXPORT,@EXPORT_OK);
@EXPORT = qw(
RES_OK
......@@ -37,7 +36,7 @@ our (@EXPORT,@EXPORT_OK);
MOD_RES_NACK
MOD_RES_SKIP
UINT_MAX
GIGAWORD_VALUE
);
@EXPORT_OK = ();
......@@ -50,7 +49,7 @@ use constant {
MOD_RES_ACK => 1,
MOD_RES_NACK => 2,
UINT_MAX => 2**32
GIGAWORD_VALUE => 2**32,
};
......
smradiusd → lib/smradius/daemon.pm 100755 → 100644
View file @ b659b33b
#!/usr/bin/perl
# Radius daemon
# Copyright (C) 2007-2016, AllWorldIT
# 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
......@@ -17,13 +16,6 @@
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
use warnings;
use lib('/usr/local/lib/smradius-0.0','/usr/lib/smradius-0.0',
'/usr/lib64/smradius-0.0','smradius','awitpt/lib');
package smradius::daemon;
......@@ -50,6 +42,36 @@ if (!eval {require DateTime; 1;}) {
exit 1;
}
# Check Crypt::DES is installed
if (!eval {require Crypt::DES; 1;}) {
print STDERR "You're missing DateTime, try 'apt-get install libcrypt-des-perl'\n";
exit 1;
}
# Check Crypt::RC4 is installed
if (!eval {require Crypt::RC4; 1;}) {
print STDERR "You're missing Crypt::RC4, try 'apt-get install libcrypt-rc4-perl'\n";
exit 1;
}
# Check Digest::MD4 is installed
if (!eval {require Digest::MD4; 1;}) {
print STDERR "You're missing Digest::MD4, try 'apt-get install libdigest-md4-perl'\n";
exit 1;
}
# Check Digest::SHA is installed
if (!eval {require Digest::SHA; 1;}) {
print STDERR "You're missing Digest::SHA, try 'apt-get install libdigest-sha-perl'\n";
exit 1;
}
# Check Date::Parse is installed
if (!eval {require Date::Parse; 1;}) {
print STDERR "You're missing TimeDate, try 'apt-get install libtimedate-perl'\n";
exit 1;
}
# Check Cache::FastMmap is installed
if (!eval {require Cache::FastMmap; 1;}) {
print STDERR "You're missing DateTime, try 'apt-get install libcache-fastmmap-perl'\n";
......@@ -58,6 +80,12 @@ if (!eval {require Cache::FastMmap; 1;}) {
eval {use AWITPT::Cache;};
}
# Check MIME::Lite is installed
if (!eval {require MIME::Lite; 1;}) {
print STDERR "You're missing MIME::Lite, try 'apt-get install libmime-lite-perl'\n";
exit 1;
}
## no critic (BuiltinFunctions::ProhibitStringyEval)
eval qq{
......@@ -65,15 +93,15 @@ eval qq{
};
## use critic
use Getopt::Long;
use Getopt::Long qw( GetOptionsFromArray );
use Socket;
use Sys::Syslog;
use Time::HiRes qw( gettimeofday tv_interval );
use AWITPT::DB::DBILayer;
use AWITPT::DB::DBLayer;
use AWITPT::Util qw( booleanize );
use Radius::Packet;
use smradius::Radius::Packet;
use smradius::version;
use smradius::constants;
use smradius::daemon::request;
......@@ -121,16 +149,23 @@ sub configure {
$server->{'max_servers'} = 25;
$server->{'max_requests'} = 1000;
# Work out runtime arguments
my @runArgs = @{$server->{'_run_args'}} ? @{$server->{'_run_args'}} : @ARGV;
# Parse command line params
my $cmdline;
%{$cmdline} = ();
GetOptions(
if (!GetOptionsFromArray(
\@runArgs,
\%{$cmdline},
"help",
"config:s",
"debug",
"fg",
) or die "Error parsing commandline arguments";
)) {
print(STDERR "ERROR: Error parsing commandline arguments");
return 1;
}
# Check for some args
if ($cmdline->{'help'}) {
......@@ -351,7 +386,7 @@ sub post_configure_hook {
my $config = $self->{'config'};
$self->log(LOG_NOTICE,"[SMRADIUS] SMRadius - v".VERSION);
$self->log(LOG_NOTICE,"[SMRADIUS] SMRadius - v$VERSION");
# Init config
$self->log(LOG_INFO,"[SMRADIUS] Initializing configuration...");
......@@ -360,7 +395,7 @@ sub post_configure_hook {
# Load dictionaries
$self->log(LOG_INFO,"[SMRADIUS] Initializing dictionaries...");
my $dict = Radius::Dictionary->new();
my $dict = smradius::Radius::Dictionary->new();
foreach my $df (@{$config->{'dictionary_list'}}) {
# Load dictionary
if (!$dict->readfile($df)) {
......@@ -460,11 +495,11 @@ sub child_init_hook
# If we succeeded, record OK
$self->{'client'}->{'dbh_status'} = 0;
} else {
$self->log(LOG_WARN,"[SMRADIUS] Failed to connect to database: ".$self->{'client'}->{'dbh'}->Error().
$self->log(LOG_WARN,"[SMRADIUS] Failed to connect to database: ".$self->{'client'}->{'dbh'}->error().
" ($$)");
}
} else {
$self->log(LOG_WARN,"[SMRADIUS] Failed to Initialize: ".awitpt::db::dbilayer::internalError()." ($$)");
$self->log(LOG_WARN,"[SMRADIUS] Failed to Initialize: ".AWITPT::DB::DBILayer::internalError()." ($$)");
}
}
......@@ -555,7 +590,10 @@ sub process_request {
my $request = smradius::daemon::request->new($self);
$request->setTimeZone($self->{'smradius'}->{'event_timezone'});
if (!$request->setTimezone($self->{'smradius'}->{'event_timezone'})) {
$self->log(LOG_ERR,"[SMRADIUS] Setting event_timezone to '%s' failed",$self->{'smradius'}->{'event_timezone'});
return;
}
$request->parsePacket($self->{'radius'}->{'dictionary'},$rawPacket);
......@@ -577,20 +615,38 @@ sub process_request {
my $logReason = "UNKNOWN";
# First thing we do is to make sure the NAS behaves if we using abuse prevention
if ($self->{'smradius'}->{'use_abuse_prevention'} && defined($user->{'Username'})) {
my ($res,$val) = cacheGetKeyPair('FloodCheck',$server->{'peeraddr'}."/".$user->{'Username'}."/".$pkt->code);
if (defined($val)) {
my $timePeriod = $now - $val;
# Check if we're still within the abuse threshold
if ($pkt->code eq "Access-Request" && $timePeriod < $self->{'smradius'}->{'access_request_abuse_threshold'}) {
$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: Server trying too fast. server = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: NAS trying too fast. NAS = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
", code = ".$pkt->code.", timeout = ".($now - $val));
# Tell the NAS we got its packet
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Access-Reject');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
);
return;
} elsif ($pkt->code eq "Accounting-Request" && $timePeriod < $self->{'smradius'}->{'accounting_request_abuse_threshold'}) {
$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: Server trying too fast. server = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: NAS trying too fast. NAS = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
", code = ".$pkt->code.", timeout = ".($now - $val));
# Tell the NAS we got its packet
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Accounting-Response');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
);
return;
}
}
# We give the benefit of the doubt and let a query take 60s. We update to right stamp at end of this function
......@@ -689,7 +745,7 @@ sub process_request {
if ($module->{'User_find'}) {
$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Trying plugin '".$module->{'Name'}."' for username '".
$user->{'Username'}."'");
my ($res,$userdb_data) = $module->{'User_find'}($self,$user,$pkt);
my ($res,$userDB_Data) = $module->{'User_find'}($self,$user,$pkt);
# Check result
if (!defined($res)) {
......@@ -704,7 +760,9 @@ sub process_request {
} elsif ($res == MOD_RES_ACK) {
$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Username found with '".$module->{'Name'}."'");
$user->{'_UserDB'} = $module;
$user->{'_UserDB_Data'} = $userdb_data;
$user->{'_UserDB_Data'} = $userDB_Data;
# The user ID is supposed to be global unique, on the same level as the username
$user->{'ID'} = $user->{'_UserDB_Data'}->{'ID'};
last;
# Or a negative result
......@@ -732,6 +790,16 @@ sub process_request {
$self->log(LOG_DEBUG,"[SMRADIUS] Accounting Request Packet");
# Add onto logline
$request->addLogLine(". REQUEST => ");
foreach my $attrName ($pkt->attributes) {
$request->addLogLine(
"%s: '%s'",
$attrName,
$pkt->rawattr($attrName)
);
}
#
# GET USER
#
......@@ -776,15 +844,6 @@ sub process_request {
}
}
# Tell the NAS we got its packet
my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Accounting-Response');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
);
# Are we going to POD the user?
my $PODUser = 0;
......@@ -819,120 +878,169 @@ sub process_request {
}
}
# Build a list of our attributes in the packet
my $acctAttributes;
foreach my $attr ($pkt->attributes) {
$acctAttributes->{$attr} = $pkt->rawattr($attr);
}
# Loop with attributes we got from the user
foreach my $attrName (keys %{$user->{'Attributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Check attribute against accounting attributes attributes
my $res = checkAcctAttribute($self,$user,$acctAttributes,$attr);
# We don't care if it fails
# Tell the NAS we got its packet
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Accounting-Response');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
);
# CoA and POD only apply to accounting updates...
if ($pkt->rawattr('Acct-Status-Type') eq "3") {
# Build a list of our attributes in the packet
my $acctAttributes;
foreach my $attr ($pkt->attributes) {
$acctAttributes->{$attr} = $pkt->rawattr($attr);
}
# Loop with attributes we got from the user
foreach my $attrName (keys %{$user->{'Attributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Check attribute against accounting attributes
my $res = checkAcctAttribute($self,$user,$acctAttributes,$attr);
# We don't care if it fails
}
}
}
# Check if we must POD the user
if ($PODUser) {
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying to disconnect user...");
# The coaReq may be either POD or CoA
my $coaReq = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
# Set packet identifier
$coaReq->set_identifier( $$ & 0xff );
$resp->set_code('Disconnect-Request');
my $id = $$ & 0xff;
$resp->set_identifier( $id );
# Check if we must POD the user, if so we set the code to disconnect
if ($PODUser) {
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying to disconnect user...");
$coaReq->set_code('Disconnect-Request');
} else {
# If this is *not* a POD, we need to process reply attributes
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Sending CoA...");
$coaReq->set_code('CoA-Request');
# Process the reply attributes
$self->_processReplyAttributes($request,$user,$coaReq);
}
$resp->set_attr('User-Name',$pkt->attr('User-Name'));
$resp->set_attr('Framed-IP-Address',$pkt->attr('Framed-IP-Address'));
$resp->set_attr('NAS-IP-Address',$pkt->attr('NAS-IP-Address'));
# NAS identification
$coaReq->set_attr('NAS-IP-Address',$pkt->attr('NAS-IP-Address'));
# Session identification
$coaReq->set_attr('User-Name',$pkt->attr('User-Name'));
$coaReq->set_attr('NAS-Port',$pkt->attr('NAS-Port'));
$coaReq->set_attr('Acct-Session-Id',$pkt->attr('Acct-Session-Id'));
# Add onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($resp->attributes) {
foreach my $attrName ($coaReq->attributes) {
$request->addLogLine(
"%s: '%s'",
$attrName,
$resp->rawattr($attrName)
$coaReq->rawattr($attrName)
);
}
# Grab packet
my $response = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
# Generate coaReq packet
my $coaReq_packet = auth_resp($coaReq->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
# Array CoA servers to contact
my @coaServers;
# Check for POD Servers and send disconnect
# Check for old POD server attribute
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'})) {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is defined");
@coaServers = @{$user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'}};
}
# Check address format
foreach my $podServerAttribute (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'}}) {
# Check for valid IP
if ($podServerAttribute =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/) {
my $podServer = $1;
# If we have a port, use it, otherwise use default 1700
my $podServerPort;
if ($podServerAttribute =~ /:([0-9]+)$/) {
$podServerPort = $1;
} else {
$podServerPort = 1700;
}
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying PODServer => IP: '".$podServer."' Port: '".$podServerPort."'");
# Create socket to send packet out on
my $podServerTimeout = "10"; # 10 second timeout
my $podSock = IO::Socket::INET->new(
PeerAddr => $podServer,
PeerPort => $podServerPort,
Type => SOCK_DGRAM,
Proto => 'udp',
TimeOut => $podServerTimeout,
);
if (!$podSock) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send POD on");
next;
}
# Check if we sent the packet...
if (!$podSock->send($response)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on socket");
next;
}
# Once sent, we need to get a response back
my $sh = IO::Select->new($podSock);
if (!$sh) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket");
next;
}
if (!$sh->can_read($podServerTimeout)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket");
next;
}
my $data;
$podSock->recv($data, 65536);
if (!$data) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Receive data failed");
$logReason = "POD Failure";
} else {
$logReason = "User POD";
}
#my @stuff = unpack('C C n a16 a*', $data);
#$self->log(LOG_DEBUG,"STUFF: ".Dumper(\@stuff));
} else {
$self->log(LOG_DEBUG,"[SMRADIUS] Invalid POD Server value: '".$podServerAttribute."'");
}
# Check for new CoA server attribute
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'})) {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-CoAServer is defined");
@coaServers = @{$user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'}};
}
# If we didn't get provided a CoA server, use the peer address
if (!@coaServers) {
push(@coaServers,$server->{'peeraddr'});
}
# Check address format
foreach my $coaServer (@coaServers) {
# Remove IPv6 portion for now...
$coaServer =~ s/^::ffff://;
# Check for valid IP
my ($coaServerIP,$coaServerPort) = ($coaServer =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})(?::([0-9]+))?/);
if (!defined($coaServerIP)) {
$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: CoAServer '$coaServer' looks incorrect");
next;
}
# Set default CoA server port
$coaServerPort //= 1700;
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '".$coaServer."' Port: '".$coaServerPort."'");
# Create socket to send packet out on
my $coaServerTimeout = "2"; # 2 second timeout
my $coaSock = IO::Socket::INET->new(
PeerAddr => $coaServerIP,
PeerPort => $coaServerPort,
Type => SOCK_DGRAM,
Proto => 'udp',
TimeOut => $coaServerTimeout,
);
if (!$coaSock) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send CoA on: $!");
next;
}
# Check if we sent the packet...
if (!$coaSock->send($coaReq_packet)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on CoA socket: $!");
next;
}
# Once sent, we need to get a response back
my $select = IO::Select->new($coaSock);
if (!$select) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket: $!");
next;
}
if (!$select->can_read($coaServerTimeout)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket: $!");
next;
}
# Grab CoA response
my $coaRes_packet;
$coaSock->recv($coaRes_packet, 65536);
if (!$coaRes_packet) {
$self->log(LOG_INFO,"[SMRADIUS] POST-ACCT: No data received in response to our request to '$coaServerIP:$coaServerPort': $!");
$request->addLogLine(". No response to CoA/POD");
next;
}
# Parse the radius packet
my $coaRes = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'},$coaRes_packet);
# Check status
if ($coaRes->code eq "CoA-ACK") {
$request->addLogLine(". CoA Success");
last;
} elsif ($coaRes->code eq "CoA-NACK") {
$request->addLogLine(". CoA Fail");
} elsif ($coaRes->code eq "Disconnect-ACK") {
$request->addLogLine(". POD Success");
last;
} elsif ($coaRes->code eq "Disconnect-NACK") {
$request->addLogLine(". POD Fail");
} else {
$request->addLogLine(". Invalid CoA/POD response");
}
} else {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is not defined");
}
}
......@@ -1034,12 +1142,12 @@ sub process_request {
# Check if we got a positive result back
} elsif ($res == MOD_RES_ACK) {
$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Passed authenticated by '".$module->{'Name'}."'");
$logReason = "Post Authentication Success";
$logReason = "Post Authentication Success";
# Or a negative result
} elsif ($res == MOD_RES_NACK) {
$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Failed authentication by '".$module->{'Name'}."'");
$logReason = "Post Authentication Failure";
$logReason = "Post Authentication Failure";
$authenticated = 0;
# Do we want to run the other modules ??
last;
......@@ -1079,140 +1187,15 @@ sub process_request {
# Check if we authenticated or not
if ($authenticated && $authorized) {
$self->log(LOG_DEBUG,"[SMRADIUS] Authenticated and authorized");
$logReason = "User Authorized";
$logReason = "User Authorized";
my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Access-Accept');
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Access-Accept');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
# Loop with attributes we got from the getReplyAttributes function, its a hash of arrays which are the values
my %replyAttributes = %{ $user->{'ReplyAttributes'} };
foreach my $attrName (keys %{$user->{'Attributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyAttribute($self,\%replyAttributes,$attr);
}
}
# Loop with reply attributes
$request->addLogLine(". RFILTER => ");
foreach my $attrName (keys %replyAttributes) {
# Loop with values
foreach my $value (@{$replyAttributes{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-Attribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# Add each value
$resp->set_attr($attrName,$value);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
# Loop with vendor reply attributes
$request->addLogLine(". RVFILTER => ");
my %replyVAttributes = ();
# Process reply vattributes already added
foreach my $vendor (keys %{ $user->{'ReplyVAttributes'} }) {
# Loop with operators
foreach my $attrName (keys %{$user->{'ReplyVAttributes'}->{$vendor}}) {
# Add each value
foreach my $value (@{$user->{'ReplyVAttributes'}{$vendor}->{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-VAttribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# This attribute is not excluded, so its ok
$replyVAttributes{$vendor}->{$attrName} = $user->{'ReplyVAttributes'}->{$vendor}->{$attrName};
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
}
# Process VAttributes
foreach my $attrName (keys %{$user->{'VAttributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'VAttributes'}->{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-VAttribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# Grab attribute
my $attr = $user->{'VAttributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyVAttribute($self,\%replyVAttributes,$attr);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
foreach my $vendor (keys %replyVAttributes) {
# Loop with operators
foreach my $attrName (keys %{$replyVAttributes{$vendor}}) {
# Add each value
foreach my $value (@{$replyVAttributes{$vendor}->{$attrName}}) {
$resp->set_vsattr($vendor,$attrName,$value);
}
}
}
# Add attributes onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($resp->attributes) {
$request->addLogLine(
"%s: '%s",
$attrName,
$resp->rawattr($attrName)
);
}
# Add vattributes onto logline
$request->addLogLine(". VREPLY => ");
# Loop with vendors
foreach my $vendor ($resp->vendors()) {
# Loop with attributes
foreach my $attrName ($resp->vsattributes($vendor)) {
# Grab the value
my @attrRawVal = ( $resp->vsattr($vendor,$attrName) );
my $attrVal = $attrRawVal[0][0];
# Sanatize it a bit
if ($attrVal =~ /[[:cntrl:]]/) {
$attrVal = "-nonprint-";
} else {
$attrVal = "'$attrVal'";
}
$request->addLogLine(
"%s/%s: %s",
$attrName,
$attrVal,
$resp->rawattr($attrName)
);
}
}
# Process the reply attributes
$self->_processReplyAttributes($request,$user,$resp);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
......@@ -1224,9 +1207,9 @@ CHECK_RESULT:
# Check if found and authenticated
if (!$authenticated || !$authorized) {
$self->log(LOG_DEBUG,"[SMRADIUS] Authentication or authorization failure");
$logReason = "User NOT Authenticated or Authorized";
$logReason = "User NOT Authenticated or Authorized";
my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
$resp->set_code('Access-Reject');
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
......@@ -1328,7 +1311,7 @@ sub log ## no critic (Subroutines::ProhibitBuiltinHomonyms)
# Display help
sub displayHelp {
print(STDERR "SMRadius v".VERSION." - Copyright (c) 2007-2016, AllWorldIT\n");
print(STDERR "SMRadius v$VERSION - Copyright (c) 2007-2016, AllWorldIT\n");
print(STDERR<<EOF);
......@@ -1344,9 +1327,127 @@ EOF
__PACKAGE__->run();
#
# Internal functions
#
# Process reply attributes
sub _processReplyAttributes
{
my ($self,$request,$user,$pkt) = @_;
# Add attributes we got from plugins and process attributes attached to the user
my %replyAttributes = %{ $user->{'ReplyAttributes'} };
foreach my $attrName (keys %{$user->{'Attributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyAttribute($self,\%replyAttributes,$attr);
}
}
# Add vendor attributes we got from plugins and process attributes attached to the user
my %replyVAttributes = %{ $user->{'ReplyVAttributes'} };
foreach my $attrName (keys %{$user->{'VAttributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'VAttributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'VAttributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyVAttribute($self,\%replyVAttributes,$attr);
}
}
# Loop with reply attributes add them to our response, or output them to log if they were excluded
$request->addLogLine("RFILTER => ");
foreach my $attrName (keys %replyAttributes) {
# Loop with values
foreach my $value (@{$replyAttributes{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-Attribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# Add each value
$pkt->set_attr($attrName,$value);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
# Loop with reply vendor attributes add them to our response, or output them to log if they were excluded
$request->addLogLine(". RVFILTER => ");
# Process reply vattributes already added
foreach my $vendor (keys %replyVAttributes) {
# Loop with operators
foreach my $attrName (keys %{$replyVAttributes{$vendor}}) {
# Add each value
foreach my $value (@{$replyVAttributes{$vendor}->{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-VAttribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# This attribute is not excluded, so its ok
$pkt->set_vsattr($vendor,$attrName,$value);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
}
# Add attributes onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($pkt->attributes) {
$request->addLogLine(
"%s: '%s",
$attrName,
$pkt->rawattr($attrName)
);
}
# Add vattributes onto logline
$request->addLogLine(". VREPLY => ");
# Loop with vendors
foreach my $vendor ($pkt->vendors()) {
# Loop with attributes
foreach my $attrName ($pkt->vsattributes($vendor)) {
# Grab the value
my @attrRawVal = ( $pkt->vsattr($vendor,$attrName) );
my $attrVal = $attrRawVal[0][0];
# Sanatize it a bit
if ($attrVal =~ /[[:cntrl:]]/) {
$attrVal = "-nonprint-";
} else {
$attrVal = "'$attrVal'";
}
$request->addLogLine(
"%s/%s: %s",
$vendor,
$attrName,
$attrVal
);
}
}
return $self;
};
1;
# vim: ts=4
smradius/daemon/request.pm → lib/smradius/daemon/request.pm
View file @ b659b33b
......@@ -25,6 +25,13 @@ use warnings;
use base qw{AWITPT::Object};
use DateTime;
use DateTime::TimeZone;
use Try::Tiny;
use smradius::Radius::Packet;
# Parse radius packet
sub parsePacket
......@@ -33,7 +40,7 @@ sub parsePacket
# Parse the radius packet
$self->{'packet'} = Radius::Packet->new($dictionary,$rawPacket);
$self->{'packet'} = smradius::Radius::Packet->new($dictionary,$rawPacket);
# Loop with packet attribute names and add to our log line
$self->addLogLine("PACKET => ");
......@@ -80,7 +87,7 @@ sub setTimestamp
# Grab real event timestamp in local time uzing the time zone
my $eventTimestamp = DateTime->from_epoch(
epoch => $self->{'user'}->{'_Internal'}->{'Timestamp-Unix'},
time_zone => $self->{'timeZone'},
time_zone => $self->{'timezone'},
);
# Set the timestamp (not in unix)
$self->{'user'}->{'_Internal'}->{'Timestamp'} = $eventTimestamp->strftime('%Y-%m-%d %H:%M:%S');
......@@ -91,12 +98,20 @@ sub setTimestamp
# Set internal time zone
sub setTimeZone
sub setTimezone
{
my ($self,$timeZone) = @_;
my ($self,$timezone) = @_;
my $timezone_obj;
try {
$timezone_obj = DateTime::TimeZone->new('name' => $timezone);
};
# Retrun if we don't have a value, this means we failed
return if (!defined($timezone_obj));
$self->{'timeZone'} = $timeZone;
$self->{'timezone'} = $timezone_obj;
return $self;
}
......@@ -144,7 +159,7 @@ sub _init
$self->{'logLine'} = [ ];
$self->{'logLineParams'} = [ ];
$self->{'timeZone'} = "UTC";
$self->{'timezone'} = "UTC";
# Initialize user
$self->{'user'} = {
......
smradius/logging.pm → lib/smradius/logging.pm
View file @ b659b33b
File moved
smradius/modules/accounting/mod_accounting_sql.pm → lib/smradius/modules/accounting/mod_accounting_sql.pm
View file @ b659b33b
# SQL accounting database
# Copyright (C) 2007-2015, AllWorldIT
#
# 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.
......@@ -35,12 +35,10 @@ use Math::BigFloat;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
use base qw(Exporter);
our @EXPORT = qw(
);
@EXPORT_OK = qw(
our @EXPORT_OK = qw(
);
......@@ -127,26 +125,26 @@ sub init
%{request.NAS-Identifier},
%{request.NAS-IP-Address},
%{request.Acct-Delay-Time},
%{request.SessionTime},
%{request.InputOctets},
%{request.InputGigawords},
%{request.InputPackets},
%{request.OutputOctets},
%{request.OutputGigawords},
%{request.OutputPackets},
%{request.Acct-Session-Time},
%{request.Acct-Input-Octets},
%{request.Acct-Input-Gigawords},
%{request.Acct-Input-Packets},
%{request.Acct-Output-Octets},
%{request.Acct-Output-Gigawords},
%{request.Acct-Output-Packets},
%{query.PeriodKey}
)
';
$config->{'accounting_update_get_records_query'} = '
SELECT
SUM(AcctInputOctets) AS InputOctets,
SUM(AcctInputPackets) AS InputPackets,
SUM(AcctOutputOctets) AS OutputOctets,
SUM(AcctOutputPackets) AS OutputPackets,
SUM(AcctInputGigawords) AS InputGigawords,
SUM(AcctOutputGigawords) AS OutputGigawords,
SUM(AcctSessionTime) AS SessionTime,
SUM(AcctInputOctets) AS AcctInputOctets,
SUM(AcctInputPackets) AS AcctInputPackets,
SUM(AcctOutputOctets) AS AcctOutputOctets,
SUM(AcctOutputPackets) AS AcctOutputPackets,
SUM(AcctInputGigawords) AS AcctInputGigawords,
SUM(AcctOutputGigawords) AS AcctOutputGigawords,
SUM(AcctSessionTime) AS AcctSessionTime,
PeriodKey
FROM
@TP@accounting
......@@ -165,13 +163,13 @@ sub init
UPDATE
@TP@accounting
SET
AcctSessionTime = %{query.SessionTime},
AcctInputOctets = %{query.InputOctets},
AcctInputGigawords = %{query.InputGigawords},
AcctInputPackets = %{query.InputPackets},
AcctOutputOctets = %{query.OutputOctets},
AcctOutputGigawords = %{query.OutputGigawords},
AcctOutputPackets = %{query.OutputPackets},
AcctSessionTime = %{query.Acct-Session-Time},
AcctInputOctets = %{query.Acct-Input-Octets},
AcctInputGigawords = %{query.Acct-Input-Gigawords},
AcctInputPackets = %{query.Acct-Input-Packets},
AcctOutputOctets = %{query.Acct-Output-Octets},
AcctOutputGigawords = %{query.Acct-Output-Gigawords},
AcctOutputPackets = %{query.Acct-Output-Packets},
AcctStatusType = %{request.Acct-Status-Type}
WHERE
Username = %{user.Username}
......@@ -208,6 +206,20 @@ sub init
AND PeriodKey = %{query.PeriodKey}
';
$config->{'accounting_usage_query_period'} = '
SELECT
SUM(AcctInputOctets) AS AcctInputOctets,
SUM(AcctOutputOctets) AS AcctOutputOctets,
SUM(AcctInputGigawords) AS AcctInputGigawords,
SUM(AcctOutputGigawords) AS AcctOutputGigawords,
SUM(AcctSessionTime) AS AcctSessionTime
FROM
@TP@accounting
WHERE
Username = %{user.Username}
AND EventTimestamp > %{query.PeriodKey}
';
$config->{'accounting_select_duplicates_query'} = '
SELECT
ID
......@@ -282,6 +294,15 @@ sub init
$config->{'accounting_usage_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_usage_query'};
}
}
if (defined($scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}) &&
$scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'} ne "") {
if (ref($scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}) eq "ARRAY") {
$config->{'accounting_usage_query_period'} = join(' ',
@{$scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}});
} else {
$config->{'accounting_usage_query_period'} = $scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'};
}
}
if (defined($scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'}) &&
$scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'} ne "") {
if (ref($scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'}) eq "ARRAY") {
......@@ -301,10 +322,15 @@ sub init
}
}
if (defined($scfg->{'mod_accounting_sql'}->{'accounting_usage_cache_time'})) {
if ($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'} =~ /^\s*(yes|true|1)\s*$/i) {
# Default?
} elsif ($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'} =~ /^\s*(no|false|0)\s*$/i) {
$config->{'accounting_usage_cache_time'} = undef;
# Check if we're a boolean
if (defined(my $val = isBoolean($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'}))) {
# If val is true, we default to the default anyway
# We're disabled
if (!$val) {
$config->{'accounting_usage_cache_time'} = undef;
}
# We *could* have a value...
} elsif ($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'} =~ /^[0-9]+$/) {
$config->{'accounting_usage_cache_time'} = $scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'};
} else {
......@@ -324,20 +350,42 @@ sub init
# Function to get radius user data usage
# The 'period' parameter is optional and is the number of days to return usage for
sub getUsage
{
my ($server,$user,$packet) = @_;
my ($server,$user,$packet,$period) = @_;
# Build template
my $template;
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
$template->{'user'} = $user;
# Current PeriodKey
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Current PeriodKey, this is used for non-$period queries
my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
$template->{'query'}->{'PeriodKey'} = $now->strftime("%Y-%m");
# Query template to use below
my $queryTemplate;
# If we're doing a query for a specific period
if (defined($period)) {
# We need to switch out the query to the period query
$queryTemplate = "accounting_usage_query_period";
# Grab a clone of now, and create the start date DateTime object
my $startDate = $now->clone->subtract( 'days' => $period );
# And we add the start date
$template->{'query'}->{'PeriodKey'} = $startDate->ymd();
# If not, we just use PeriodKey as normal...
} else {
# Set the normal PeriodKey query template to use
$queryTemplate = "accounting_usage_query";
# And set the period key to this month
$template->{'query'}->{'PeriodKey'} = $now->strftime("%Y-%m");
}
# If we using caching, check how old the result is
if (defined($config->{'accounting_usage_cache_time'})) {
......@@ -349,20 +397,20 @@ sub getUsage
}
# Replace template entries
my (@dbDoParams) = templateReplace($config->{'accounting_usage_query'},$template);
my (@dbDoParams) = templateReplace($config->{$queryTemplate},$template);
# Fetch data
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
return;
}
# Our usage hash
my %usageTotals;
$usageTotals{'TotalSessionTime'} = Math::BigInt->new();
$usageTotals{'TotalDataInput'} = Math::BigInt->new();
$usageTotals{'TotalDataOutput'} = Math::BigInt->new();
$usageTotals{'TotalSessionTime'} = Math::BigInt->new(0);
$usageTotals{'TotalDataInput'} = Math::BigInt->new(0);
$usageTotals{'TotalDataOutput'} = Math::BigInt->new(0);
# Pull in usage and add up
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
......@@ -379,7 +427,7 @@ sub getUsage
}
if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
$inputGigawords->bmul(UINT_MAX);
$inputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{'TotalDataInput'}->badd($inputGigawords);
}
# Add output usage if we have any
......@@ -388,16 +436,16 @@ sub getUsage
}
if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
$outputGigawords->bmul(UINT_MAX);
$outputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{'TotalDataOutput'}->badd($outputGigawords);
}
}
DBFreeRes($sth);
# Convert to bigfloat for accuracy
my $totalData = Math::BigFloat->new();
my $totalData = Math::BigFloat->new(0);
$totalData->badd($usageTotals{'TotalDataOutput'})->badd($usageTotals{'TotalDataInput'});
my $totalTime = Math::BigFloat->new();
my $totalTime = Math::BigFloat->new(0);
$totalTime->badd($usageTotals{'TotalSessionTime'});
# Rounding up
......@@ -408,7 +456,7 @@ sub getUsage
# If we using caching and got here, it means that we must cache the result
if (defined($config->{'accounting_usage_cache_time'})) {
$res{'CachedUntil'} = $user->{'_Internal'}->{'Timestamp-Unix'} + $config->{'accounting_usage_cache_time'};
# Cache the result
cacheStoreComplexKeyPair('mod_accounting_sql(getUsage)',$user->{'Username'}."/".$template->{'query'}->{'PeriodKey'},\%res);
}
......@@ -429,6 +477,7 @@ sub acct_log
{
my ($server,$user,$packet) = @_;
# Build template
my $template;
foreach my $attr ($packet->attributes) {
......@@ -437,8 +486,9 @@ sub acct_log
# Fix event timestamp
$template->{'request'}->{'Timestamp'} = $user->{'_Internal'}->{'Timestamp'};
# Add user
$template->{'user'} = $user;
# 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'});
......@@ -447,11 +497,12 @@ sub acct_log
# For our queries
$template->{'query'}->{'PeriodKey'} = $periodKey;
# Default to being a new period, only if we update on INTERIM or STOP do we set this to 0
my $newPeriod = 1;
#
# U P D A T E & S T O P P A C K E T
#
# If its a new period we're going to trigger START
my $newPeriod;
if ($packet->rawattr('Acct-Status-Type') eq "2" || $packet->rawattr('Acct-Status-Type') eq "3") {
# Replace template entries
my @dbDoParams = templateReplace($config->{'accounting_update_get_records_query'},$template);
......@@ -459,16 +510,17 @@ sub acct_log
# Fetch previous records of the same session
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
return;
}
# Convert session total gigawords/octets into bytes
my $totalInputBytes = Math::BigInt->new();
$totalInputBytes->badd($template->{'request'}->{'Acct-Input-Gigawords'})->bmul(UINT_MAX);
# Convert session total gigawords into bytes
my $totalInputBytes = Math::BigInt->new($template->{'request'}->{'Acct-Input-Gigawords'});
my $totalOutputBytes = Math::BigInt->new($template->{'request'}->{'Acct-Output-Gigawords'});
$totalInputBytes->bmul(GIGAWORD_VALUE);
$totalOutputBytes->bmul(GIGAWORD_VALUE);
# Add byte counters
$totalInputBytes->badd($template->{'request'}->{'Acct-Input-Octets'});
my $totalOutputBytes = Math::BigInt->new();
$totalOutputBytes->badd($template->{'request'}->{'Acct-Output-Gigawords'})->bmul(UINT_MAX);
$totalOutputBytes->badd($template->{'request'}->{'Acct-Output-Octets'});
# Packets, no conversion
my $totalInputPackets = Math::BigInt->new($template->{'request'}->{'Acct-Input-Packets'});
......@@ -478,21 +530,31 @@ sub acct_log
# Loop through previous records and subtract them from our session totals
while (my $sessionPart = hashifyLCtoMC($sth->fetchrow_hashref(),
qw(InputOctets InputPackets OutputOctets OutputPackets InputGigawords OutputGigawords SessionTime PeriodKey)
qw(AcctInputOctets AcctInputPackets AcctOutputOctets AcctOutputPackets AcctInputGigawords AcctOutputGigawords
SessionTime PeriodKey)
)) {
# Convert this session usage to bytes
my $sessionInputBytes = Math::BigInt->new();
$sessionInputBytes->badd($sessionPart->{'InputGigawods'})->bmul(UINT_MAX);
$sessionInputBytes->badd($sessionPart->{'InputOctets'});
my $sessionOutputBytes = Math::BigInt->new();
$sessionOutputBytes->badd($sessionPart->{'OutputGigawods'})->bmul(UINT_MAX);
$sessionOutputBytes->badd($sessionPart->{'OutputOctets'});
# Make sure we treat undef values sort of sanely
$sessionPart->{'AcctInputGigawords'} //= 0;
$sessionPart->{'AcctInputOctets'} //= 0;
$sessionPart->{'AcctOutputGigawords'} //= 0;
$sessionPart->{'AcctOutputOctets'} //= 0;
$sessionPart->{'AcctInputPackets'} //= 0;
$sessionPart->{'AcctOutputPackets'} //= 0;
$sessionPart->{'AcctSessionTime'} //= 0;
# Convert the gigawords into bytes
my $sessionInputBytes = Math::BigInt->new($sessionPart->{'AcctInputGigawords'});
my $sessionOutputBytes = Math::BigInt->new($sessionPart->{'AcctOutputGigawords'});
$sessionInputBytes->bmul(GIGAWORD_VALUE);
$sessionOutputBytes->bmul(GIGAWORD_VALUE);
# Add the byte counters
$sessionInputBytes->badd($sessionPart->{'AcctInputOctets'});
$sessionOutputBytes->badd($sessionPart->{'AcctOutputOctets'});
# And packets
my $sessionInputPackets = Math::BigInt->new($sessionPart->{'InputPackets'});
my $sessionOutputPackets = Math::BigInt->new($sessionPart->{'OutputPackets'});
my $sessionInputPackets = Math::BigInt->new($sessionPart->{'AcctInputPackets'});
my $sessionOutputPackets = Math::BigInt->new($sessionPart->{'AcctOutputPackets'});
# Finally session time
my $sessionSessionTime = Math::BigInt->new($sessionPart->{'SessionTime'});
my $sessionSessionTime = Math::BigInt->new($sessionPart->{'AcctSessionTime'});
# Check if this record is from an earlier period
if (defined($sessionPart->{'PeriodKey'}) && $sessionPart->{'PeriodKey'} ne $periodKey) {
......@@ -511,36 +573,36 @@ sub acct_log
DBFreeRes($sth);
# Sanitize
if ($totalInputBytes->is_neg()) {
if ($totalInputBytes->is_neg()) {
$totalInputBytes->bzero();
}
if ($totalOutputBytes->is_neg()) {
if ($totalOutputBytes->is_neg()) {
$totalOutputBytes->bzero();
}
if ($totalInputPackets->is_neg()) {
if ($totalInputPackets->is_neg()) {
$totalInputPackets->bzero();
}
if ($totalOutputPackets->is_neg()) {
if ($totalOutputPackets->is_neg()) {
$totalOutputPackets->bzero();
}
if ($totalSessionTime->is_neg()) {
if ($totalSessionTime->is_neg()) {
$totalSessionTime->bzero();
}
# Re-calculate
my ($inputGigawordsStr,$inputOctetsStr) = $totalInputBytes->bdiv(UINT_MAX);
my ($outputGigawordsStr,$outputOctetsStr) = $totalOutputBytes->bdiv(UINT_MAX);
my ($inputGigawordsStr,$inputOctetsStr) = $totalInputBytes->bdiv(GIGAWORD_VALUE);
my ($outputGigawordsStr,$outputOctetsStr) = $totalOutputBytes->bdiv(GIGAWORD_VALUE);
# Conversion to strings
$template->{'query'}->{'InputGigawords'} = $inputGigawordsStr->bstr();
$template->{'query'}->{'InputOctets'} = $inputOctetsStr->bstr();
$template->{'query'}->{'OutputGigawords'} = $outputGigawordsStr->bstr();
$template->{'query'}->{'OutputOctets'} = $outputOctetsStr->bstr();
$template->{'query'}->{'Acct-Input-Gigawords'} = $inputGigawordsStr->bstr();
$template->{'query'}->{'Acct-Input-Octets'} = $inputOctetsStr->bstr();
$template->{'query'}->{'Acct-Output-Gigawords'} = $outputGigawordsStr->bstr();
$template->{'query'}->{'Acct-Output-Octets'} = $outputOctetsStr->bstr();
$template->{'query'}->{'InputPackets'} = $totalInputPackets->bstr();
$template->{'query'}->{'OutputPackets'} = $totalOutputPackets->bstr();
$template->{'query'}->{'Acct-Input-Packets'} = $totalInputPackets->bstr();
$template->{'query'}->{'Acct-Output-Packets'} = $totalOutputPackets->bstr();
$template->{'query'}->{'SessionTime'} = $totalSessionTime->bstr();
$template->{'query'}->{'Acct-Session-Time'} = $totalSessionTime->bstr();
# Replace template entries
......@@ -550,7 +612,7 @@ sub acct_log
$sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting ALIVE record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
......@@ -559,7 +621,7 @@ sub acct_log
# Be very sneaky .... if we updated something, this is obviously NOT a new period
$newPeriod = 0;
# If we updated a few things ... possibly duplicates?
if ($sth > 1) {
if ($sth > 1) {
fixDuplicates($server, $template);
}
}
......@@ -575,12 +637,11 @@ sub acct_log
if ($packet->rawattr('Acct-Status-Type') eq "1" || $newPeriod) {
# Replace template entries
my @dbDoParams = templateReplace($config->{'accounting_start_query'},$template);
# Insert into database
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to insert accounting START record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Update first login?
......@@ -592,7 +653,6 @@ sub acct_log
$user->{'_UserDB'}->{'Users_data_set'}($server,$user,'global','FirstLogin',$user->{'_Internal'}->{'Timestamp-Unix'});
}
}
}
......@@ -608,11 +668,12 @@ sub acct_log
# Update database (status)
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting STOP record: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting STOP record: %s",AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
}
return MOD_RES_ACK;
}
......@@ -629,7 +690,7 @@ sub fixDuplicates
# Select duplicates
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
return;
}
......@@ -652,7 +713,7 @@ sub fixDuplicates
# Delete duplicates
$sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -682,7 +743,7 @@ sub cleanup
# Last month..
my $lastMonth = $thisMonth->clone()->subtract( months => 1 );
my $prevPeriodKey = $lastMonth->strftime("%Y-%m");
# Begin transaction
DBBegin();
......@@ -700,7 +761,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to delete accounting summary record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -725,7 +786,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to select accounting record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
return;
}
......@@ -747,7 +808,7 @@ sub cleanup
}
if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
$inputGigawords->bmul(UINT_MAX);
$inputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
}
# Add output usage if we have any
......@@ -756,7 +817,7 @@ sub cleanup
}
if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
$outputGigawords->bmul(UINT_MAX);
$outputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
}
......@@ -764,9 +825,9 @@ sub cleanup
} else {
# Make BigInts for this user
$usageTotals{$row->{'Username'}}{'TotalSessionTime'} = Math::BigInt->new();
$usageTotals{$row->{'Username'}}{'TotalDataInput'} = Math::BigInt->new();
$usageTotals{$row->{'Username'}}{'TotalDataOutput'} = Math::BigInt->new();
$usageTotals{$row->{'Username'}}{'TotalSessionTime'} = Math::BigInt->new(0);
$usageTotals{$row->{'Username'}}{'TotalDataInput'} = Math::BigInt->new(0);
$usageTotals{$row->{'Username'}}{'TotalDataOutput'} = Math::BigInt->new(0);
# Look for session time
if (defined($row->{'AcctSessionTime'}) && $row->{'AcctSessionTime'} > 0) {
......@@ -778,7 +839,7 @@ sub cleanup
}
if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
$inputGigawords->bmul(UINT_MAX);
$inputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
}
# Add output usage if we have any
......@@ -787,7 +848,7 @@ sub cleanup
}
if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
$outputGigawords->bmul(UINT_MAX);
$outputGigawords->bmul(GIGAWORD_VALUE);
$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
}
......@@ -832,7 +893,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to create accounting summary record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -849,5 +910,6 @@ sub cleanup
}
1;
# vim: ts=4
smradius/modules/accounting/mod_accounting_test.pm → lib/smradius/modules/accounting/mod_accounting_test.pm
View file @ b659b33b
# Test accounting database
# Copyright (C) 2007-2015, AllWorldIT
#
# 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.
......@@ -99,7 +99,10 @@ Acct-Delay-Time: %{accounting.Acct-Delay-Time}
foreach my $attr ($packet->attributes) {
$template->{'accounting'}->{$attr} = $packet->attr($attr)
}
$template->{'user'} = $user;
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
if ($packet->rawattr('Acct-Status-Type') eq "1") {
$server->log(LOG_DEBUG,"Start Packet: ".$packet->dump());
......
smradius/modules/features/mod_feature_capping.pm → lib/smradius/modules/features/mod_feature_capping.pm
View file @ b659b33b
# Capping support
# Copyright (C) 2007-2016, AllWorldIT
# 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
......@@ -27,11 +27,19 @@ use smradius::logging;
use smradius::util;
use AWITPT::Util;
use POSIX qw(floor);
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(
);
......@@ -57,9 +65,6 @@ 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 $TRAFFIC_AUTOTOPUP_ATTRIBUTE = 'SMRadius-Capping-Traffic-AutoTopup';
my $TIME_AUTOTOPUP_ATTRIBUTE = 'SMRadius-Capping-Uptime-AutoTopup';
my $config;
......@@ -72,21 +77,34 @@ sub init
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 ($scfg->{'mod_feature_capping'}{'enable_mikrotik'} =~ /^\s*(yes|true|1)\s*$/i) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Mikrotik-specific vendor return attributes ENABLED");
$config->{'enable_mikrotik'} = $scfg->{'mod_feature_capping'}{'enable_mikrotik'};
# Default?
} elsif ($scfg->{'mod_feature_capping'}{'enable_mikrotik'} =~ /^\s*(no|false|0)\s*$/i) {
$config->{'enable_mikrotik'} = undef;
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;
......@@ -120,6 +138,20 @@ sub post_auth_hook
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
......@@ -135,19 +167,15 @@ sub post_auth_hook
# 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;
my $uptimeAutoTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_AUTOTOPUP_ATTRIBUTE) // 0;
my $trafficAutoTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_AUTOTOPUP_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;
......@@ -157,24 +185,41 @@ sub post_auth_hook
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
#
_logUptimeUsage($server,$accountingUsage,$uptimeLimit,$uptimeTopupAmount);
_logTrafficUsage($server,$accountingUsage,$trafficLimit,$trafficTopupAmount);
_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 client attribute
# Allow for capping overrides by attribute
#
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'})) {
......@@ -186,7 +231,7 @@ sub post_auth_hook
$uptimeLimitWithTopups = $newLimit;
$accountingUsage->{'TotalSessionTime'} = $newSessionTime;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Client uptime multiplier '$multiplier' changes ".
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User uptime multiplier '$multiplier' changes ".
"uptime limit ('$uptimeLimitWithTopups' => '$newLimit'), ".
"uptime usage ('".$accountingUsage->{'TotalSessionTime'}."' => '$newSessionTime')"
);
......@@ -200,7 +245,7 @@ sub post_auth_hook
$trafficLimitWithTopups = $newLimit;
$accountingUsage->{'TotalDataUsage'} = $newDataUsage;
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Client traffic multiplier '$multiplier' changes ".
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User traffic multiplier '$multiplier' changes ".
"traffic limit ('$trafficLimitWithTopups' => '$newLimit'), ".
"traffic usage ('".$accountingUsage->{'TotalDataUsage'}."' => '$newDataUsage')"
);
......@@ -211,8 +256,8 @@ sub post_auth_hook
# Check if we've exceeded our limits
#
# Uptime..
if (!defined($uptimeLimit) || $uptimeLimit > 0) {
# Uptime...
if (defined($uptimeLimit)) {
# Check session time has not exceeded what we're allowed
if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
......@@ -223,7 +268,7 @@ sub post_auth_hook
} else {
# Check if we returning Mikrotik vattributes
# FIXME: NK - this is not mikrotik specific
if (defined($config->{'enable_mikrotik'})) {
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 = (
......@@ -237,7 +282,7 @@ sub post_auth_hook
}
# Traffic
if (!defined($trafficLimit) || $trafficLimit > 0) {
if (defined($trafficLimit)) {
# Capped
if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
......@@ -247,7 +292,7 @@ sub post_auth_hook
# Setup limits
} else {
# Check if we returning Mikrotik vattributes
if (defined($config->{'enable_mikrotik'})) {
if ($config->{'enable_mikrotik'}) {
# Get remaining traffic
my $remainingTraffic = $trafficLimitWithTopups - $accountingUsage->{'TotalDataUsage'};
my $remainingTrafficLimit = ( $remainingTraffic % 4096 ) * 1024 * 1024;
......@@ -301,7 +346,7 @@ sub post_acct_hook
# Skip MAC authentication
return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
# Exceeding maximum, must be disconnected
# 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");
......@@ -314,6 +359,19 @@ sub post_acct_hook
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
......@@ -332,8 +390,6 @@ sub post_acct_hook
# 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;
my $uptimeAutoTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_AUTOTOPUP_ATTRIBUTE) // 0;
my $trafficAutoTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_AUTOTOPUP_ATTRIBUTE) // 0;
#
......@@ -348,12 +404,30 @@ sub post_acct_hook
# // 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
#
_logUptimeUsage($server,$accountingUsage,$uptimeLimit,$uptimeTopupAmount);
_logTrafficUsage($server,$accountingUsage,$trafficLimit,$trafficTopupAmount);
_logUsage($server,$accountingUsage->{'TotalDataUsage'},$trafficLimit,$trafficTopupAmount,'traffic');
_logUsage($server,$accountingUsage->{'TotalSessionTime'},$uptimeLimit,$uptimeTopupAmount,'uptime');
#
......@@ -366,20 +440,20 @@ sub post_acct_hook
#
# Allow for capping overrides by client attribute
# 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] Client cap uptime multiplier '$multiplier' changes limit ".
$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] Client cap traffic multiplier '$multiplier' changes limit ".
$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User cap traffic multiplier '$multiplier' changes limit ".
"from '$trafficLimitWithTopups' to '$newLimit'");
$trafficLimitWithTopups = $newLimit;
}
......@@ -390,7 +464,7 @@ sub post_acct_hook
#
# Uptime..
if (!defined($uptimeLimit) || $uptimeLimit > 0) {
if (defined($uptimeLimit)) {
# Capped
if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
......@@ -401,7 +475,7 @@ sub post_acct_hook
}
# Traffic
if (!defined($trafficLimit) || $trafficLimit > 0) {
if (defined($trafficLimit)) {
# Capped
if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
......@@ -417,7 +491,7 @@ sub post_acct_hook
## @internal
# Code snippet to grab the current uptime limit by processing the user attributes
# Code snippet to grab the current attribute key limit by processing the user attributes
sub _getAttributeKeyLimit
{
my ($server,$user,$attributeKey) = @_;
......@@ -474,62 +548,30 @@ sub _getAccountingUsage
## @internal
# Code snippet to log our uptime usage
sub _logUptimeUsage
sub _logUsage
{
my ($server,$accountingUsage,$uptimeLimit,$uptimeTopupAmount) = @_;
my ($server,$accountingUsage,$limit,$topupAmount,$type) = @_;
# Check if our limit is defined
if (!defined($uptimeLimit)) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Uptime => Usage total: ".$accountingUsage->{'TotalSessionTime'}.
"min (Limit: Prepaid, Topups: ".$uptimeTopupAmount."min)");
return;
}
# If so, check if its > 0, which would depict its capped
if ($uptimeLimit > 0) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Uptime => Usage total: ".$accountingUsage->{'TotalSessionTime'}.
"min (Limit: ".$uptimeLimit."min, Topups: ".$uptimeTopupAmount."min)");
} else {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Uptime => Usage total: ".$accountingUsage->{'TotalSessionTime'}.
"min (Limit: none, Topups: ".$uptimeTopupAmount."min)");
}
return;
}
## @internal
# Code snippet to log our traffic usage
sub _logTrafficUsage
{
my ($server,$accountingUsage,$trafficLimit,$trafficTopupAmount) = @_;
my $typeKey = ucfirst($type);
# Check if our limit is defined
if (!defined($trafficLimit)) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Bandwidth => Usage total: ".$accountingUsage->{'TotalDataUsage'}.
"Mbyte (Limit: Prepaid, Topups: ".$trafficTopupAmount."Mbyte)");
return;
}
# If so, check if its > 0, which would depict its capped
if ($trafficLimit > 0) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Bandwidth => Usage total: ".$accountingUsage->{'TotalDataUsage'}.
"Mbyte (Limit: ".$trafficLimit."Mbyte, Topups: ".$trafficTopupAmount."Mbyte)");
if (defined($limit) && $limit == 0) {
$limit = '-topup-';
} else {
$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Bandwidth => Usage total: ".$accountingUsage->{'TotalDataUsage'}.
"Mbyte (Limit: none, Topups: ".$trafficTopupAmount."Mbyte)");
$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 numeric configuration attribute
# Function snippet to return a user attribute
sub _getConfigAttributeNumeric
{
my ($server,$user,$attributeName) = @_;
......@@ -557,5 +599,264 @@ sub _getConfigAttributeNumeric
## @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
smradius/modules/features/mod_feature_update_user_stats_sql.pm → lib/smradius/modules/features/mod_feature_update_user_stats_sql.pm
View file @ b659b33b
# Support for updating of user stats
# Copyright (C) 2007-2011, AllWorldIT
#
# 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.
......@@ -74,7 +74,8 @@ sub init
PeriodKey = %{query.PeriodKey},
TotalTraffic = %{query.TotalTraffic},
TotalUptime = %{query.TotalUptime},
NASIdentifier = %{request.NAS-Identifier}
NASIdentifier = %{request.NAS-Identifier},
LastAcctUpdate = now()
WHERE
Username = %{user.Username}
';
......@@ -109,9 +110,9 @@ sub updateUserStats
# Skip MAC authentication
return MOD_RES_SKIP if (defined($user->{'_UserDB'}->{'Name'}) &&
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
......@@ -119,7 +120,10 @@ sub updateUserStats
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
$template->{'user'} = $user;
# 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'});
......@@ -152,7 +156,7 @@ sub updateUserStats
# 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());
$server->log(LOG_ERR,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Database query failed: ".AWITPT::DB::DBLayer::error());
return;
}
......
smradius/modules/features/mod_feature_user_stats.pm → lib/smradius/modules/features/mod_feature_user_stats.pm
View file @ b659b33b
......@@ -147,6 +147,23 @@ sub updateUserStats
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;
......
smradius/modules/features/mod_feature_validity.pm → lib/smradius/modules/features/mod_feature_validity.pm
View file @ b659b33b
# Validity support
# Copyright (C) 2007-2011, AllWorldIT
#
# 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,12 +28,10 @@ use DateTime;
use Date::Parse;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
use base qw(Exporter);
our @EXPORT = qw(
);
@EXPORT_OK = qw(
our @EXPORT_OK = qw(
);
......@@ -41,7 +39,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
our $pluginInfo = {
Name => "User Validity Feature",
Init => \&init,
# Authentication hook
'Feature_Post-Authentication_hook' => \&checkValidity,
'Feature_Post-Accounting_hook' => \&checkValidity
......@@ -148,15 +146,15 @@ sub checkValidity
if (defined($validFrom)) {
# Convert string to datetime
my $validFrom_unixtime = str2time($validFrom);
my $validFrom_unixtime = str2time($validFrom,$server->{'smradius'}->{'event_timezone'});
if (!defined($validFrom_unixtime)) {
$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] Date conversion failed on '".$validFrom."'");
$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: '".$pretty_dt."', rejecting");
$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;
......@@ -167,14 +165,14 @@ sub checkValidity
if (defined($validTo)) {
# Convert string to datetime
my $validTo_unixtime = str2time($validTo);
my $validTo_unixtime = str2time($validTo,$server->{'smradius'}->{'event_timezone'});
if (!defined($validTo_unixtime)) {
$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Date conversion failed on '".$validTo."'");
$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: '".$pretty_dt."', rejecting");
$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;
......@@ -194,18 +192,20 @@ sub checkValidity
# 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: '".$pretty_dt."', rejecting");
$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 '".$user->{'Username'}."'");
$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 '".$user->{'_UserDB'}->{'Name'}.
"' does not support 'users_data'. Therefore no support for Validity Window feature");
$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'})) {
}
......
smradius/modules/system/mod_config_sql.pm → lib/smradius/modules/system/mod_config_sql.pm
View file @ b659b33b
# SQL config database support
# Copyright (C) 2007-2011, AllWorldIT
# 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
......@@ -171,7 +171,7 @@ sub getConfig
$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());
$server->log(LOG_ERR,"Failed to get default realm ID: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Set realm ID
......@@ -186,7 +186,7 @@ sub getConfig
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());
$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
......@@ -197,14 +197,14 @@ sub getConfig
}
# Extract realm from username
if (defined($user->{'Username'}) && $user->{'Username'} =~ /^\S+@(\S+)$/) {
$realmName = $1;
$server->log(LOG_DEBUG,"Processing realm attributes for '$realmName'");
if (defined($user->{'Username'}) && $user->{'Username'} =~ /^\S+(?:@(\S+))?$/) {
my $userRealm = $1 // "";
$sth = DBSelect($config->{'get_config_realm_id_query'},$realmName);
$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 user realm config attributes: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to get realm config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Fetch realm ID
......@@ -216,7 +216,7 @@ sub getConfig
# User realm attributes
$sth = DBSelect($config->{'get_config_realm_attributes_query'},$realmID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get user realm config attributes: ".AWITPT::DB::DBLayer::Error());
$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
......@@ -224,6 +224,8 @@ sub getConfig
processConfigAttribute($server,$user,hashifyLCtoMC($row, qw(Name Operator Value)));
}
DBFreeRes($sth);
$realmName = $userRealm;
}
}
......@@ -233,6 +235,8 @@ sub getConfig
return MOD_RES_NACK;
}
$server->log(LOG_DEBUG,"Realm '$realmName' has ID '$realmID'");
# Get client name
my $clientID;
......@@ -258,13 +262,12 @@ sub getConfig
$sth = DBSelect($config->{'get_config_accesslist_query'},$realmID);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get config attributes: ".AWITPT::DB::DBLayer::Error());
$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()) {
......@@ -274,9 +277,9 @@ sub getConfig
@accessList = split(',',$res->{'AccessList'});
# Loop with what we get and check if we have match
foreach my $range (@accessList) {
my $rangeObj = new AWITPT::NetIP->new($range);
my $rangeObj = AWITPT::NetIP->new($range);
# Check for match
if ($peerAddrObj->is_within($rangeObj)) {
if ($peerAddrObj->is_within($rangeObj)) {
$clientID = $res->{'ID'};
$server->log(LOG_INFO,"(SETCACHE) Got client ID '$clientID' from DB");
last;
......@@ -300,7 +303,7 @@ sub getConfig
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());
$server->log(LOG_ERR,"Failed to get default config attributes: ".AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Add to config attributes
......
smradius/modules/system/mod_config_sql_topups.pm → lib/smradius/modules/system/mod_config_sql_topups.pm
View file @ b659b33b
......@@ -28,21 +28,18 @@ use AWITPT::Util;
use smradius::util;
use smradius::attributes;
use POSIX qw(ceil strftime);
use POSIX qw(ceil);
use DateTime;
use Date::Parse;
use Math::BigInt;
use Math::BigFloat;
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
use base qw(Exporter);
our @EXPORT = qw(
);
@EXPORT_OK = qw(
our @EXPORT_OK = qw(
);
......@@ -57,7 +54,10 @@ our $pluginInfo = {
Cleanup => \&cleanup,
# User database
Config_get => \&getTopups
Config_get => \&getTopups,
# Topups
Feature_Config_Topop_add => \&addTopup,
};
# Module config
......@@ -118,6 +118,29 @@ sub init
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'})) {
......@@ -140,6 +163,15 @@ sub init
}
}
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'};
}
}
}
}
......@@ -185,7 +217,7 @@ sub getTopups
# Query database
my $sth = DBSelect($config->{'get_topups_summary_query'},$periodKey,$username);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get topup information: ".AWITPT::DB::DBLayer::Error());
$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))) {
......@@ -196,7 +228,7 @@ sub getTopups
# Query database
$sth = DBSelect($config->{'get_topups_query'},$thisMonth->ymd,$now->ymd,$username);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get topup information: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to get topup information: %s",AWITPT::DB::DBLayer::error());
return MOD_RES_NACK;
}
# Fetch all new topups
......@@ -254,7 +286,7 @@ sub cleanup
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select users: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
return;
}
......@@ -283,7 +315,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to delete topup summaries: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -299,8 +331,7 @@ sub cleanup
SMAdminDepletedOn >= ?', $thisMonth->ymd()
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to undeplete topups: ".
AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to undeplete topups: ".AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -319,7 +350,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to retrieve accounting summaries: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
DBRollback();
return;
}
......@@ -346,14 +377,14 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select accounting summary record: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
# Our usage hash
my %usageTotals;
$usageTotals{'TotalSessionTime'} = Math::BigInt->new();
$usageTotals{'TotalDataUsage'} = Math::BigInt->new();
$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(),
......@@ -396,7 +427,7 @@ sub cleanup
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select group usage caps: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -451,7 +482,7 @@ sub cleanup
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select user usage caps: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -520,7 +551,7 @@ sub cleanup
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topup summaries: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -532,7 +563,7 @@ sub cleanup
if (defined($row->{'ValidTo'})) {
# Convert string to unix time
my $unix_validTo = str2time($row->{'ValidTo'});
my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
# Process traffic topup
if (_isTrafficTopup($row->{'Type'})) {
push(@trafficSummary, {
......@@ -590,8 +621,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topups: ".
AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topups: ".AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -600,7 +630,7 @@ sub cleanup
while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Value Type ValidTo))) {
# Convert string to unix time
my $unix_validTo = str2time($row->{'ValidTo'});
my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
# If this is a traffic topup ...
if (_isTrafficTopup($row->{'Type'})) {
push(@trafficTopups, {
......@@ -983,7 +1013,7 @@ sub cleanup
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to create topup summary: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -1010,7 +1040,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to deplete topup: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -1036,7 +1066,7 @@ sub cleanup
);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to update topups_summary: ".
AWITPT::DB::DBLayer::Error());
AWITPT::DB::DBLayer::error());
goto FAIL_ROLLBACK;
}
......@@ -1060,6 +1090,47 @@ FAIL_ROLLBACK:
## @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
......
smradius/modules/system/mod_config_test.pm → lib/smradius/modules/system/mod_config_test.pm
View file @ b659b33b
......@@ -15,7 +15,7 @@
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package smradius::smradius::modules::system::mod_config_test;
package smradius::modules::system::mod_config_test;
use strict;
use warnings;
......