#!@PERL@
#
# checkrad.pl See if a user is (still) logged in on a certain port.
#
# This is used by the FreeRADIUS server to check
# if its idea of a user logged in on a certain port/nas
# is correct if a double login is detected.
#
# Called as: nas_type nas_ip nas_port login session_id
#
# Returns: 0 = no duplicate, 1 = duplicate, >1 = error.
#
# Version: $Id$
#
# livingston_snmp 1.2 Author: miquels@cistron.nl
# cvx_snmp 1.0 Author: miquels@cistron.nl
# portslave_finger 1.0 Author: miquels@cistron.nl
# max40xx_finger 1.0 Author: costa@mdi.ca
# ascend_snmp 1.1 Author: blaz@amis.net
# computone_finger 1.2 Author: pacman@world.std.com
# sub tc_tccheck 1.1 Author: alexisv@compass.com.ph
# cyclades_telnet 1.2 Author: accdias@sst.com.br
# patton_snmp 1.0 Author: accdias@sst.com.br
# digitro_rusers 1.1 Author: accdias@sst.com.br
# cyclades_snmp 1.0 Author: accdias@sst.com.br
# usrhiper_snmp 1.0 Author: igor@ipass.net
# multitech_snmp 1.0 Author: ehonzay@willmar.com
# netserver_telnet 1.0 Author: mts@interplanet.es
# versanet_snmp 1.0 Author: support@versanetcomm.com
# bay_finger 1.0 Author: chris@shenton.org
# cisco_l2tp 1.14 Author: paul@distributel.net
# mikrotik_telnet 1.1 Author: Evren Yurtesen <yurtesen@ispro.net.tr>
# mikrotik_snmp 1.0 Author: Evren Yurtesen <yurtesen@ispro.net.tr>
# redback_telnet Author: Eduardo Roldan
#
# Config: $debug is the file you want to put debug messages in
# $snmpget is the location of your ``snmpget'' program
# $snmpwalk is the location of your ``snmpwalk'' program
# $snmp_timeout is the timeout for snmp queries
# $snmp_retries is the number of retries for timed out snmp queries
# $snmp_version is the version of to use for snmp queries [1,2c,3]
# $rusers is the location of your ``rusers'' program
# $naspass is the location of your NAS admin password file
#
$prefix = "@prefix@";
$localstatedir = "@localstatedir@";
$logdir = "@logdir@";
$sysconfdir = "@sysconfdir@";
$raddbdir = "@raddbdir@";
$debug = "";
#$debug = "$logdir/checkrad.log";
$snmpget = "@SNMPGET@";
$snmpwalk = "@SNMPWALK@";
$snmp_timeout = 5;
$snmp_retries = 1;
$snmp_version = "2c";
$rusers = "@RUSERS@";
$naspass = "$raddbdir/naspasswd";
# Community string. Change this if yours isn't "public".
$cmmty_string = "public";
# path to finger command
$finger = "/usr/bin/finger";
# Extremely slow way of converting port descriptions to actual indexes
$portisdescr = 0;
# Realm used by Cisco sub
$realm = '';
#
# USR-Hiper: $hiper_density is the reported port density (default 256
# but 24 makes more sense)
#
$hiper_density = 256;
#
# Try to load Net::Telnet, SNMP_Session etc.
# Do not complain if we cannot find it.
# Prefer a locally installed copy.
#
BEGIN {
unshift @INC, "/usr/local/lib/site_perl";
eval "use Net::Telnet 3.00;";
$::HAVE_NET_TELNET = ($@ eq "");
eval "use SNMP_Session;";
if ($@ eq "") {
eval "use BER;";
$::HAVE_SNMP_SESSION = ($@ eq "");
eval "use Socket;";
}
};
#
# Get password from /etc/raddb/naspasswd file.
# Returns (login, password).
#
sub naspasswd {
my ($terminalserver, $emptyok) = @_;
my ($login, $password);
my ($ts, $log, $pass);
unless (open(NFD, $naspass)) {
if (!$emptyok) {
print LOG "checkrad: naspasswd file not found; " .
"possible match for $ARGV[3]\n" if ($debug);
print STDERR "checkrad: naspasswd file not found; " .
"possible match for $ARGV[3]\n";
}
return ();
}
while (<NFD>) {
chop;
next if (m/^(#|$|[\t ]+$)/);
($ts, $log, $pass) = split(/\s+/, $_, 3);
if ($ts eq $terminalserver) {
$login = $log;
$password = $pass;
last;
}
}
close NFD;
if ($password eq "" && !$emptyok) {
print LOG "checkrad: password for $ARGV[1] is null; " .
"possible match for $ARGV[3] on " .
"port $ARGV[2]\n" if ($debug);
print STDERR "checkrad: password for $ARGV[1] is null; " .
"possible match for $ARGV[3] on port $ARGV[2]\n";
}
($login, $password);
}
#
# See if Net::Telnet is there.
#
sub check_net_telnet {
if (!$::HAVE_NET_TELNET) {
print LOG
" checkrad: Net::Telnet 3.00+ CPAN module not installed\n"
if ($debug);
print STDERR
"checkrad: Net::Telnet 3.00+ CPAN module not installed\n";
return 0;
}
1;
}
#
# Do snmpwalk by calling snmpwalk.
#
sub snmpwalk_prog {
my ($host, $community, $oid) = @_;
local $_;
print LOG "snpwalk: $snmpwalk -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid\n";
$_ = `$snmpwalk -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid`;
return $_;
}
#
# Do snmpwalk.
#
sub snmpwalk {
my $ret;
if (-x $snmpwalk) {
$ret = snmpwalk_prog(@_);
} else {
$e = "$snmpwalk not found!";
print LOG "$e\n" if ($debug);
print STDERR "checkrad: $e\n";
$ret = "";
}
$ret;
}
#
# Do snmpget by calling snmpget.
#
sub snmpget_prog {
my ($host, $community, $oid) = @_;
my ($ret);
local $_;
print LOG "snmpget: $snmpget -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid\n";
$_ = `$snmpget -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid`;
if (/^.*(\s|\")([0-9A-Za-z]{8})(\s|\"|$).*$/) {
# Session ID format.
$ret = $2;
} elsif (/^.*=.*"(.*)"/) {
# oid = "...." junk format.
$ret = $1;
} elsif (/^.*=\s*(?:.*:\s*)?(\S+)/) {
# oid = string format
$ret = $1;
}
# Strip trailing junk if any.
$ret =~ s/\s*Hex:.*$//;
$ret;
}
#
# Do snmpget by using SNMP_Session.
# Coded by Jerry Workman <jerry@newwave.net>
#
sub snmpget_session {
my ($host, $community, $OID) = @_;
my ($ret);
local $_;
my (@enoid, $var,$response, $bindings, $binding, $value);
my ($inoid, $outoid, $upoid, $oid, @retvals);
$OID =~ s/^.iso.org.dod.internet.private.enterprises/.1.3.6.1.4.1/;
push @enoid, encode_oid((split /\./, $OID));
srand();
my $session = SNMP_Session->open($host, $community, 161);
if (!$session->get_request_response(@enoid)) {
$e = "No SNMP answer from $ARGV[0].";
print LOG "$e\n" if ($debug);
print STDERR "checkrad: $e\n";
return "";
}
$response = $session->pdu_buffer;
($bindings) = $session->decode_get_response ($response);
$session->close ();
while ($bindings) {
($binding,$bindings) = decode_sequence ($bindings);
($oid,$value) = decode_by_template ($binding, "%O%@");
my $tempo = pretty_print($value);
$tempo=~s/\t/ /g;
$tempo=~s/\n/ /g;
$tempo=~s/^\s+//;
$tempo=~s/\s+$//;
push @retvals, $tempo;
}
$retvals[0];
}
#
# Do snmpget
#
sub snmpget {
my $ret;
if ($::HAVE_SNMP_SESSION) {
$ret = snmpget_session(@_);
} elsif (-x $snmpget) {
$ret = snmpget_prog(@_);
} else {
$e = "Neither SNMP_Session module or $snmpget found!";
print LOG "$e\n" if ($debug);
print STDERR "checkrad: $e\n";
$ret = "";
}
$ret;
}
#
# Get ifindex from description
#
sub ifindex {
my $port = shift;
# If its not an integer, portisdescr lies!
return $port unless $portisdescr || $port !~ /^[0-9]*$/;
$_ = snmpwalk($ARGV[1], "$cmmty_string", ".1.3.6.1.2.1.2.2.1.2");
foreach (split /\n/){
if(/\.([0-9]+)\s*=.*$port"?$/){
print LOG " port descr $port is at SNMP ifIndex $1\n" if ($debug);
return $1;
}
}
return $port;
}
#
# Strip domains, prefixes and suffixes from username
#
# Known prefixes: (P)PP, (S)LIP e (C)SLIP
# Known suffixes: .ppp, .slip e .cslip
#
# Author: Antonio Dias of SST Internet <accdias@sst.com.br>
#
sub strip_username {
my ($user) = @_;
#
# Trim white spaces.
#
$user =~ s/^\s*(.*?)\s*$/$1/;
#
# Strip out domains, prefix and suffixes
#
$user =~ s/\@(.)*$//;
$user =~ s/^[PSC]//;
$user =~ s/\.(ppp|slip|cslip)$//;
$user;
}
#
# Check whether a session is current on any device which implements the standard IEEE 802.1X MIB
#
# Note: Vendors use different formats for the session ID, and it often doesn't map
# between Acct-Session-ID so can't be used to identify and 802.1X session (we ignore it).
#
# If a session matching the username is found on the port specified, and the
# session is still active then thats good enough...
#
# Author: Arran Cudbard-Bell <arran.cudbard-bell@freeradius.org>
#
$ieeedot1m = '.iso.0.8802.1.1';
sub dot1x_snmp {
$ifIndex = ifindex($ARGV[2]);
# User matches and not terminated yet?
if(
snmpget($ARGV[1], "$cmmty_string", "$ieeedot1m.1.1.2.4.1.9.$ifIndex") eq $ARGV[3] &&
snmpget($ARGV[1], "$cmmty_string", "$ieeedot1m.1.1.2.4.1.8.$ifIndex") eq '999'
){
print LOG " found user $ARGV[3] at port $ARGV[2] ($ifIndex)" if $debug;
return 1;
}
0;
}
#
# See if the user is logged in using the Livingston MIB.
# We don't check the username but the session ID.
#
$lvm = '.iso.org.dod.internet.private.enterprises.307';
sub livingston_snmp {
#
# We don't know at which ifIndex S0 is, and
# there might be a hole at S23, or at S30+S31.
# So we figure out dynamically which offset to use.
#
# If the port < S23, probe ifIndex 5.
# If the port < S30, probe IfIndex 23.
# Otherwise probe ifIndex 32.
#
my $ifIndex;
my $test_index;
if ($ARGV[2] < 23) {
$test_index = 5;
} elsif ($ARGV[2] < 30) {
$test_index = 23;
} else {
$test_index = 32;
}
$_ = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.2.$test_index");
/S([0-9]+)/;
$xport = $1 + 0;
$ifIndex = $ARGV[2] + ($test_index - $xport);
print LOG " port S$ARGV[2] at SNMP ifIndex $ifIndex\n"
if ($debug);
#
# Now get the session id from the terminal server.
#
$sessid = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.5.$ifIndex");
print LOG " session id at port S$ARGV[2]: $sessid\n" if ($debug);
($sessid eq $ARGV[4]) ? 1 : 0;
}
#
# See if the user is logged in using the Aptis MIB.
# We don't check the username but the session ID.
#
# sessionStatusActiveName
$apm1 = '.iso.org.dod.internet.private.enterprises.2637.2.2.102.1.12';
# sessionStatusActiveStopTime
$apm2 = '.iso.org.dod.internet.private.enterprises.2637.2.2.102.1.20';
sub cvx_snmp {
# Remove unique identifier, then take remainder of the
# session-id as a hex number, convert that to decimal.
my $sessid = $ARGV[4];
$sessid =~ s/^.*://;
$sessid =~ s/^0*//;
$sessid = "0" if ($sessid eq '');
#
# Now get the login from the terminal server.
# Blech - the SNMP table is called 'sessionStatusActiveTable,
# but it sometimes lists inactive sessions too.
# However an active session doesn't have a Stop time,
# so we can differentiate that way.
#
my $login = snmpget($ARGV[1], "$cmmty_string", "$apm1." . hex($sessid));
my $stopt = snmpget($ARGV[1], "$cmmty_string", "$apm2." . hex($sessid));
$login = "--" if ($stopt > 0);
print LOG " login with session-id $ARGV[4]: $login\n" if ($debug);
(strip_username($login) eq strip_username($ARGV[3])) ? 1 : 0;
}
#
# See if the user is logged in using the Cisco MIB
#
$csm = '.iso.org.dod.internet.private.enterprises.9';
sub cisco_snmp {
# Look up community string in naspasswd file.
my ($login, $pass) = naspasswd($ARGV[1], 1);
if ($login eq '') {
$pass = $cmmty_string;
} elsif ($login ne 'SNMP') {
if ($debug) {
print LOG
" Error: Need SNMP community string for $ARGV[1]\n";
}
return 2;
}
my $port = $ARGV[2];
my $sess_id = hex($ARGV[4]);
if ($port < 20000) {
#
# The AS5350 doesn't support polling the session ID,
# so we do it based on nas-port-id. This only works
# for analog sessions where port < 20000.
# Yes, this means that simultaneous-use on the as5350
# doesn't work for ISDN users.
#
$login = snmpget($ARGV[1], $pass, "$csm.2.9.2.1.18.$port");
print LOG " user at port S$port: $login\n" if ($debug);
} else {
$login = snmpget($ARGV[1], $pass,
"$csm.9.150.1.1.3.1.2.$sess_id");
print LOG " user with session id $ARGV[4] ($sess_id): " .
"$login\n" if ($debug);
}
# ($login eq $ARGV[3]) ? 1 : 0;
if($login eq $ARGV[3]) {
return 1;
}else{
$out=snmpwalk($ARGV[1],$pass,".iso.org.dod.internet.private.enterprises.9.10.19.1.3.1.1.3");
if($out=~/\"$ARGV[3]\"/){
return 1;
}else{
return 0;
}
}
}
#
# Check a MultiTech CommPlete Server ( CC9600 & CC2400 )
#
# Author: Eric Honzay of Bennett Office Products <ehonzay@willmar.com>
#
$msm = '.iso.org.dod.internet.private.enterprises.995';
sub multitech_snmp {
my $temp = $ARGV[2] + 1;
$login = snmpget($ARGV[1], "$cmmty_string", "$msm.2.31.1.1.1.$temp");
print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
($login eq $ARGV[3]) ? 1 : 0;
}
#
# Check a Computone Powerrack via finger
#
# Old Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
# New Author: Alan Curry <pacman@world.std.com>
#
# The finger response format is version-dependent. To do this *right*, you
# need to know exactly where the port number and username are. I know that
# for 1.7.2, and 3.0.4 but for others I just guess.
# Oh yeah and on top of it all, the thing truncates usernames. --Pac.
#
# 1.7.2 and 3.0.4 both look like this:
#
# 0 0 000 00:56 luser pppfsm Incoming PPP, ppp00, 10.0.0.1
#
# and the truncated ones look like this:
#
# 25 0 000 00:15 longnameluse..pppfsm Incoming PPP, ppp25, 10.0.0.26
#
# Yes, the fields run together. Long Usernames Considered Harmful.
#
sub computone_finger {
my $trunc, $ver;
open(FD, "$finger \@$ARGV[1]|") or return 2;
<FD>; # the [hostname] line is definitely uninteresting
$trunc = substr($ARGV[3], 0, 12);
$ver = "";
while(<FD>) {
if(/cnx kernel release ([^ ,]+)[, ]/) {
$ver = $1;
next;
}
# Check for known versions
if ($ver eq '1.7.2' || $ver eq '3.0.4') {
if (/^\Q$ARGV[2]\E\s+\S+\s+\S+\s+\S+\s+\Q$trunc\E(\s+|\.\.)/) {
close FD;
return 1;
}
next;
}
# All others.
if (/^\s*\Q$ARGV[2]\E\s+.*\s+\Q$trunc\E\s+/) {
close FD;
return 1;
}
}
close FD;
return 0;
}
#
# Check an Ascend Max4000 or similar model via finger
#
# Note: Not all software revisions support finger
# You may also need to enable the finger option.
#
# Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
#
sub max40xx_finger {
open(FD, "$finger $ARGV[3]\@$ARGV[1]|");
while(<FD>) {
$line = $_;
if( $line =~ /Session/ ){
next;
}
if( $line =~ /$ARGV[4]/ ){
return 1; # user is online
}
}
close FD;
return 0; # user is offline
}
#
# Check an Ascend Max4000 or similar model via SNMP
#
# Author: Blaz Zupan of Medinet <blaz@amis.net>
#
$asm = '.iso.org.dod.internet.private.enterprises.529';
sub ascend_snmp {
my $sess_id;
my $l1, $l2;
$l1 = '';
$l2 = '';
#
# If it looks like hex, only try it as hex,
# otherwise try it as both decimal and hex.
#
$sess_id = $ARGV[4];
if ($sess_id !~ /^0/ && $sess_id !~ /[a-f]/i) {
$l1 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
}
if (!$l1){
$sess_id = hex $ARGV[4];
$l2 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
}
print LOG " user at port S$ARGV[2]: $l1 (dec)\n" if ($debug && $l1);
print LOG " user at port S$ARGV[2]: $l2 (hex)\n" if ($debug && $l2);
(($l1 && $l1 eq $ARGV[3]) || ($l2 && $l2 eq $ARGV[3])) ? 1 : 0;
}
#
# See if the user is logged in using the portslave finger.
#
sub portslave_finger {
my ($Port_seen);
$Port_seen = 0;
open(FD, "$finger \@$ARGV[1]|");
while(<FD>) {
#
# Check for ^Port. If we don't see it we
# wont get confused by non-portslave-finger
# output too.
#
if (/^Port/) {
$Port_seen++;
next;
}
next if (!$Port_seen);
next if (/^---/);
($port, $user) = /^.(...) (...............)/;
$port =~ s/ .*//;
$user =~ s/ .*//;
$ulen = length($user);
#
# HACK: strip [PSC] from the front of the username,
# and things like .ppp from the end.
#
$user =~ s/^[PSC]//;
$user =~ s/\.(ppp|slip|cslip)$//;
#
# HACK: because ut_user usually has max. 8 characters
# we only compare up the the length of $user if the
# unstripped name had 8 chars.
#
$argv_user = $ARGV[3];
if ($ulen == 8) {
$ulen = length($user);
$argv_user = substr($ARGV[3], 0, $ulen);
}
if ($port == $ARGV[2]) {
if ($user eq $argv_user) {
print LOG " $user matches $argv_user " .
"on port $port" if ($debug);
close FD;
return 1;
} else {
print LOG " $user doesn't match $argv_user " .
"on port $port" if ($debug);
close FD;
return 0;
}
}
}
close FD;
0;
}
#
# See if the user is already logged-in at the 3Com/USR Total Control.
# (this routine by Alexis C. Villalon <alexisv@compass.com.ph>).
# You must have the Net::Telnet module from CPAN for this to work.
# You must also have your /etc/raddb/naspasswd made up.
#
sub tc_tccheck {
#
# Localize all variables first.
#
my ($Port_seen, $ts, $terminalserver, $log, $login, $pass, $password);
my ($telnet, $curprompt, $curline, $ok, $totlines, $ccntr);
my (@curlines, @cltok, $user, $port, $ulen);
return 2 unless (check_net_telnet());
$terminalserver = $ARGV[1];
$Port_seen = 0;
#
# Get login name and password for a certain NAS from $naspass.
#
($login, $password) = naspasswd($terminalserver, 1);
return 2 if ($password eq "");
#
# Communicate with NAS using Net::Telnet, then issue
# the command "show sessions" to see who are logged in.
# Thanks to Chris Jackson <chrisj@tidewater.net> for the
# for the "-- Press Return for More --" workaround.
#
$telnet = new Net::Telnet (Timeout => 5,
Prompt => '/\>/');
$telnet->open($terminalserver);
$telnet->login($login, $password);
$telnet->print("show sessions");
while ($curprompt ne "\>") {
($curline, $curprompt) = $telnet->waitfor
(String => "-- Press Return for More --",
String => "\>",
Timeout => 5);
$ok = $telnet->print("");
push @curlines, split(/^/m, $curline);
}
$telnet->close;
#
# Telnet closed. We got the info. Let's examine it.
#
$totlines = @curlines;
$ccntr = 0;
while($ccntr < $totlines) {
#
# Check for ^Port.
#
if ($curlines[$ccntr] =~ /^Port/) {
$Port_seen++;
$ccntr++;
next;
}
#
# Ignore all unnecessary lines.
#
if (!$Port_seen || $curlines[$ccntr] =~ /^---/ ||
$curlines[$ccntr] =~ /^ .*$/) {
$ccntr++;
next;
}
#
# Parse the current line for the port# and username.
#
@cltok = split(/\s+/, $curlines[$ccntr]);
$ccntr++;
$port = $cltok[0];
$user = $cltok[1];
$ulen = length($user);
#
# HACK: strip [PSC] from the front of the username,
# and things like .ppp from the end. Strip S from
# the front of the port number.
#
$user =~ s/^[PSC]//;
$user =~ s/\.(ppp|slip|cslip)$//;
$port =~ s/^S//;
#
# HACK: because "show sessions" shows max. 15 characters
# we only compare up to the length of $user if the
# unstripped name had 15 chars.
#
$argv_user = $ARGV[3];
if ($ulen == 15) {
$ulen = length($user);
$argv_user = substr($ARGV[3], 0, $ulen);
}
if ($port == $ARGV[2]) {
if ($user eq $argv_user) {
print LOG " $user matches $argv_user " .
"on port $port" if ($debug);
return 1;
} else {
print LOG " $user doesn't match $argv_user " .
"on port $port" if ($debug);
return 0;
}
}
}
0;
}
#
# Check a Cyclades PathRAS via telnet
#
# Version: 1.2
#
# Author: Antonio Dias of SST Internet <accdias@sst.com.br>
#
sub cyclades_telnet {
#
# Localize all variables first.
#
my ($pr, $pr_login, $pr_passwd, $pr_prompt, $endlist, @list, $port, $user);
#
# This variable must match PathRAS' command prompt
# string as entered in menu option 6.2.
# The value below matches the default command prompt.
#
$pr_prompt = '/Select option ==\>$/i';
#
# This variable match the end of userslist.
#
$endlist = '/Type \<enter\>/i';
#
# Do we have Net::Telnet installed?
#
return 2 unless (check_net_telnet());
#
# Get login name and password for NAS
# from $naspass file.
#
($pr_login, $pr_passwd) = naspasswd($ARGV[1], 1);
#
# Communicate with PathRAS using Net::Telnet, then access
# menu option 6.8 to see who are logged in.
# Based on PathRAS firmware version 1.2.3
#
$pr = new Net::Telnet (
Timeout => 5,
Host => $ARGV[1],
ErrMode => 'return'
) || return 2;
#
# Force PathRAS shows its banner.
#
$pr->break();
#
# Log on PathRAS
#
if ($pr->waitfor(Match => '/login : $/i') == 1) {
$pr->print($pr_login);
} else {
print LOG " Error: sending login name to PathRAS\n" if ($debug);
$pr->close;
return 2;
}
if ($pr->waitfor(Match => '/password : $/i') == 1) {
$pr->print($pr_passwd);
} else {
print LOG " Error: sending password to PathRAS.\n" if ($debug);
$pr->close;
return 2;
}
$pr->print();
#
# Access menu option 6 "PathRAS Management"
#
if ($pr->waitfor(Match => $pr_prompt) == 1) {
$pr->print('6');
} else {
print LOG " Error: acessing menu option '6'.\n" if ($debug);
$pr->close;
return 2;
}
#
# Access menu option 8 "Show Active Ports"
#
if ($pr->waitfor(Match => $pr_prompt) == 1) {
@list = $pr->cmd(String => '8', Prompt => $endlist);
} else {
print LOG " Error: acessing menu option '8'.\n" if ($debug);
$pr->close;
return 2;
}
#
# Since we got the info we want, let's close
# the telnet session
#
$pr->close;
#
# Lets examine the userlist stored in @list
#
foreach(@list) {
#
# We are interested in active sessions only
#
if (/Active/i) {
($port, $user) = split;
#
# Strip out any prefix, suffix and
# realm from $user check to see if
# $ARGV[3] matches.
#
if(strip_username($ARGV[3]) eq strip_username($user)) {
print LOG " User '$ARGV[3]' found on '$ARGV[1]:$port'.\n" if ($debug);
return 1;
}
}
}
print LOG " User '$ARGV[3]' not found on '$ARGV[1]'.\n" if ($debug);
0;
}
#
# Check a Patton 2800 via SNMP
#
# Version: 1.0
#
# Author: Antonio Dias of SST Internet <accdias@sst.com.br>
#
sub patton_snmp {
my($oid);
#$oid = '.1.3.6.1.4.1.1768.5.100.1.40.' . hex $ARGV[4];
# Reported by "Andria Legon" <andria@patton.com>
# The OID below should be the correct one instead of the one above.
$oid = '.1.3.6.1.4.1.1768.5.100.1.56.' . hex $ARGV[4];
#
# Check if the session still active
#
if (snmpget($ARGV[1], "monitor", "$oid") == 0) {
print LOG " Session $ARGV[4] still active on NAS " .
"$ARGV[1], port $ARGV[2], for user $ARGV[3].\n" if ($debug);
return 1;
}
0;
}
#
# Check a Digitro BXS via rusers
#
# Version: 1.1
#
# Author: Antonio Dias of SST Internet <accdias@sst.com.br>
#
sub digitro_rusers {
my ($ret);
local $_;
if (-e $rusers && -x $rusers) {
#
# Get a list of users logged in via rusers
#
$_ = `$rusers $ARGV[1]`;
$ret = ((/$ARGV[3]/) ? 1 : 0);
} else {
print LOG " Error: can't execute $rusers\n" if $debug;
$ret = 2;
}
$ret;
}
#
# Check Cyclades PR3000 and PR4000 via SNMP
#
# Version: 1.0
#
# Author: Antonio Dias of SST Internet <accdias@sst.com.br>
#
sub cyclades_snmp {
my ($oid, $ret);
local $_;
$oid = ".1.3.6.1.4.1.2925.3.3.6.1.1.2";
$_ = snmpwalk($ARGV[1],"$cmmty_string",$oid);
$ret = ((/$ARGV[3]/) ? 1 : 0);
$ret;
}
#
# 3Com/USR HiPer Arc Total Control.
# This works with HiPer Arc 4.0.30
# (this routine by Igor Brezac <igor@ipass.net>)
#
# This routine modified by Dan Halverson <danh@tbc.net>
# to suport additional versions of Hiper Arc
#
$usrm = '.iso.org.dod.internet.private.enterprises.429';
sub usrhiper_snmp {
my ($login,$password,$oidext);
# Look up community string in naspasswd file.
($login, $password) = naspasswd($ARGV[1], 1);
if ($login && $login ne 'SNMP') {
if($debug) {
print LOG
" Error: Need SNMP community string for $ARGV[1]\n";
}
return 2;
} else {
# If password is defined in naspasswd file, use it as community, otherwise use $cmmty_string
if ($password eq '') {
$password = "$cmmty_string";
}
}
my ($ver) = get_hiper_ver(usrm=>$usrm, target=>$ARGV[1], community=>$password);
$oidext = get_oidext(ver=>$ver, tty=>$ARGV[2]);
my ($login);
$login = snmpget($ARGV[1], $password, "$usrm.4.10.1.1.18.$oidext");
if ($login =~ /\"/) {
$login =~ /^.*\"([^"]+)\"/;
$login = $1;
}
print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
($login eq $ARGV[3]) ? 1 : 0;
}
#
# get_hiper_ver and get_oidext by Dan Halverson <danh@tbc.net>
#
sub get_hiper_ver {
my (%args) = @_;
my ($ver
);
$ver = snmpget ($args{'target'}, $args{'community'}, $args{'usrm'}.".4.1.14.0");
return($ver);
}
#
# Add additional OID checks below before the else.
# Else is for 4.0.30
#
sub get_oidext {
my (%args) = @_;
my ($oid
);
if ($args{'ver'} =~ /V5.1.99/) {
$oid = $args{'tty'}+1257-1;
}
else {
$oid = 1257 + 256*int(($args{'tty'}-1) / $hiper_density) +
(($args{'tty'}-1) % $hiper_density);
}
return($oid);
}
#
# Check USR Netserver with Telnet - based on tc_tccheck.
# By "Marti" <mts@interplanet.es>
#
sub usrnet_telnet {
#
# Localize all variables first.
#
my ($ts, $terminalserver, $login, $password);
my ($telnet, $curprompt, $curline, $ok);
my (@curlines, $user, $port);
return 2 unless (check_net_telnet());
$terminalserver = $ARGV[1];
$Port_seen = 0;
#
# Get login name and password for a certain NAS from $naspass.
#
($login, $password) = naspasswd($terminalserver, 1);
return 2 if ($password eq "");
#
# Communicate with Netserver using Net::Telnet, then access
# list connectionsto see who are logged in.
#
$telnet = new Net::Telnet (Timeout => 5,
Prompt => '/\>/');
$telnet->open($terminalserver);
#
# Log on Netserver
#
$telnet->login($login, $password);
#
# Launch list connections command
$telnet->print("list connections");
while ($curprompt ne "\>") {
($curline, $curprompt) = $telnet->waitfor
( String => "\>",
Timeout => 5);
$ok = $telnet->print("");
push @curlines, split(/^/m, $curline);
}
$telnet->close;
#
# Telnet closed. We got the info. Let's examine it.
#
foreach(@curlines) {
if ( /mod\:/ ) {
($port, $user, $dummy) = split;
#
# Strip out any prefixes and suffixes
# from the username
#
# uncomment this if you use the standard
# prefixes
#$user =~ s/^[PSC]//;
#$user =~ s/\.(ppp|slip|cslip)$//;
#
# Check to see if $user is already connected
#
if ($user eq $ARGV[3]) {
print LOG " $user matches $ARGV[3] " .
"on port $port" if ($debug);
return 1;
};
};
};
print LOG
" $ARGV[3] not found on Netserver logged users list " if ($debug);
0;
}
#
# Versanet's Perl Script Support:
#
# ___ versanet_snmp 1.0 by support@versanetcomm.com ___ July 1999
# Versanet Enterprise MIB Base: 1.3.6.1.4.1.2180
#
# VN2001/2002 use slot/port number to locate modems. To use snmp get we
# have to translate the original port number into a slot/port pair.
#
$vsm = '.iso.org.dod.internet.private.enterprises.2180';
sub versanet_snmp {
print LOG "argv[2] = $ARGV[2] " if ($debug);
$port = $ARGV[2]%8;
$port = 8 if ($port eq 0);
print LOG "port = $port " if ($debug);
$slot = (($ARGV[2]-$port)/8)+1;
print LOG "slot = $slot" if ($debug);
$loginname = snmpget($ARGV[1], "$cmmty_string", "$vsm.27.1.1.3.$slot.$port");
#
# Note: the "$cmmty_string" string above could be replaced by the public
# community string defined in Versanet VN2001/VN2002.
#
print LOG " user at slot $slot port $port: $loginname\n" if ($debug); ($loginname eq $ARGV[3]) ? 1 : 0;
}
# 1999/08/24 Chris Shenton <chris@shenton.org>
# Check Bay8000 NAS (aka: Annex) using finger.
# Returns from "finger @bay" like:
# Port What User Location When Idle Address
# asy2 PPP bill --- 9:33am :08 192.168.1.194
# asy4 PPP hillary --- 9:36am :04 192.168.1.195
# [...]
# But also returns partial-match users if you say like "finger g@bay":
# Port What User Location When Idle Address
# asy2 PPP gore --- 9:33am :09 192.168.1.194
# asy22 PPP gwbush --- Mon 9:19am :07 192.168.1.80
# So check exact match of username!
sub bay_finger { # ARGV: 1=nas_ip, 2=nas_port, 3=login, 4=sessid
open(FINGER, "$finger $ARGV[3]\@$ARGV[1]|") || return 2; # error
while(<FINGER>) {
my ($Asy, $PPP, $User) = split;
if( $User =~ /^$ARGV[3]$/ ){
close FINGER;
print LOG "checkrad:bay_finger: ONLINE $ARGV[3]\@$ARGV[1]"
if ($debug);
return 1; # online
}
}
close FINGER;
print LOG "checkrad:bay_finger: offline $ARGV[3]\@$ARGV[1]" if ($debug);
return 0; # offline
}
#
# Cisco L2TP support
# This is for PPP sessions coming from an L2TP tunnel from a Dial
# or DSL wholesale provider
# Paul Khavkine <paul@distributel.net>
# July 19 2001
#
# find_l2tp_login() walks a part of cisco vpdn tree to find out what session
# and tunnel ID's are for a given Virtual-Access interface to construct
# the following OID: .1.3.6.1.4.1.9.10.24.1.3.2.1.2.2.$tunID.$sessID
# Then gets the username from that OID.
# Make sure you set the $realm variable at the begining of the file if
# needed. The new type for naslist is cisco_l2tp
sub find_l2tp_login
{
my($host, $community, $port_num) = @_;
my $l2tp_oid = '.1.3.6.1.4.1.9.10.24.1.3.2.1.2.2';
my $port_oid = '.iso.org.dod.internet.private.enterprises.9.10.51.1.2.1.1.2.2';
my $port = 'Vi' . $port_num;
my $sess = new SNMP::Session(DestHost => $host, Community => $community);
my $snmp_var = new SNMP::Varbind(["$port_oid"]);
my $val = $sess->getnext($snmp_var);
do
{
$sess->getnext($snmp_var);
} until ($snmp_var->[$SNMP::Varbind::val_f] =~ /$port/) ||
(!($snmp_var->[$SNMP::Varbind::ref_f] =~ /^$port_oid\.(\d+)\.(\d+)$/)) ||
($sess->{ErrorNum});
my $val1 = $snmp_var->[$SNMP::Varbind::ref_f];
if ($val1 =~ /^$port_oid/) {
$result = substr($val1, length($port_oid));
$result =~ /^\.(\d+)\.(\d+)$/;
$tunID = $1;
$sessID = $2;
}
my $snmp_var1 = new SNMP::Varbind(["$l2tp_oid\.$tunID\.$sessID"]);
$val = $sess->get($snmp_var1);
my $login = $snmp_var1->[$SNMP::Varbind::val_f];
return $login;
}
sub cisco_l2tp_snmp
{
my $login = find_l2tp_login("$ARGV[1]", $cmmty_string, "$ARGV[2]");
print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
($login eq "$ARGV[3]\@$realm") ? 1 : 0;
}
sub mikrotik_snmp {
# Set SNMP version
# MikroTik only supports version 1
$snmp_version = "1";
# Look up community string in naspasswd file.
($login, $password) = naspasswd($ARGV[1], 1);
if ($login && $login ne 'SNMP') {
if($debug) {
print LOG "Error: Need SNMP community string for $ARGV[1]\n";
}
return 2;
} else {
# If password is defined in naspasswd file, use it as community,
# otherwise use $cmmty_string
if ($password eq '') {
$password = "$cmmty_string";
}
}
# We want interface descriptions
$oid = "ifDescr";
# Mikrotik doesnt give port IDs correctly to RADIUS :(
# practically this would limit us to a simple only-one user limit for
# this script to work properly.
@output = snmpwalk_prog($ARGV[1], $password, "$oid");
foreach $line ( @output ) {
#remove newline
chomp $line;
#remove trailing whitespace
($line = $line) =~ s/\s+$//;
if( $line =~ /<.*-$ARGV[3]>/ ) {
$username_seen++;
}
}
#lets return something
if ($username_seen > 0) {
return 1;
} else {
return 0;
}
}
sub mikrotik_telnet {
# Localize all variables first.
my ($t, $login, $password);
my (@fields, @output, $output, $username_seen, $user);
return 2 unless (check_net_telnet());
$terminalserver = $ARGV[1];
$user = $ARGV[3];
# Get login name and password for a certain NAS from $naspass.
($login, $password) = naspasswd($terminalserver, 1);
return 2 if ($password eq "");
# MikroTik routeros doesnt tell us to which port the user is connected
# practically this would limit us to a simple only-one user limit for
# this script to work properly.
$t = new Net::Telnet (Timeout => 5,
Prompt => '//\[.*@.*\] > /');
# Dont just exit when there is error
$t->errmode('return');
# Telnet to terminal server
$t->open($terminalserver) or return 2;
#Send login and password etc.
$t->login(Name => $login,
Password => $password,
# We must detect if we are logged in from the login banner.
# Because if routeros is with a free license the command
# prompt dont come. Instead it waits us to press "Enter".
Prompt => '/MikroTik/');
# Just be sure that routeros isn't waiting for us to press "Enter"
$t->print("");
# Wait for the real prompt
$t->waitfor('/\[.*@.*\] > /');
# It is not possible to get the line numbers etc.
# Thus we cant support if simultaneus-use is over 1
# At least I was using pppoe so it wasnt possible.
$t->print('ppp active print column name detail');
# Somehow routeros echo'es our commands 2 times. We dont want to mix
# this with the real command prompt.
$t->waitfor('/\[.*@.*\] > ppp active print column name detail/');
# Now lets get the list of online ppp users.
( $output ) = $t->waitfor('/\[.*@.*\] > /');
# For debugging we can print the list to stdout
# print $output;
#Lets logout to make everybody happy.
#If we close the connection without logging out then routeros
#starts to complain after a while. Saying;
#telnetd: All network ports in use.
$t->print("quit");
$t->close;
#check for # of $user in output
#the output includes only one = between name and username so we can
#safely use it as a seperator.
#disabled until mikrotik starts to send newline after each line...
# @output = $output;
# foreach $line ( @output ) {
# #remove newline
# chomp $line;
# #remove trailing whitespace
# ($line = $line) =~ s/\s+$//;
# if( $line =~ /name=/ ) {
# print($line);
# @fields = split( /=/, $line );
# if( $fields[1] == "\"$user\"") {
# $username_seen++;
# }
# }
# }
if( $output =~ /name="$user"/ ) {
$username_seen++;
}
#lets return something
if ($username_seen > 0) {
return 1;
} else {
return 0;
}
}
sub redback_telnet {
#Localize all variables first.
my ($terminalserver, $login, $password);
my ($user, $context, $operprompt, $adminprompt, $t);
return 2 unless (check_net_telnet());
$terminalserver = $ARGV[1];
($user, $context) = split /@/, $ARGV[3];
if (not $user) {
print LOG " Error: No user defined\n" if ($debug);
return 2;
}
if (not $context) {
print LOG " Error: No context defined\n" if ($debug);
return 2;
}
# Get loggin information
($root, $password) = naspasswd($terminalserver, 1);
return 2 if ($password eq "");
$operprompt = '/\[.*\].*>$/';
$adminprompt = '/\[.*\].*#$/';
# Logging to the RedBack NAS
$t = new Net::Telnet (Timeout => 5, Prompt => $operprompt);
$t->input_log("./debug");
$t->open($terminalserver);
$t->login($root, $password);
#Enable us
$t->print('ena');
$t->waitfor('/Password/');
$t->print($password);
$t->waitfor($adminprompt);
$t->prompt($adminprompt);
#Switch context
$t->cmd(String => "context $context");
#Ask the question
@lines = $t->cmd(String => "show subscribers active $user\@$context");
if ($lines[0] =~ /subscriber $user\@$context/ ) {
return 1;
}
return 0;
}
###############################################################################
# Poor man's getopt (for -d)
if ($ARGV[0] eq '-d') {
shift @ARGV;
$debug = "stdout";
}
if ($debug) {
if ($debug eq 'stdout') {
open(LOG, ">&STDOUT");
} elsif ($debug eq 'stderr') {
open(LOG, ">&STDERR");
} else {
open(LOG, ">>$debug");
$now = localtime;
print LOG "$now checkrad @ARGV\n";
}
}
if ($#ARGV != 4) {
print LOG "Usage: checkrad nas_type nas_ip " .
"nas_port login session_id\n" if ($debug);
print STDERR "Usage: checkrad nas_type nas_ip " .
"nas_port login session_id\n"
unless ($debug =~ m/^(stdout|stderr)$/);
close LOG if ($debug);
exit(2);
}
if ($ARGV[0] eq 'livingston') {
$ret = &livingston_snmp;
} elsif ($ARGV[0] eq 'cisco') {
$ret = &cisco_snmp;
} elsif ($ARGV[0] eq 'cvx') {
$ret = &cvx_snmp;
} elsif ($ARGV[0] eq 'multitech') {
$ret = &multitech_snmp;
} elsif ($ARGV[0] eq 'computone') {
$ret = &computone_finger;
} elsif ($ARGV[0] eq 'max40xx') {
$ret = &max40xx_finger;
} elsif ($ARGV[0] eq 'ascend' || $ARGV[0] eq 'max40xx_snmp') {
$ret = &ascend_snmp;
} elsif ($ARGV[0] eq 'portslave') {
$ret = &portslave_finger;
} elsif ($ARGV[0] eq 'tc') {
$ret = &tc_tccheck;
} elsif ($ARGV[0] eq 'pathras') {
$ret = &cyclades_telnet;
} elsif ($ARGV[0] eq 'pr3000') {
$ret = &cyclades_snmp;
} elsif ($ARGV[0] eq 'pr4000') {
$ret = &cyclades_snmp;
} elsif ($ARGV[0] eq 'patton') {
$ret = &patton_snmp;
} elsif ($ARGV[0] eq 'digitro') {
$ret = &digitro_rusers;
} elsif ($ARGV[0] eq 'usrhiper') {
$ret = &usrhiper_snmp;
} elsif ($ARGV[0] eq 'netserver') {
$ret = &usrnet_telnet;
} elsif ($ARGV[0] eq 'versanet') {
$ret = &versanet_snmp;
} elsif ($ARGV[0] eq 'bay') {
$ret = &bay_finger;
} elsif ($ARGV[0] eq 'cisco_l2tp'){
$ret = &cisco_l2tp_snmp;
} elsif ($ARGV[0] eq 'mikrotik'){
$ret = &mikrotik_telnet;
} elsif ($ARGV[0] eq 'mikrotik_snmp'){
$ret = &mikrotik_snmp;
} elsif ($ARGV[0] eq 'redback'){
$ret = &redback_telnet;
} elsif ($ARGV[0] eq 'dot1x'){
$ret = &dot1x_snmp;
} elsif ($ARGV[0] eq 'other') {
$ret = 1;
} else {
print LOG " checkrad: unknown NAS type $ARGV[0]\n" if ($debug);
print STDERR "checkrad: unknown NAS type $ARGV[0]\n";
$ret = 2;
}
if ($debug) {
$mn = "login ok";
$mn = "double detected" if ($ret == 1);
$mn = "error detected" if ($ret == 2);
print LOG " Returning $ret ($mn)\n";
close LOG;
}
exit($ret);