Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
smradius
smradius
Commits
f31f17a4
Commit
f31f17a4
authored
May 17, 2019
by
Nigel Kukard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Only send CoA/POD for accounting updates
parent
1d36c549
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
132 additions
and
128 deletions
+132
-128
lib/smradius/daemon.pm
lib/smradius/daemon.pm
+132
-128
No files found.
lib/smradius/daemon.pm
View file @
f31f17a4
...
...
@@ -887,156 +887,160 @@ sub process_request {
auth_resp
(
$resp
->
pack
,
getAttributeValue
(
$user
->
{'
ConfigAttributes
'},"
SMRadius-Config-Secret
"))
);
# 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
# CoA and POD only apply to accounting updates...
if
(
$pkt
->
rawattr
('
Acct-Status-Type
')
eq
"
2
")
{
# 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
}
}
}
# The coaReq may be either POD or CoA
my
$coaReq
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'});
# The coaReq may be either POD or CoA
my
$coaReq
=
smradius::Radius::
Packet
->
new
(
$self
->
{'
radius
'}
->
{'
dictionary
'});
# Set packet identifier
$coaReq
->
set_identifier
(
$$
&
0xff
);
# Set packet identifier
$coaReq
->
set_identifier
(
$$
&
0xff
);
# 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
);
}
# 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
);
}
# 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
'));
# 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
(
$coaReq
->
attributes
)
{
$request
->
addLogLine
(
"
%s: '%s'
",
$attrName
,
$coaReq
->
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
"));
#
Generate coaReq packe
t
my
$
coa
Req_packet
=
auth_resp
(
$coaReq
->
pack
,
getAttributeValue
(
$user
->
{'
ConfigAttributes
'},"
SMRadius-Config-Secret
"))
;
#
Array CoA servers to contac
t
my
@
coa
Servers
;
# 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
old POD
server attribute
if
(
defined
(
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-
POD
Server
'}))
{
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] SMRadius-Config-
POD
Server is defined
");
@coaServers
=
@
{
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-
POD
Server
'}};
}
# Check for
new CoA
server attribute
if
(
defined
(
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-
CoA
Server
'}))
{
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] SMRadius-Config-
CoA
Server is defined
");
@coaServers
=
@
{
$user
->
{'
ConfigAttributes
'}
->
{'
SMRadius-Config-
CoA
Server
'}};
}
# 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
'});
}
# 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]+))?/
);
# 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
;
}
if
(
!
defined
(
$coaServerIP
))
{
$self
->
log
(
LOG_NOTICE
,"
[SMRADIUS] POST-ACCT: CoAServer '
$coaServer
' looks incorrect
");
next
;
}
# Set default CoA server port
$coaServerPort
//
=
1700
;
# Set default CoA server port
$coaServerPort
//
=
1700
;
$self
->
log
(
LOG_DEBUG
,"
[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '
"
.
$coaServer
.
"
' Port: '
"
.
$coaServerPort
.
"
'
");
$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
,
);
# 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
;
}
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
;
}
# 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
;
}
# 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
;
}
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
;
}
# 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
);
# 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
");
# 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
");
}
}
}
...
...
Write
Preview
Markdown
is supported
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