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
97a9c1cc
Commit
97a9c1cc
authored
May 18, 2019
by
Nigel Kukard
Browse files
Merge branch 'FUP' into 'master'
FUP updates See merge request
!427
parents
d82d2454
90dfd988
Pipeline
#3775
passed with stages
in 4 minutes and 3 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
lib/smradius/attributes.pm
View file @
97a9c1cc
...
...
@@ -843,16 +843,16 @@ sub processConditional
$res
=
1
;
}
# Sanitize the output
$attribStr
=~
s/^\s*//
;
$attribStr
=~
s/\s*$//
;
$server
->
log
(
LOG_DEBUG
,"
[ATTRIBUTES] - Evaluated to '
$res
' returning '
"
.
(
defined
(
$attribStr
)
?
$attribStr
:
"
-undef-
")
.
"
'
");
# Loop with attributes:
# We only get here if $res is set to 1 above, if its only a conditional with no onTrue & onFalse
# Then attribStr will be unef
if
(
$res
&&
defined
(
$attribStr
))
{
# Sanitize the output
$attribStr
=~
s/^\s*//
;
$attribStr
=~
s/\s*$//
;
foreach
my
$rawAttr
(
split
(
/;/
,
$attribStr
))
{
# Split off attribute string: name = value
my
(
$attrName
,
$attrVal
)
=
(
$rawAttr
=~
/^\s*([^=]+)=\s*(.*)/
);
...
...
lib/smradius/daemon.pm
View file @
97a9c1cc
...
...
@@ -622,7 +622,7 @@ sub process_request {
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
'});
...
...
@@ -635,7 +635,7 @@ sub process_request {
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
'});
...
...
@@ -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
"
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
}
}
}
# 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
': $!
");
$logReason
=
"
No Response
";
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
")
{
$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
{
$logReason
=
"
CoA/POD Fail
";
# 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
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