Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
smradius
smradius
Commits
035c70fa
Commit
035c70fa
authored
May 15, 2019
by
Nigel Kukard
Browse files
FEATURE: CoA
parent
c615c7ea
Changes
2
Hide whitespace changes
Inline
Side-by-side
lib/smradius/daemon.pm
View file @
035c70fa
...
...
@@ -898,128 +898,145 @@ sub process_request {
foreach
my
$attrOp
(
keys
%
{
$user
->
{'
Attributes
'}
->
{
$attrName
}})
{
# Grab attribute
my
$attr
=
$user
->
{'
Attributes
'}
->
{
$attrName
}
->
{
$attrOp
};
# Check attribute against accounting attributes
attributes
# Check attribute against accounting attributes
my
$res
=
checkAcctAttribute
(
$self
,
$user
,
$acctAttributes
,
$attr
);
# We don't care if it fails
}
}
# TEST START
my
$coaReq
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'});
# Process the reply attributes
$self
->
_processReplyAttributes
(
$request
,
$user
,
$coaReq
);
# TEST END
# The coaReq may be either POD or CoA
my
$coaReq
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'});
# Set packet identifier
$coaReq
->
set_identifier
(
$$
&
0xff
);
# Check if we must POD the user
# 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
);
}
my
$resp
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'});
# 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
'));
$resp
->
set_code
('
Disconnect-Request
');
my
$id
=
$$
&
0xff
;
$resp
->
set_identifier
(
$id
);
$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
'));
# Add onto logline
$request
->
addLogLine
("
. REPLY =>
");
foreach
my
$attrName
(
$resp
->
attributes
)
{
$request
->
addLogLine
(
"
%s: '%s'
",
$attrName
,
$resp
->
rawattr
(
$attrName
)
);
# Add onto logline
$request
->
addLogLine
("
. REPLY =>
");
foreach
my
$attrName
(
$coaReq
->
attributes
)
{
$request
->
addLogLine
(
"
%s: '%s'
",
$attrName
,
$coaReq
->
rawattr
(
$attrName
)
);
}
# 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 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 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
;
}
# Grab packet
my
$response
=
auth_resp
(
$resp
->
pack
,
getAttributeValue
(
$user
->
{'
ConfigAttributes
'},"
SMRadius-Config-Secret
"));
# 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
;
}
my
$coaServer
;
# 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
;
}
# Check for old POD server attribute
if
(
defined
(
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-PODServer
'}))
{
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] SMRadius-Config-PODServer is defined
");
$coaServer
=
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-PODServer
'};
if
(
!
$select
->
can_read
(
$coaServerTimeout
))
{
$self
->
log
(
LOG_ERR
,"
[SMRADIUS] POST-ACCT: Failed to receive data on socket: $!
");
next
;
}
# Check for new CoA server attribute
if
(
defined
(
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-CoAServer
'}))
{
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] SMRadius-Config-CoAServer is defined
");
$coaServer
=
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-CoAServer
'};
# 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
': $!
");
$logReason
=
"
No Response
";
next
;
}
# Check for CoA servers
if
(
defined
(
$coaServer
))
{
# Check address format
foreach
my
$coaServerAttribute
(
@
{
$coaServer
})
{
# Check for valid IP
if
(
$coaServerAttribute
=~
/^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/
)
{
my
$coaServer
=
$
1
;
# If we have a port, use it, otherwise use default 1700
my
$coaServerPort
;
if
(
$coaServerAttribute
=~
/:([0-9]+)$/
)
{
$coaServerPort
=
$
1
;
}
else
{
$coaServerPort
=
1700
;
}
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '
"
.
$coaServer
.
"
' Port: '
"
.
$coaServerPort
.
"
'
");
# Create socket to send packet out on
my
$coaServerTimeout
=
"
10
";
# 10 second timeout
my
$coaSock
=
IO::Socket::
INET
->
new
(
PeerAddr
=>
$coaServer
,
PeerPort
=>
$coaServerPort
,
Type
=>
SOCK_DGRAM
,
Proto
=>
'
udp
',
TimeOut
=>
$coaServerTimeout
,
);
if
(
!
$coaSock
)
{
$self
->
log
(
LOG_ERR
,"
[SMRADIUS] POST-ACCT: Failed to create socket to send POD on
");
next
;
}
# Check if we sent the packet...
if
(
!
$coaSock
->
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
(
$coaSock
);
if
(
!
$sh
)
{
$self
->
log
(
LOG_ERR
,"
[SMRADIUS] POST-ACCT: Failed to select data on socket
");
next
;
}
if
(
!
$sh
->
can_read
(
$coaServerTimeout
))
{
$self
->
log
(
LOG_ERR
,"
[SMRADIUS] POST-ACCT: Failed to receive data on socket
");
next
;
}
my
$data
;
$coaSock
->
recv
(
$data
,
65536
);
if
(
!
$data
)
{
$self
->
log
(
LOG_ERR
,"
[SMRADIUS] POST-ACCT: Receive data failed
");
$logReason
=
"
CoA 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 CoA Server value: '
"
.
$coaServerAttribute
.
"
'
");
}
}
# Parse the radius packet
my
$coaRes
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'},
$coaRes_packet
);
# Check status
if
(
$coaRes
->
code
eq
"
CoA-ACK
")
{
$logReason
=
"
CoA Success
";
last
;
}
elsif
(
$coaRes
->
code
eq
"
CoA-NACK
")
{
$logReason
=
"
CoA Fail
";
}
elsif
(
$coaRes
->
code
eq
"
Disconnect-ACK
")
{
$logReason
=
"
POD Success
";
last
;
}
elsif
(
$coaRes
->
code
eq
"
Disconnect-NACK
")
{
$logReason
=
"
POD Fail
";
}
else
{
$
self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] SMRadius-Config-CoAServer is not defined
")
;
$
logReason
=
"
CoA/POD Fail
"
;
}
}
...
...
t/200-dbtests.t
View file @
035c70fa
...
...
@@ -835,7 +835,7 @@ if ($child = fork()) {
# 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
"
$user5_ID
,'
SMRadius-Evaluate
','
||+=
',"
SMRadius_FUP > 0 ? [14988:Mikrotik-Rate-Limit] = 1638k/8m
: [14988:Mikrotik-Rate-Limit] = 1k/1m
"
);
my
$session4_ID
=
"
a8abc40
";
...
...
@@ -871,7 +871,8 @@ if ($child = fork()) {
'
Service-Type=Framed-User
',
);
is
(
ref
(
$res
),"
HASH
","
smradclient should return a HASH
");
is
(
$res
->
{'
response
'}
->
{'
vattributes
'},
undef
,"
Check that the vendor attributes are not defined
");
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
");
#
...
...
@@ -900,7 +901,7 @@ if ($child = fork()) {
# 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
"
$user6_ID
,'
SMRadius-Evaluate
','
||+=
',"
SMRadius_FUP > 0 ? [14988:Mikrotik-Rate-Limit] = 1638k/8m
: [14988:Mikrotik-Rate-Limit] = 1k/1m
"
);
my
$session5_ID
=
"
582dc00
";
...
...
@@ -936,7 +937,7 @@ if ($child = fork()) {
'
Service-Type=Framed-User
',
);
is
(
ref
(
$res
),"
HASH
","
smradclient should return a HASH
");
is
(
$res
->
{'
response
'}
->
{'
vattributes
'}
->
{'
14988
'}
->
{'
Mikrotik-Rate-Limit
'}
->
[
0
],"
1638k/8m
","
Check that the vendor attribute
"
.
is
(
$res
->
{'
listen
'}
->
{'
response
'}
->
{'
vattributes
'}
->
{'
14988
'}
->
{'
Mikrotik-Rate-Limit
'}
->
[
0
],"
1638k/8m
","
Check that the vendor attribute
"
.
"
'14988:Mikrotik-Rate-Limit' is returned
");
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment