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
# SQL user database support for mac authentication
# 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.
......@@ -21,13 +21,13 @@ use strict;
use warnings;
# Modules we need
use smradius::constants;
use AWITPT::Cache;
use smradius::logging;
use AWITPT::DB::DBLayer;
use AWITPT::Util;
use smradius::util;
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::util;
# Exporter stuff
require Exporter;
......@@ -70,7 +70,7 @@ sub init
# Default configs...
$config->{'userdb_macauth_find_query'} = '
SELECT
user_attributes.ID,
user_attributes.ID,
user_attributes.Operator, user_attributes.Disabled,
users.Username, users.Disabled AS UserDisabled
FROM
......@@ -130,7 +130,8 @@ sub find
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
$template->{'user'} = $user;
# Add MAC address details
$template->{'user'}->{'MACAddress'} = $macAddress;
# Replace template entries
......@@ -138,7 +139,7 @@ sub find
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_USERDB_MACAUTH_SQL] Failed to find data for MAC address: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_USERDB_MACAUTH_SQL] Failed to find data for MAC address: ".AWITPT::DB::DBLayer::error());
return MOD_RES_SKIP;
}
......
# SQL user 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
# 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.
......@@ -21,13 +21,13 @@ use strict;
use warnings;
# Modules we need
use smradius::constants;
use AWITPT::Cache;
use smradius::logging;
use AWITPT::DB::DBLayer;
use AWITPT::Util;
use smradius::util;
use smradius::attributes;
use smradius::constants;
use smradius::logging;
use smradius::util;
# Exporter stuff
require Exporter;
......@@ -91,7 +91,7 @@ sub init
FROM
@TP@group_attributes, @TP@users_to_groups
WHERE
@TP@users_to_groups.UserID = %{userdb.ID}
@TP@users_to_groups.UserID = %{user.ID}
AND @TP@group_attributes.GroupID = @TP@users_to_groups.GroupID
AND @TP@group_attributes.Disabled = 0
';
......@@ -102,22 +102,22 @@ sub init
FROM
@TP@user_attributes
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Disabled = 0
';
$config->{'users_data_set_query'} = '
INSERT INTO
@TP@users_data (UserID, LastUpdated, Name, Value)
VALUES
(
%{userdb.ID},
%{user.ID},
%{query.LastUpdated},
%{query.Name},
%{query.Value}
)
';
$config->{'users_data_update_query'} = '
UPDATE
@TP@users_data
......@@ -125,25 +125,25 @@ sub init
LastUpdated = %{query.LastUpdated},
Value = %{query.Value}
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
';
$config->{'users_data_get_query'} = '
SELECT
LastUpdated, Name, Value
FROM
@TP@users_data
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
';
$config->{'users_data_delete_query'} = '
DELETE FROM
@TP@users_data
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
';
......@@ -165,10 +165,10 @@ sub init
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}) &&
$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'} ne "") {
if (ref($scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}) eq "ARRAY") {
$config->{'userdb_get_group_attributes_query'} = join(' ',
$config->{'userdb_get_group_attributes_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'}});
} else {
$config->{'userdb_get_group_attributes_query'} =
$config->{'userdb_get_group_attributes_query'} =
$scfg->{'mod_userdb_sql'}->{'userdb_get_group_attributes_query'};
}
}
......@@ -179,7 +179,7 @@ sub init
$config->{'userdb_get_user_attributes_query'} = join(' ',
@{$scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'}});
} else {
$config->{'userdb_get_user_attributes_query'} =
$config->{'userdb_get_user_attributes_query'} =
$scfg->{'mod_userdb_sql'}->{'userdb_get_user_attributes_query'};
}
}
......@@ -225,10 +225,14 @@ sub init
}
if (defined($scfg->{'mod_userdb_sql'}->{'userdb_data_cache_time'})) {
if ($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'} =~ /^\s*(yes|true|1)\s*$/i) {
# Default?
} elsif ($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'} =~ /^\s*(no|false|0)\s*$/i) {
$config->{'userdb_data_cache_time'} = undef;
if (defined(my $val = isBoolean($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'}))) {
# If val is true, we default to the default anyway
# We're disabled
if (!$val) {
$config->{'userdb_data_cache_time'} = undef;
}
# We *could* have a value...
} elsif ($scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'} =~ /^[0-9]+$/) {
$config->{'userdb_data_cache_time'} = $scfg->{'mod_userdb_sql'}{'userdb_data_cache_time'};
} else {
......@@ -264,14 +268,16 @@ sub find
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
$template->{'user'} = $user;
# Add user details, not user ID is available here as thats what we are retrieving
$template->{'user'}->{'Username'} = $user->{'Username'};
# Replace template entries
my @dbDoParams = templateReplace($config->{'userdb_find_query'},$template);
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"[MOD_USERDB_SQL] Failed to find user data: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"[MOD_USERDB_SQL] Failed to find user data: ".AWITPT::DB::DBLayer::error());
return MOD_RES_SKIP;
}
......@@ -320,6 +326,11 @@ sub get
foreach my $attr ($packet->attributes) {
$template->{'request'}->{$attr} = $packet->rawattr($attr)
}
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
......@@ -331,7 +342,7 @@ sub get
# Query database
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get group attributes: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to get group attributes: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
......@@ -349,7 +360,7 @@ sub get
# Query database
$sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get user attributes: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to get user attributes: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
......@@ -381,23 +392,28 @@ sub data_set
# Build template
my $template;
# Last updated time would be now
$template->{'query'}->{'LastUpdated'} = $user->{'_Internal'}->{'Timestamp'};
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
$template->{'query'}->{'Value'} = $value;
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
# Last updated time would be now
$template->{'query'}->{'LastUpdated'} = $user->{'_Internal'}->{'Timestamp'};
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
$template->{'query'}->{'Value'} = $value;
# Replace template entries
my @dbDoParams = templateReplace($config->{'users_data_update_query'},$template);
# Query database
my $sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to update users data: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to update users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
......@@ -408,7 +424,7 @@ sub data_set
# Insert
$sth = DBDo(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to set users data: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to set users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
}
......@@ -422,7 +438,7 @@ sub data_set
$data{'Module'} = $module;
$data{'Name'} = $name;
$data{'Value'} = $value;
# Cache the result
cacheStoreComplexKeyPair('mod_userdb_sql(users_data)',
sprintf('%s/%s/%s',$module,$user->{'_UserDB_Data'}->{'ID'},$name),
......@@ -453,13 +469,18 @@ sub data_get
# Build template
my $template;
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
# Add user details
$template->{'user'}->{'ID'} = $user->{'ID'};
$template->{'user'}->{'Username'} = $user->{'Username'};
# Add in userdb data
foreach my $item (keys %{$user->{'_UserDB_Data'}}) {
$template->{'userdb'}->{$item} = $user->{'_UserDB_Data'}->{$item};
}
$template->{'query'}->{'Name'} = sprintf('%s/%s',$module,$name);
# If we using caching, check how old the result is
if (defined($config->{'userdb_data_cache_time'})) {
my ($res,$val) = cacheGetComplexKeyPair('mod_userdb_sql(data_get)',
......@@ -477,7 +498,7 @@ sub data_get
# Query database
my $sth = DBSelect(@dbDoParams);
if (!$sth) {
$server->log(LOG_ERR,"Failed to get users data: ".AWITPT::DB::DBLayer::Error());
$server->log(LOG_ERR,"Failed to get users data: ".AWITPT::DB::DBLayer::error());
return RES_ERROR;
}
......@@ -497,7 +518,7 @@ sub data_get
# If we using caching and got here, it means that we must cache the result
if (defined($config->{'userdb_data_cache_time'})) {
$data{'CachedUntil'} = $user->{'_Internal'}->{'Timestamp-Unix'} + $config->{'userdb_data_cache_time'};
# Cache the result
cacheStoreComplexKeyPair('mod_userdb_sql(users_data)',
sprintf('%s/%s/%s',$module,$user->{'_UserDB_Data'}->{'ID'},$name),
......
# SMRadius Utility Functions
# Copyright (C) 2007-2016, AllWorldIT
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
=encoding utf8
=head1 NAME
smradius::util - SMRadius utils
=head1 SYNOPSIS
my ($str,@vals) = templateReplace("SELECT * FROM abc WHERE %{abc} = ?",{ 'abc' => "some value" });
my $str = quickTemplateToolkit('someval is "[% someval %]"',{ 'someval' = "hello world" });
=head1 DESCRIPTION
The smradius::util class provides utility classes for SMRadius.
=cut
package smradius::util;
use parent qw(Exporter);
use strict;
use warnings;
our (@EXPORT_OK,@EXPORT);
@EXPORT_OK = qw(
);
@EXPORT = qw(
templateReplace
quickTemplateToolkit
);
use Template;
=head1 METHODS
The following utility methods are available.
=cut
=head2 templateReplace
my ($str,@vals) = templateReplace("SELECT * FROM abc WHERE %{abc} = ?",{ 'abc' => "some value" });
The C<templatereplace> method is used to replace variables with a placeholder. This is very useful for SQL templates. The values
are returned in the second and subsequent array items.
=over
=back
=cut
# Replace hashed variables with placeholders and return an array with the values.
sub templateReplace
{
my ($string,$hashref,$placeholder) = @_;
my @valueArray = ();
$placeholder //= '?';
# Replace blanks
while (my ($entireMacro,$section,$item,$default) = ($string =~ /(\%\{([a-z]+)\.([a-z0-9\-]+)(?:=([^\}]*))?\})/i )) {
# Replace macro with ? or the placeholder if specified
# We also quote the entireMacro
$string =~ s/\Q$entireMacro\E/$placeholder/;
# Get value to substitute
my $value = (defined($hashref->{$section}) && defined($hashref->{$section}->{$item})) ?
$hashref->{$section}->{$item} : $default;
# Add value onto our array
push(@valueArray,$value);
}
return ($string, @valueArray);
}
=head2 quickTemplateToolkit
my $str = quickTemplateToolkit('someval is "[% someval %]"',{ 'someval' = "hello world" });
The C<quickTemplateToolkit> is a quick and easy template toolkit function.
=over
=back
=cut
# Replace hashed variables with placeholders and return an array with the values.
sub quickTemplateToolkit
{
my ($string,$variables) = @_;
# This is the config we're going to pass to Template
my $config = {
# Our include path built below
INCLUDE_PATH => [ ],
};
# Create template engine
my $tt = Template->new($config);
# Process the template and output to our OUTPUT_PATH
my $output = "";
if (!(my $res = $tt->process(\$string, $variables, \$output))) {
return (undef,$tt->error());
}
return $output;
}
1;
__END__
=head1 AUTHORS
Nigel Kukard E<lt>nkukard@lbsd.netE<gt>
=head1 BUGS
All bugs should be reported via the project issue tracker
L<http://gitlab.devlabs.linuxassist.net/awit-frameworks/awit-perl-toolkit/issues/>.
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2007-2016, AllWorldIT
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
=head1 SEE ALSO
L<Template>.
=cut
# SMRadius version package
# 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.
......@@ -27,13 +27,19 @@ require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
$VERSION
VERSION
);
@EXPORT_OK = qw(
);
our $VERSION = "1.0.1";
use constant {
VERSION => "0.1.x",
};
sub VERSION { return $VERSION };
......
#!/usr/bin/perl
# Radius client
# 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.
use strict;
use warnings;
use lib('/usr/local/lib/smradius-0.0','/usr/lib/smradius-0.0',
'/usr/lib64/smradius-0.0','smradius','awitpt');
# 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;
}
use Getopt::Long;
use IO::Select;
use IO::Socket;
use smradius::version;
use Radius::Packet;
# Display help
sub displayHelp {
print(STDERR<<EOF);
Usage: $0 [args] <server> <acct|auth|disconnect> <secret>
--raddb Directory where the radius dictionary files are
EOF
return;
}
print(STDERR "SMRadClient v".VERSION." - Copyright (c) 2007-2016, AllWorldIT\n");
# Set defaults
my $cfg;
$cfg->{'config_file'} = "/etc/smradiusd.conf";
# Parse command line params
my $cmdline;
%{$cmdline} = ();
GetOptions(
\%{$cmdline},
"config:s",
"raddb:s",
"help",
) or die "Error parsing commandline arguments";
# Check for some args
if ($cmdline->{'help'}) {
displayHelp();
exit 0;
}
# Make sure we only have 2 additional args
if (@ARGV > 3 || @ARGV < 3) {
print(STDERR "ERROR: Invalid number of arguments\n\n");
displayHelp();
exit 1;
}
if (!defined($cmdline->{'raddb'}) || $cmdline->{'raddb'} eq "") {
print(STDERR "ERROR: No raddb directory specified!\n\n");
displayHelp();
exit 1;
}
# Get variables we need
my ($server,$type,$secret) = @ARGV;
# Validate type
if (!defined($type) || ( $type ne "acct" && $type ne "auth" &&
$type ne "disconnect"
)){
print(STDERR "ERROR: Invalid packet type specified!\n\n");
displayHelp();
exit 1;
}
#if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") {
# $cfg->{'config_file'} = $cmdline->{'config'};
#}
# Check config file exists
#if (! -f $cfg->{'config_file'}) {
# die("No configuration file '".$cfg->{'config_file'}."' found!\n");
#}
# Use config file, ignore case
#tie my %inifile, 'Config::IniFiles', (
# -file => $cfg->{'config_file'},
# -nocase => 1
#) or die "Failed to open config file '".$cfg->{'config_file'}."': $!";
# Copy config
#my %config = %inifile;
print(STDERR "\n");
# Time to start loading the dictionary
print(STDERR "Loading dictionaries...");
my $raddb = Radius::Dictionary->new();
# Look for files in the dir
opendir(my $DIR, $cmdline->{'raddb'})
or die "Cannot open '".$cmdline->{'raddb'}."': $!";
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");
print(STDERR " > Secret => '$secret'\n");
# Build packet
my $pkt = Radius::Packet->new($raddb);
$pkt->set_code($pkt_code);
# Generate identifier
my $ident = rand(32768);
$pkt->set_identifier($ident);
print(STDERR " > Identifier: $ident\n");
# Generate authenticator number
my $authen = rand(32768);
$pkt->set_authenticator($authen);
print(STDERR " > Authenticator: $ident\n");
# Pull in attributes
while (my $line = <STDIN>) {
# 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?(.+)/);
# Add to packet
print(STDERR " > Adding '$name' => '$value'\n");
if ($name eq "User-Password") {
$pkt->set_password($value,$secret);
} else {
$pkt->set_attr($name,$value);
}
}
}
# Create UDP packet
my $udp_packet = $pkt->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");
}
# Check if we sent the packet...
if (!$sock->send($udp_packet)) {
print(STDERR "ERROR: Failed to send data on socket\n");
exit 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");
exit 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");
exit 1;
}
# Read packet
$sock->recv($udp_packet, 65536);
if (!$udp_packet) {
print(STDERR "ERROR: Receive response data failed: $!\n");
exit 1;
}
# Parse packet
$pkt = Radius::Packet->new($raddb,$udp_packet);
print(STDERR " > Authenticated: ". (defined(auth_req_verify($udp_packet,$secret,$authen)) ? "yes" : "no") ."\n");
print(STDERR $pkt->str_dump());
1;
# vim: ts=4
......@@ -20,8 +20,8 @@
# Preforking configuration
#
# min_server - Minimum servers to keep around
# min_spare_servers - Minimum spare servers to keep around ready to
# handle requests
# min_spare_servers - Minimum spare servers to keep around ready to
# handle requests
# max_spare_servers - Maximum spare servers to have around doing nothing
# max_servers - Maximum servers alltogether
# max_requests - Maximum number of requests each child will serve
......@@ -44,14 +44,14 @@
# 1 - Warnings and errors
# 2 - Notices, warnings, errors
# 3 - Info, notices, warnings, errors
# 4 - Debugging
# 4 - Debugging
#log_level=2
# File to log to instead of stdout
#log_file=/var/log/smradiusd.log
# Things to log in extreme detail
# modules - Log detailed module running information
# modules - Log detailed module running information
#
# There is no default for this configuration option. Options can be
# separated by commas. ie. modules
......@@ -65,9 +65,9 @@
#timeout=120
# cidr_allow/cidr_deny
# Comma, whitespace or semi-colon separated. Contains a CIDR block to
# compare the clients IP to. If cidr_allow or cidr_deny options are
# given, the incoming client must match a cidr_allow and not match a
# Comma, whitespace or semi-colon separated. Contains a CIDR block to
# compare the clients IP to. If cidr_allow or cidr_deny options are
# given, the incoming client must match a cidr_allow and not match a
# cidr_deny or the client connection will be closed.
#cidr_allow=0.0.0.0/0
#cidr_deny=
......@@ -76,16 +76,19 @@
# Defaults to "GMT"
event_timezone=GMT
# SMTP server to use when sending email
#smtp_server=127.0.0.1
[radius]
# Use packet timestamp, if unset, the default is to use the server
# timestamp at the moment the packet is received.
#
# WARNING!!!!
# Not all routers keep time, it may occur that some routers depend on
# getting date & time apon reboot from an ntp server. The problem
# will arise when the router cannot get the date and time before the
# first user logs in .. BAM, you'll have sessions with a period key
# Not all routers keep time, it may occur that some routers depend on
# getting date & time apon reboot from an ntp server. The problem
# will arise when the router cannot get the date and time before the
# first user logs in .. BAM, you'll have sessions with a period key
# in current month but an event timestamp in 1970.
#
# Defaults to "no"
......@@ -157,9 +160,10 @@ EOT
[features]
modules=<<EOT
mod_feature_capping
mod_feature_validity
mod_feature_fup
mod_feature_user_stats
mod_feature_update_user_stats_sql
mod_feature_validity
EOT
......@@ -255,6 +259,28 @@ get_topups_query=<<EOT
AND @TP@users.Username = ?
EOT
topups_add_query=<<EOT
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}
)
EOT
# MOD_ACCOUNTING_SQL
[mod_accounting_sql]
......@@ -306,26 +332,26 @@ accounting_start_query=<<EOT
%{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}
)
EOT
accounting_update_get_records_query=<<EOT
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
......@@ -344,13 +370,13 @@ accounting_update_query=<<EOT
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}
......@@ -413,7 +439,7 @@ EOT
# This is how long we going to cache the usage query for
# Default: 300 (seconds)
#
# You can use "no", "0", "false" to disable, specify a number > 1, or use
# You can use "no", "0", "false" to disable, specify a number > 1, or use
# "yes", "1", "true" to enable with the default value
accounting_usage_cache_time=300
......@@ -436,7 +462,7 @@ userdb_get_group_attributes_query=<<EOT
FROM
@TP@group_attributes, @TP@users_to_groups
WHERE
users_to_groups.UserID = %{userdb.ID}
users_to_groups.UserID = %{user.ID}
AND group_attributes.GroupID = users_to_groups.GroupID
AND group_attributes.Disabled = 0
EOT
......@@ -447,7 +473,7 @@ userdb_get_user_attributes_query=<<EOT
FROM
@TP@user_attributes
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Disabled = 0
EOT
......@@ -456,7 +482,7 @@ users_data_set_query=<<EOT
@TP@users_data (UserID, LastUpdated, Name, Value)
VALUES
(
%{userdb.ID},
%{user.ID},
%{query.LastUpdated},
%{query.Name},
%{query.Value}
......@@ -470,7 +496,7 @@ users_data_update_query=<<EOT
LastUpdated = %{query.LastUpdated},
Value = %{query.Value}
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
EOT
......@@ -480,7 +506,7 @@ users_data_get_query=<<EOT
FROM
@TP@users_data
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
EOT
......@@ -488,7 +514,7 @@ users_data_delete_query=<<EOT
DELETE FROM
@TP@users_data
WHERE
UserID = %{userdb.ID}
UserID = %{user.ID}
AND Name = %{query.Name}
EOT
......@@ -510,7 +536,8 @@ update_user_stats_query=<<EOT
PeriodKey = %{query.PeriodKey},
TotalTraffic = %{query.TotalTraffic},
TotalUptime = %{query.TotalUptime},
NASIdentifier = %{request.NAS-Identifier}
NASIdentifier = %{request.NAS-Identifier},
LastAcctUpdate = now()
WHERE
Username = %{user.Username}
EOT
......@@ -518,6 +545,10 @@ EOT
# MOD_FEATURE_CAPPING
[mod_feature_capping]
# Enable Mikrotik-specific return vattributes
#enable_mikrotik=1
# Enable caveat for SMRadius-Capping-Traffic-Limit having the meaning of 0 and -undef- swapped up to v1.0.x
#caveat_captrafzero=1
# Test harness for module loading
# Copyright (C) 2014-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.
use Test::More;
use strict;
use warnings;
require_ok("smradius::daemon");
require_ok("smradius::client");
done_testing();
use strict;
use warnings;
use AWITPT::Util;
use Data::Dumper;
use Date::Parse;
use POSIX qw(:sys_wait_h);
use Test::Most;
use Test::Most::Exception 'throw_failure';
#
# Check that database tests are enabled
#
# We need DBTESTS enabled to run this
if (!$ENV{'DBTESTS'}) {
plan skip_all => 'DBTESTS not set in ENV';
done_testing();
exit 0;
}
#
# Load database handling libraries
#
require_ok('AWITPT::DB::DBILayer');
require_ok('AWITPT::DB::DBLayer');
use AWITPT::DB::DBLayer;
#
# Load our server and client
#
require_ok("smradius::daemon");
require_ok("smradius::client");
#
# Daemon help
#
can_ok("smradius::daemon","displayHelp");
#
# Try connect to database
#
my $dbh = AWITPT::DB::DBILayer->new({
'Username' => 'root',
'DSN' => 'DBI:mysql:database=smradiustest;host=localhost',
});
# If we cannot connect, just bail out
if ($dbh->connect()) {
BAIL_OUT("ERROR: Failed to connect to database for testing purposes: ".$dbh->error());
}
AWITPT::DB::DBLayer::setHandle($dbh);
#
# Make sure DB is clean
#
my $sth;
$sth = DBDo("DELETE FROM topups");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'topups");
$sth = DBDo("DELETE FROM accounting");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'accounting");
$sth = DBDo("DELETE FROM user_attributes");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'user_attributes");
$sth = DBDo("DELETE FROM client_attributes");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'client_attributes");
$sth = DBDo("DELETE FROM users");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'users'");
$sth = DBDo("DELETE FROM clients_to_realms");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'clients_to_realms'");
$sth = DBDo("DELETE FROM clients");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'clients'");
$sth = DBDo("DELETE FROM realms");
is(AWITPT::DB::DBLayer::error(),"","Clean table 'realms'");
#
# Run server and client
#
our $child;
if ($child = fork()) {
# CHLD handler
local $SIG{CHLD} = sub {
warn "SIGCHLD TRIGGER";
waitpid($child,-1);
};
# Install signal handlers to cleanup if we get a TERM or INT
local $SIG{TERM} = local $SIG{INT} = \&cleanup;
# Wait before starting
sleep(2);
# Setup failure handler
set_failure_handler( sub { my @params = @_; cleanup(); throw_failure } );
my $res;
#
# Make sure basic test without any config does not authenticate users
#
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser1',
'User-Password=test123',
);
is(ref($res),"","smradclient ref should return ''");
is($res,1,"smradclient result should be 1");
#
# Create test case data
#
my $client1_ID = testDBInsert("Create client 'localhost'",
"INSERT INTO clients (Name,AccessList,Disabled) VALUES ('localhost','127.0.0.0/8',0)"
);
my $client1attr1_ID = testDBInsert("Create client 'localhost' secret",
"INSERT INTO client_attributes (ClientID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$client1_ID,'SMRadius-Config-Secret',':=','secret123'
);
# Blank realm
my $realm1_ID = testDBInsert("Create realm ''",
"INSERT INTO realms (Name,Disabled) VALUES ('',0)"
);
my $clientTOrealm1_ID = testDBInsert("Link client 'localhost' to realm ''",
"INSERT INTO clients_to_realms (ClientID,RealmID,Disabled) VALUES (?,?,0)",$client1_ID,$realm1_ID
);
#
# Check we get an Access-Accept for a bare user using a blank realm
#
my $user1_ID = testDBInsert("Create user 'testuser1'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser1',0)"
);
my $user1attr1_ID = testDBInsert("Create user 'testuser1' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user1_ID,'User-Password','==','test123'
);
my $user1attr2_ID = testDBInsert("Create user 'testuser1' attribute 'Framed-IP-Address'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user1_ID,'Framed-IP-Address',':=','10.0.0.1'
);
my $user1attr3_ID = testDBInsert("Create user 'testuser1' vendor attribute '[14988:Mikrotik-Rate-Limit]'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user1_ID,'[14988:Mikrotik-Rate-Limit]',':=','1024k/512k'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser1',
'User-Password=test123',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Accept","Check our return is 'Access-Accept' for bare user blank '' realm");
# Test the normal attribute and vendor attribute
is($res->{'response'}->{'attributes'}->{'Framed-IP-Address'},"10.0.0.1","Check that attribute 'Framed-IP-Address' is".
" returned");
is($res->{'response'}->{'vattributes'}->{'14988'}->{'Mikrotik-Rate-Limit'}->[0],"1024k/512k","Check that the vendor attribute".
"'14988:Mikrotik-Rate-Limit' is returned");
# Add filter attributes
my $user1attr4_ID = testDBInsert("Create user 'testuser1' filter attribute for 'Framed-IP-Address'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user1_ID,'SMRadius-Config-Filter-Reply-Attribute',':=','Framed-IP-Address'
);
my $user1attr5_ID = testDBInsert("Create user 'testuser1' filter vattribute for 'Mikrotik-Rate-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user1_ID,'SMRadius-Config-Filter-Reply-VAttribute',':=','Mikrotik-Rate-Limit'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser1',
'User-Password=test123',
);
is(ref($res),"HASH","smradclient should return a HASH");
# We shouldn't....
isnt($res->{'response'}->{'attributes'}->{'Framed-IP-Address'},"10.0.0.1","Check that attribute 'Framed-IP-Address' is".
" returned");
#
# Modify data for the default realm
#
testDBDelete("Delete blank realm '' link to client",
"DELETE FROM clients_to_realms WHERE ID = ?",$clientTOrealm1_ID
);
testDBDelete("Delete blank realm '' for realm '<DEFAULT>' test",
"DELETE FROM realms WHERE ID = ?",$realm1_ID
);
my $realm1b_ID = testDBInsert("Create default realm '<DEFAULT>'",
"INSERT INTO realms (Name,Disabled) VALUES ('<DEFAULT>',0)"
);
my $clientTOrealm1b_ID = testDBInsert("Link client 'localhost' to realm '<DEFAULT>'",
"INSERT INTO clients_to_realms (ClientID,RealmID,Disabled) VALUES (?,?,0)",$client1_ID,$realm1b_ID
);
#
# Check we get an Access-Accept for a bare user using the default realm
#
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser1',
'User-Password=test123',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Accept","Check our return is 'Access-Accept' for bare user on <DEFAULT> realm");
#
# Check we get a Access-Reject for a traffic topup user
#
my $user2_ID = testDBInsert("Create user 'testuser2'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser2',0)"
);
my $user2attr1_ID = testDBInsert("Create user 'testuser2' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user2_ID,'User-Password','==','test123'
);
my $user2attr2_ID = testDBInsert("Create user 'testuser2' attribute 'SMRadius-Capping-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user2_ID,'SMRadius-Capping-Traffic-Limit',':=','0'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser2',
'User-Password=test123',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Reject","Check our return is 'Access-Reject' for a traffic topup user");
#
# Check we get a Access-Reject for a uptime topup user
#
my $user2b_ID = testDBInsert("Create user 'testuser2b'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser2b',0)"
);
my $user2battr1_ID = testDBInsert("Create user 'testuser2b' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user2b_ID,'User-Password','==','test123'
);
my $user2battr3_ID = testDBInsert("Create user 'testuser2b' attribute 'SMRadius-Capping-Uptime-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user2b_ID,'SMRadius-Capping-Uptime-Limit',':=','0'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser2b',
'User-Password=test123',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Reject","Check our return is 'Access-Reject' for a uptime topup user");
#
# Test accounting START packet
#
my $session1_ID = "09d15244";
my $session1_Timestamp = time();
my $session1_Timestamp_str = DateTime->from_epoch(epoch => $session1_Timestamp,time_zone => 'UTC')
->strftime('%Y-%m-%d %H:%M:%S');
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"acct",
"secret123",
'NAS-IP-Address=10.0.0.3',
'Acct-Delay-Time=11',
'NAS-Identifier=Test-NAS1',
'Acct-Status-Type=Start',
'Event-Timestamp='.$session1_Timestamp,
'Framed-IP-Address=10.0.1.3',
'Acct-Session-Id='.$session1_ID,
'NAS-Port-Id=test iface name1',
'Called-Station-Id=testservice1',
'Calling-Station-Id=00:00:0C:EE:47:AA',
'User-Name=testuser1',
'NAS-Port-Type=Ethernet',
'NAS-Port=45355555',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
testDBResults("Check accounting record is created correctly",'accounting',{'AcctSessionID' => $session1_ID},
{
'NASIPAddress' => '10.0.0.3',
'AcctDelayTime' => '11',
'NASIdentifier' => 'Test-NAS1',
'AcctStatusType' => 1,
'EventTimestamp' => sub{ _timestampCheck(shift,$session1_Timestamp_str) },
'FramedIPAddress' => '10.0.1.3',
'AcctSessionId' => $session1_ID,
'NASPortId' => 'test iface name1',
'CalledStationId' => 'testservice1',
'CallingStationId' => '00:00:0C:EE:47:AA',
'Username' => 'testuser1',
'NASPortType' => 15,
'NASPort' => '45355555',
'FramedProtocol' => 1,
'ServiceType' => 2,
'AcctOutputPackets' => undef,
'AcctOutputGigawords' => undef,
'AcctOutputOctets' => undef,
'AcctInputPackets' => undef,
'AcctInputGigawords' => undef,
'AcctInputOctets' => undef,
'AcctSessionTime' => undef,
}
);
#
# Test accounting ALIVE packet
#
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"acct",
"secret123",
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=800000',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=810000000',
'Acct-Input-Packets=777777',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=123456789',
'Acct-Session-Time=999',
'User-Name=testuser1',
'Acct-Session-Id='.$session1_ID,
'NAS-IP-Address=10.0.0.3',
'NAS-Port=45355555',
);
is(ref($res),"HASH","smradclient should return a HASH");
testDBResults("Check accounting record is updated correctly",'accounting',{'AcctSessionID' => $session1_ID},
{
'NASIPAddress' => '10.0.0.3',
'AcctDelayTime' => '11',
'NASIdentifier' => 'Test-NAS1',
'AcctStatusType' => 3,
'EventTimestamp' => sub{ _timestampCheck(shift,$session1_Timestamp_str) },
'FramedIPAddress' => '10.0.1.3',
'AcctSessionId' => $session1_ID,
'NASPortId' => 'test iface name1',
'CalledStationId' => 'testservice1',
'CallingStationId' => '00:00:0C:EE:47:AA',
'Username' => 'testuser1',
'NASPortType' => 15,
'NASPort' => '45355555',
'FramedProtocol' => 1,
'ServiceType' => 2,
'AcctOutputPackets' => '800000',
'AcctOutputGigawords' => '0',
'AcctOutputOctets' => '810000000',
'AcctInputPackets' => '777777',
'AcctInputGigawords' => '0',
'AcctInputOctets' => '123456789',
'AcctSessionTime' => '999',
}
);
#
# Test accounting STOP packet
#
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"acct",
"secret123",
'Acct-Status-Type=Stop',
'Acct-Output-Packets=999999',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=888888888',
'Acct-Input-Packets=1111111',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=222222222',
'Acct-Session-Time=3998',
'Acct-Terminate-Cause=Session-Timeout',
'User-Name=testuser1',
'Acct-Session-Id='.$session1_ID,
'NAS-IP-Address=10.0.0.3',
'NAS-Port=45355555',
);
is(ref($res),"HASH","smradclient should return a HASH");
testDBResults("Check accounting record is stopped correctly",'accounting',{'AcctSessionID' => $session1_ID},
{
'NASIPAddress' => '10.0.0.3',
'AcctDelayTime' => '11',
'NASIdentifier' => 'Test-NAS1',
'AcctStatusType' => 2,
'EventTimestamp' => sub{ _timestampCheck(shift,$session1_Timestamp_str) },
'FramedIPAddress' => '10.0.1.3',
'AcctSessionId' => $session1_ID,
'NASPortId' => 'test iface name1',
'CalledStationId' => 'testservice1',
'CallingStationId' => '00:00:0C:EE:47:AA',
'Username' => 'testuser1',
'NASPortType' => 15,
'NASPort' => '45355555',
'FramedProtocol' => 1,
'ServiceType' => 2,
'AcctOutputPackets' => '999999',
'AcctOutputGigawords' => '0',
'AcctOutputOctets' => '888888888',
'AcctInputPackets' => '1111111',
'AcctInputGigawords' => '0',
'AcctInputOctets' => '222222222',
'AcctSessionTime' => '3998',
'AcctTerminateCause' => '5',
}
);
#
# Test missing accounting START packet
#
my $session2_ID = "817a0f1b";
my $session2_Timestamp = time();
my $session2_Timestamp_str = DateTime->from_epoch(epoch => $session2_Timestamp,time_zone => 'UTC')
->strftime('%Y-%m-%d %H:%M:%S');
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"acct",
"secret123",
'User-Name=testuser2',
'NAS-IP-Address=10.0.0.1',
'Acct-Delay-Time=12',
'NAS-Identifier=Test-NAS2',
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=786933',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=708163705',
'Acct-Input-Packets=670235',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=102600046',
'Acct-Session-Time=800',
'Event-Timestamp='.$session2_Timestamp,
'Framed-IP-Address=10.0.1.1',
'Acct-Session-Id='.$session2_ID,
'NAS-Port-Id=wlan1',
'Called-Station-Id=testservice2',
'Calling-Station-Id=00:00:0C:EE:47:BF',
'NAS-Port-Type=Ethernet',
'NAS-Port=15729175',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
testDBResults("Check missing accounting record is created correctly",'accounting',{'AcctSessionID' => $session2_ID},
{
'Username' => 'testuser2',
'NASIPAddress' => '10.0.0.1',
'AcctDelayTime' => '12',
'NASIdentifier' => 'Test-NAS2',
'AcctStatusType' => 3,
'AcctOutputPackets' => '786933',
'AcctOutputGigawords' => '0',
'AcctOutputOctets' => '708163705',
'AcctInputPackets' => '670235',
'AcctInputGigawords' => '0',
'AcctInputOctets' => '102600046',
'AcctSessionTime' => '800',
'EventTimestamp' => sub{ _timestampCheck(shift,$session2_Timestamp_str) },
'FramedIPAddress' => '10.0.1.1',
'AcctSessionId' => $session2_ID,
'NASPortId' => 'wlan1',
'CalledStationId' => 'testservice2',
'CallingStationId' => '00:00:0C:EE:47:BF',
'NASPortType' => 15,
'NASPort' => '15729175',
'FramedProtocol' => 1,
'ServiceType' => 2,
}
);
#
# Check we get a Access-Accept for a traffic autotopup user
#
my $topuptest1_amount = 100;
my $user3_ID = testDBInsert("Create user 'testuser3'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser3',0)"
);
my $user3attr1_ID = testDBInsert("Create user 'testuser3' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3_ID,'User-Password','==','test456'
);
my $user3attr2_ID = testDBInsert("Create user 'testuser3' attribute 'SMRadius-AutoTopup-Traffic-Enabled'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3_ID,'SMRadius-AutoTopup-Traffic-Enabled',':=','yes'
);
my $user3attr3_ID = testDBInsert("Create user 'testuser3' attribute 'SMRadius-AutoTopup-Traffic-Amount'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3_ID,'SMRadius-AutoTopup-Traffic-Amount',':=',$topuptest1_amount
);
my $user3attr4_ID = testDBInsert("Create user 'testuser3' attribute 'SMRadius-AutoTopup-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3_ID,'SMRadius-AutoTopup-Traffic-Limit',':=','500'
);
my $user3attr5_ID = testDBInsert("Create user 'testuser3' attribute 'SMRadius-Capping-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3_ID,'SMRadius-Capping-Traffic-Limit',':=','0'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser3',
'User-Password=test456',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Accept","Check our return is 'Access-Accept' for a traffic autotopup user");
# Get the time now
my $topuptest1_now = time();
my $topuptest1 = DateTime->from_epoch( 'epoch' => $topuptest1_now, 'time_zone' => 'UTC');
# Use truncate to set all values after 'month' to their default values
my $topuptest1_thisMonth = $topuptest1->clone()->truncate( to => "month" );
# This month, in string form
my $topuptest1_thisMonth_str = $topuptest1_thisMonth->strftime("%Y-%m-%d %H:%M:%S");
# Next month..
my $topuptest1_nextMonth = $topuptest1_thisMonth->clone()->add( months => 1 );
my $topuptest1_nextMonth_str = $topuptest1_nextMonth->strftime("%Y-%m-%d %H:%M:%S");
testDBResults("Check autotopup is added correctly",'topups',{'UserID' => $user3_ID},
{
'UserID' => $user3_ID,
'Timestamp' => sub { return _timestampCheck(shift,$topuptest1_now) },
'Type' => 5,
'ValidFrom' => $topuptest1_thisMonth_str,
'ValidTo' => $topuptest1_nextMonth_str,
'Value' => $topuptest1_amount,
'Depleted' => 0,
'SMAdminDepletedOn' => undef,
}
);
#
# Check we get a Access-Accept for a uptime autotopup user
#
my $topuptest1b_amount = 100;
my $user3b_ID = testDBInsert("Create user 'testuser3b'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser3b',0)"
);
my $user3battr1_ID = testDBInsert("Create user 'testuser3b' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3b_ID,'User-Password','==','test456'
);
my $user3battr2_ID = testDBInsert("Create user 'testuser3b' attribute 'SMRadius-AutoTopup-Uptime-Enabled'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3b_ID,'SMRadius-AutoTopup-Uptime-Enabled',':=','yes'
);
my $user3battr3_ID = testDBInsert("Create user 'testuser3b' attribute 'SMRadius-AutoTopup-Uptime-Amount'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3b_ID,'SMRadius-AutoTopup-Uptime-Amount',':=',$topuptest1b_amount
);
my $user3battr4_ID = testDBInsert("Create user 'testuser3b' attribute 'SMRadius-AutoTopup-Uptime-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3b_ID,'SMRadius-AutoTopup-Uptime-Limit',':=','500'
);
my $user3battr5_ID = testDBInsert("Create user 'testuser3b' attribute 'SMRadius-Capping-Uptime-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user3b_ID,'SMRadius-Capping-Uptime-Limit',':=','0'
);
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"auth",
"secret123",
'User-Name=testuser3b',
'User-Password=test456',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'response'}->{'code'},"Access-Accept","Check our return is 'Access-Accept' for a uptime autotopup user");
# Get the time now
my $topuptest1b_now = time();
my $topuptest1b = DateTime->from_epoch( 'epoch' => $topuptest1b_now, 'time_zone' => 'UTC');
# Use truncate to set all values after 'month' to their default values
my $topuptest1b_thisMonth = $topuptest1b->clone()->truncate( to => "month" );
# This month, in string form
my $topuptest1b_thisMonth_str = $topuptest1b_thisMonth->strftime("%Y-%m-%d %H:%M:%S");
# Next month..
my $topuptest1b_nextMonth = $topuptest1b_thisMonth->clone()->add( months => 1 );
my $topuptest1b_nextMonth_str = $topuptest1b_nextMonth->strftime("%Y-%m-%d %H:%M:%S");
testDBResults("Check autotopup is added correctly",'topups',{'UserID' => $user3b_ID},
{
'UserID' => $user3b_ID,
'Timestamp' => sub { return _timestampCheck(shift,$topuptest1b_now) },
'Type' => 6,
'ValidFrom' => $topuptest1b_thisMonth_str,
'ValidTo' => $topuptest1b_nextMonth_str,
'Value' => $topuptest1b_amount,
'Depleted' => 0,
'SMAdminDepletedOn' => undef,
}
);
#
# Check that if we send an accounting ALIVE we update the auto-topups
#
my $topuptest2_amount = 100;
my $user4_ID = testDBInsert("Create user 'testuser4'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser4',0)"
);
my $user4attr1_ID = testDBInsert("Create user 'testuser4' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'User-Password','==','test456'
);
my $user4attr2_ID = testDBInsert("Create user 'testuser4' attribute 'SMRadius-AutoTopup-Traffic-Enabled'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'SMRadius-AutoTopup-Traffic-Enabled',':=','yes'
);
my $user4attr3_ID = testDBInsert("Create user 'testuser4' attribute 'SMRadius-AutoTopup-Traffic-Amount'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'SMRadius-AutoTopup-Traffic-Amount',':=',$topuptest2_amount
);
my $user4attr4_ID = testDBInsert("Create user 'testuser4' attribute 'SMRadius-AutoTopup-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'SMRadius-AutoTopup-Traffic-Limit',':=','500'
);
my $user4attr5_ID = testDBInsert("Create user 'testuser4' attribute 'SMRadius-Capping-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'SMRadius-Capping-Traffic-Limit',':=','0'
);
my $user4attr6_ID = testDBInsert("Create user 'testuser4' attribute 'SMRadius-AutoTopup-Traffic-Notify'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user4_ID,'SMRadius-AutoTopup-Traffic-Notify',':=','root@localhost'
);
my $session3_ID = "9c5f24a";
my $session3_Timestamp = time();
$res = smradius::client->run(
"--raddb","dicts",
"127.0.0.1",
"acct",
"secret123",
'User-Name=testuser4',
'NAS-IP-Address=10.0.0.1',
'Acct-Delay-Time=12',
'NAS-Identifier=Test-NAS2',
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=786933',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=708163705',
'Acct-Input-Packets=670235',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=102600046',
'Acct-Session-Time=800',
'Event-Timestamp='.$session3_Timestamp,
'Framed-IP-Address=10.0.1.1',
'Acct-Session-Id='.$session3_ID,
'NAS-Port-Id=wlan1',
'Called-Station-Id=testservice2',
'Calling-Station-Id=00:00:0C:EE:47:BF',
'NAS-Port-Type=Ethernet',
'NAS-Port=15729175',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
# Get the time now
my $topuptest2_now = time();
my $topuptest2 = DateTime->from_epoch( 'epoch' => $topuptest2_now, 'time_zone' => 'UTC');
# Use truncate to set all values after 'month' to their default values
my $topuptest2_thisMonth = $topuptest2->clone()->truncate( to => "month" );
# This month, in string form
my $topuptest2_thisMonth_str = $topuptest2_thisMonth->strftime("%Y-%m-%d %H:%M:%S");
# Next month..
my $topuptest2_nextMonth = $topuptest2_thisMonth->clone()->add( months => 1 );
my $topuptest2_nextMonth_str = $topuptest2_nextMonth->strftime("%Y-%m-%d %H:%M:%S");
testDBResults("Check autotopup is added correctly after acct_log",'topups',{'UserID' => $user4_ID},
{
'UserID' => $user4_ID,
'Timestamp' => sub { return _timestampCheck(shift,$topuptest2_now) },
'Type' => 5,
'ValidFrom' => $topuptest2_thisMonth_str,
'ValidTo' => $topuptest2_nextMonth_str,
'Value' => $topuptest2_amount,
'Depleted' => 0,
'SMAdminDepletedOn' => undef,
}
);
#
# Check that if we send an accounting ALIVE we do not trigger FUP
#
my $user5_ID = testDBInsert("Create user 'testuser5'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser5',0)"
);
my $user5attr1_ID = testDBInsert("Create user 'testuser5' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user5_ID,'User-Password','==','test456'
);
my $user5attr2_ID = testDBInsert("Create user 'testuser5' attribute 'SMRadius-FUP-Period'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user5_ID,'SMRadius-FUP-Period',':=','1'
);
my $user5attr3_ID = testDBInsert("Create user 'testuser5' attribute 'SMRadius-FUP-Traffic-Threshold'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user5_ID,'SMRadius-FUP-Traffic-Threshold',':=',800
);
# Add an attribute so we can check the FUP match results
my $user5attr4_ID = testDBInsert("Create user 'testuser5' attribute 'SMRadius-Evaluate'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user5_ID,'SMRadius-Evaluate','||+=',"SMRadius_FUP > 0 ? [14988:Mikrotik-Rate-Limit] = 1638k/8m : [14988:Mikrotik-Rate-Limit] = 1k/1m"
);
my $session4_ID = "a8abc40";
my $session4_Timestamp = time();
$res = smradius::client->run(
"--raddb","dicts",
"--listen","127.0.0.1:1700",
"127.0.0.1",
"acct",
"secret123",
'User-Name=testuser5',
'NAS-IP-Address=10.0.0.1',
'Acct-Delay-Time=12',
'NAS-Identifier=Test-NAS2',
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=786933',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=708163705',
'Acct-Input-Packets=670235',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=102600046',
'Acct-Session-Time=800',
'Event-Timestamp='.$session4_Timestamp,
'Framed-IP-Address=10.0.1.1',
'Acct-Session-Id='.$session4_ID,
'NAS-Port-Id=wlan1',
'Called-Station-Id=testservice2',
'Calling-Station-Id=00:00:0C:EE:47:BF',
'NAS-Port-Type=Ethernet',
'NAS-Port=15729175',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'listen'}->{'response'}->{'code'},"CoA-Request","Check that the packet we got back is infact a ".
"CoA-Request");
is($res->{'listen'}->{'response'}->{'vattributes'}->{'14988'}->{'Mikrotik-Rate-Limit'}->[0],"1k/1m","Check that the vendor attribute".
"'14988:Mikrotik-Rate-Limit' is returned on the negative side of the IF");
testDBResults("Check FUP state was added to the user stats table as 0",'users_data',
{'UserID' => $user5_ID, 'Name' => "mod_feature_fup/State"},
{'Value' => "0"},
1, # Disable order
);
#
# Check that if we send an accounting ALIVE with a usage amount that exceeds FUP, that we trigger it
#
my $user6_ID = testDBInsert("Create user 'testuser6'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser6',0)"
);
my $user6attr1_ID = testDBInsert("Create user 'testuser6' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user6_ID,'User-Password','==','test456'
);
my $user6attr2_ID = testDBInsert("Create user 'testuser6' attribute 'SMRadius-FUP-Period'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user6_ID,'SMRadius-FUP-Period',':=','1'
);
my $user6attr3_ID = testDBInsert("Create user 'testuser6' attribute 'SMRadius-FUP-Traffic-Threshold'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user6_ID,'SMRadius-FUP-Traffic-Threshold',':=',800
);
# Add an attribute so we can check the FUP match results
my $user6attr4_ID = testDBInsert("Create user 'testuser6' attribute 'SMRadius-Evaluate'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user6_ID,'SMRadius-Evaluate','||+=',"SMRadius_FUP > 0 ? [14988:Mikrotik-Rate-Limit] = 1638k/8m : [14988:Mikrotik-Rate-Limit] = 1k/1m"
);
my $session5_ID = "582dc00";
my $session5_Timestamp = time();
$res = smradius::client->run(
"--raddb","dicts",
"--listen","127.0.0.1:1700",
"127.0.0.1",
"acct",
"secret123",
'User-Name=testuser6',
'NAS-IP-Address=10.0.0.1',
'Acct-Delay-Time=12',
'NAS-Identifier=Test-NAS2',
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=786933',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=808163705',
'Acct-Input-Packets=670235',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=202600046',
'Acct-Session-Time=800',
'Event-Timestamp='.$session5_Timestamp,
'Framed-IP-Address=10.0.1.1',
'Acct-Session-Id='.$session5_ID,
'NAS-Port-Id=wlan1',
'Called-Station-Id=testservice2',
'Calling-Station-Id=00:00:0C:EE:47:BF',
'NAS-Port-Type=Ethernet',
'NAS-Port=15729175',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'listen'}->{'response'}->{'code'},"CoA-Request","Check that the packet we got back is infact a ".
"CoA-Request");
is($res->{'listen'}->{'response'}->{'vattributes'}->{'14988'}->{'Mikrotik-Rate-Limit'}->[0],"1638k/8m","Check that the ".
"vendor attribute '14988:Mikrotik-Rate-Limit' is returned on the success side of the FUP check");
testDBResults("Check FUP state was added to the user stats table as 1",'users_data',
{'UserID' => $user6_ID, 'Name' => "mod_feature_fup/State"},
{'Value' => "1"},
1, # Disable order
);
#
# Check that if we send an accounting ALIVE with a usage amount that exceeds capping, that we trigger a POD
#
my $user7_ID = testDBInsert("Create user 'testuser7'",
"INSERT INTO users (UserName,Disabled) VALUES ('testuser7',0)"
);
my $user7attr1_ID = testDBInsert("Create user 'testuser7' attribute 'User-Password'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user7_ID,'User-Password','==','test456'
);
# Add an attribute so we can check the capping does a POD
my $user7attr4_ID = testDBInsert("Create user 'testuser7' attribute 'SMRadius-Capping-Traffic-Limit'",
"INSERT INTO user_attributes (UserID,Name,Operator,Value,Disabled) VALUES (?,?,?,?,0)",
$user7_ID,'SMRadius-Capping-Traffic-Limit',':=','1'
);
my $session6_ID = "5209dac0";
my $session6_Timestamp = time();
$res = smradius::client->run(
"--raddb","dicts",
"--listen","127.0.0.1:1700",
"127.0.0.1",
"acct",
"secret123",
'User-Name=testuser7',
'NAS-IP-Address=10.0.0.1',
'Acct-Delay-Time=12',
'NAS-Identifier=Test-NAS2',
'Acct-Status-Type=Interim-Update',
'Acct-Output-Packets=786933',
'Acct-Output-Gigawords=0',
'Acct-Output-Octets=808163705',
'Acct-Input-Packets=670235',
'Acct-Input-Gigawords=0',
'Acct-Input-Octets=202600046',
'Acct-Session-Time=800',
'Event-Timestamp='.$session6_Timestamp,
'Framed-IP-Address=10.0.1.1',
'Acct-Session-Id='.$session6_ID,
'NAS-Port-Id=wlan1',
'Called-Station-Id=testservice2',
'Calling-Station-Id=00:00:0C:EE:47:BF',
'NAS-Port-Type=Ethernet',
'NAS-Port=15729175',
'Framed-Protocol=PPP',
'Service-Type=Framed-User',
);
is(ref($res),"HASH","smradclient should return a HASH");
is($res->{'listen'}->{'response'}->{'code'},"Disconnect-Request","Check that the packet we got back is infact a ".
"Disconnect-Request");
sleep(5);
} else {
smradius::daemon->run(
"--fg",
"--debug",
"--config", "smradiusd.conf.test",
);
sleep 4;
exit 0;
}
cleanup();
done_testing();
# Cleanup function
sub cleanup
{
if ($child) {
# Kill the child if it exists
if (kill(0,$child)) {
kill('TERM',$child);
}
# Wait for it to be reaped
waitpid($child,-1);
}
}
# Function to quickly and easily insert data into the DB and generate 2 tests out of it
sub testDBInsert
{
my ($name,@params) = @_;
# Do the work...
DBDo(@params);
# Make sure we got no error
is(AWITPT::DB::DBLayer::error(),"",$name);
# Grab the last insert ID
my $id = DBLastInsertID();
# Make sure its > 0
is($id > 0,1,"$name, insert ID > 0");
return $id;
}
# Function to quickly and easily delete data from the DB
sub testDBDelete
{
my ($name,@params) = @_;
# Do the work...
DBDo(@params);
# Make sure we got no error
is(AWITPT::DB::DBLayer::error(),"",$name);
return 1;
}
# Test DB select results
sub testDBResults
{
my ($name,$table,$where,$resultCheck,$disableOrder) = @_;
# Build column list
my $columnList_str = join(',',keys %{$resultCheck});
# Create where criteria
my @whereLines = ();
my @whereData = ();
foreach my $columnName (keys %{$where}) {
# Add template placeholders
push(@whereLines,"$columnName = ?");
# Add data for template placeholders
push(@whereData,$where->{$columnName});
}
my $whereLines_str = join(' AND ',@whereLines);
# Check if we're not disabling ordering
my $extraSQL = "";
if (!defined($disableOrder)) {
$extraSQL = "ORDER BY ID DESC";
}
my $sqlQuery = "
SELECT
$columnList_str
FROM
$table
WHERE
$whereLines_str
$extraSQL
";
# Do select
my $sth = DBSelect($sqlQuery,@whereData);
# Make sure we got no error
is(AWITPT::DB::DBLayer::error(),"","Errors on DBSelect ($sqlQuery interpolated with ".join(', ',$extraSQL).": $name");
# We should get one result...
my $row = hashifyLCtoMC($sth->fetchrow_hashref(),keys %{$resultCheck});
is(defined($row),1,"DBSelect row defined: $name");
# Loop through results and check if they match
foreach my $resultName (keys %{$resultCheck}) {
# Check if the result is a code-based subroutine
if (ref(my $result = $resultCheck->{$resultName}) eq "CODE") {
is($resultCheck->{$resultName}($row->{$resultName}),1,"$name: $resultName sub{} check");
} else {
is($row->{$resultName},$resultCheck->{$resultName},"$name: $resultName check");
}
}
}
sub _timestampCheck
{
my ($testVal,$rightVal) = @_;
# Make sure testVal is defined
return "_timestampCheck: NO \$testVal" if (!defined($testVal));
# Make sure $testVal_time is returned form str2time
my $testVal_time = str2time($testVal,'UTC');
# Check if $rightVal is defined
my $rightVal_time;
if (!defined($rightVal)) {
$rightVal_time = time();
} elsif ($rightVal =~ /^\d+$/) {
$rightVal_time = $rightVal;
} else {
$rightVal_time = str2time($rightVal,'UTC');
}
# Make sure rightVal_time is defined
return "_timestampCheck: NO \$rightVal_time" if (!defined($rightVal_time));
# Grab the absolute difference
my $diff = abs($testVal_time - $rightVal_time);
return ($diff < 10) // "TIME DEVIATION: $diff";
}
......@@ -2,8 +2,8 @@
git submodule update --recursive --init
pushd awitpt
git checkout v0.0.x
pushd 3rdparty/awitpt
git checkout v1.0.x
git pull
popd
......