3 # checkrad.pl See if a user is (still) logged in on a certain port.
5 # This is used by the FreeRADIUS server to check
6 # if its idea of a user logged in on a certain port/nas
7 # is correct if a double login is detected.
9 # Called as: nas_type nas_ip nas_port login session_id
11 # Returns: 0 = no duplicate, 1 = duplicate, >1 = error.
15 # livingston_snmp 1.2 Author: miquels@cistron.nl
16 # cvx_snmp 1.0 Author: miquels@cistron.nl
17 # portslave_finger 1.0 Author: miquels@cistron.nl
18 # max40xx_finger 1.0 Author: costa@mdi.ca
19 # ascend_snmp 1.1 Author: blaz@amis.net
20 # computone_finger 1.2 Author: pacman@world.std.com
21 # sub tc_tccheck 1.1 Author: alexisv@compass.com.ph
22 # cyclades_telnet 1.2 Author: accdias@sst.com.br
23 # patton_snmp 1.0 Author: accdias@sst.com.br
24 # digitro_rusers 1.1 Author: accdias@sst.com.br
25 # cyclades_snmp 1.0 Author: accdias@sst.com.br
26 # usrhiper_snmp 1.0 Author: igor@ipass.net
27 # multitech_snmp 1.0 Author: ehonzay@willmar.com
28 # netserver_telnet 1.0 Author: mts@interplanet.es
29 # versanet_snmp 1.0 Author: support@versanetcomm.com
30 # bay_finger 1.0 Author: chris@shenton.org
31 # cisco_l2tp 1.14 Author: paul@distributel.net
32 # mikrotik_telnet 1.1 Author: Evren Yurtesen <yurtesen@ispro.net.tr>
33 # mikrotik_snmp 1.0 Author: Evren Yurtesen <yurtesen@ispro.net.tr>
34 # redback_telnet Author: Eduardo Roldan
36 # Config: $debug is the file you want to put debug messages in
37 # $snmpget is the location of your ``snmpget'' program
38 # $snmpwalk is the location of your ``snmpwalk'' program
39 # $snmp_timeout is the timeout for snmp queries
40 # $snmp_retries is the number of retries for timed out snmp queries
41 # $snmp_version is the version of to use for snmp queries [1,2c,3]
42 # $rusers is the location of your ``rusers'' program
43 # $naspass is the location of your NAS admin password file
47 $localstatedir = "@localstatedir@";
49 $sysconfdir = "@sysconfdir@";
50 $raddbdir = "@raddbdir@";
53 #$debug = "$logdir/checkrad.log";
55 $snmpget = "@SNMPGET@";
56 $snmpwalk = "@SNMPWALK@";
61 $naspass = "$raddbdir/naspasswd";
63 # Community string. Change this if yours isn't "public".
64 $cmmty_string = "public";
65 # path to finger command
66 $finger = "/usr/bin/finger";
69 # USR-Hiper: $hiper_density is the reported port density (default 256
70 # but 24 makes more sense)
75 # Try to load Net::Telnet, SNMP_Session etc.
76 # Do not complain if we cannot find it.
77 # Prefer a locally installed copy.
80 unshift @INC, "/usr/local/lib/site_perl";
82 eval "use Net::Telnet 3.00;";
83 $::HAVE_NET_TELNET = ($@ eq "");
85 eval "use SNMP_Session;";
88 $::HAVE_SNMP_SESSION = ($@ eq "");
94 # Get password from /etc/raddb/naspasswd file.
95 # Returns (login, password).
98 my ($terminalserver, $emptyok) = @_;
99 my ($login, $password);
100 my ($ts, $log, $pass);
102 unless (open(NFD, $naspass)) {
104 print LOG "checkrad: naspasswd file not found; " .
105 "possible match for $ARGV[3]\n" if ($debug);
106 print STDERR "checkrad: naspasswd file not found; " .
107 "possible match for $ARGV[3]\n";
113 next if (m/^(#|$|[\t ]+$)/);
114 ($ts, $log, $pass) = split(/\s+/, $_, 3);
115 if ($ts eq $terminalserver) {
122 if ($password eq "" && !$emptyok) {
123 print LOG "checkrad: password for $ARGV[1] is null; " .
124 "possible match for $ARGV[3] on " .
125 "port $ARGV[2]\n" if ($debug);
126 print STDERR "checkrad: password for $ARGV[1] is null; " .
127 "possible match for $ARGV[3] on port $ARGV[2]\n";
133 # See if Net::Telnet is there.
135 sub check_net_telnet {
136 if (!$::HAVE_NET_TELNET) {
138 " checkrad: Net::Telnet 3.00+ CPAN module not installed\n"
141 "checkrad: Net::Telnet 3.00+ CPAN module not installed\n";
148 # Do snmpwalk by calling snmpwalk.
151 my ($host, $community, $oid) = @_;
154 print LOG "snpwalk: $snmpwalk -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid\n";
155 $_ = `$snmpwalk -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid`;
167 $ret = snmpwalk_prog(@_);
169 $e = "$snmpwalk not found!";
170 print LOG "$e\n" if ($debug);
171 print STDERR "checkrad: $e\n";
179 # Do snmpget by calling snmpget.
182 my ($host, $community, $oid) = @_;
186 print LOG "snmpget: $snmpget -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid\n";
187 $_ = `$snmpget -r $snmp_retries -t $snmp_timeout -v$snmp_version -c '$community' $host $oid`;
188 if (/^.*(\s|\")([0-9A-Za-z]{8})(\s|\"|$).*$/) {
191 } elsif (/^.*=.*"(.*)"/) {
192 # oid = "...." junk format.
194 } elsif (/^.*=\s*(\S+)/) {
195 # oid = string format
199 # Strip trailing junk if any.
200 $ret =~ s/\s*Hex:.*$//;
205 # Do snmpget by using SNMP_Session.
206 # Coded by Jerry Workman <jerry@newwave.net>
208 sub snmpget_session {
209 my ($host, $community, $OID) = @_;
212 my (@enoid, $var,$response, $bindings, $binding, $value);
213 my ($inoid, $outoid, $upoid, $oid, @retvals);
215 $OID =~ s/^.iso.org.dod.internet.private.enterprises/.1.3.6.1.4.1/;
217 push @enoid, encode_oid((split /\./, $OID));
220 my $session = SNMP_Session->open($host, $community, 161);
221 if (!$session->get_request_response(@enoid)) {
222 $e = "No SNMP answer from $ARGV[0].";
223 print LOG "$e\n" if ($debug);
224 print STDERR "checkrad: $e\n";
227 $response = $session->pdu_buffer;
228 ($bindings) = $session->decode_get_response ($response);
231 ($binding,$bindings) = decode_sequence ($bindings);
232 ($oid,$value) = decode_by_template ($binding, "%O%@");
233 my $tempo = pretty_print($value);
239 push @retvals, $tempo;
250 if ($::HAVE_SNMP_SESSION) {
251 $ret = snmpget_session(@_);
252 } elsif (-x $snmpget) {
253 $ret = snmpget_prog(@_);
255 $e = "Neither SNMP_Session module or $snmpget found!";
256 print LOG "$e\n" if ($debug);
257 print STDERR "checkrad: $e\n";
264 # Strip domains, prefixes and suffixes from username
266 # Known prefixes: (P)PP, (S)LIP e (C)SLIP
267 # Known suffixes: .ppp, .slip e .cslip
269 # Author: Antonio Dias of SST Internet <accdias@sst.com.br>
276 $user =~ s/^\s*(.*?)\s*$/$1/;
278 # Strip out domains, prefix and suffixes
280 $user =~ s/\@(.)*$//;
282 $user =~ s/\.(ppp|slip|cslip)$//;
287 # See if the user is logged in using the Livingston MIB.
288 # We don't check the username but the session ID.
290 $lvm = '.iso.org.dod.internet.private.enterprises.307';
291 sub livingston_snmp {
294 # We don't know at which ifIndex S0 is, and
295 # there might be a hole at S23, or at S30+S31.
296 # So we figure out dynamically which offset to use.
298 # If the port < S23, probe ifIndex 5.
299 # If the port < S30, probe IfIndex 23.
300 # Otherwise probe ifIndex 32.
306 } elsif ($ARGV[2] < 30) {
311 $_ = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.2.$test_index");
314 $ifIndex = $ARGV[2] + ($test_index - $xport);
316 print LOG " port S$ARGV[2] at SNMP ifIndex $ifIndex\n"
320 # Now get the session id from the terminal server.
322 $sessid = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.5.$ifIndex");
324 print LOG " session id at port S$ARGV[2]: $sessid\n" if ($debug);
326 ($sessid eq $ARGV[4]) ? 1 : 0;
330 # See if the user is logged in using the Aptis MIB.
331 # We don't check the username but the session ID.
333 # sessionStatusActiveName
334 $apm1 = '.iso.org.dod.internet.private.enterprises.2637.2.2.102.1.12';
335 # sessionStatusActiveStopTime
336 $apm2 = '.iso.org.dod.internet.private.enterprises.2637.2.2.102.1.20';
339 # Remove unique identifier, then take remainder of the
340 # session-id as a hex number, convert that to decimal.
341 my $sessid = $ARGV[4];
344 $sessid = "0" if ($sessid eq '');
347 # Now get the login from the terminal server.
348 # Blech - the SNMP table is called 'sessionStatusActiveTable,
349 # but it sometimes lists inactive sessions too.
350 # However an active session doesn't have a Stop time,
351 # so we can differentiate that way.
353 my $login = snmpget($ARGV[1], "$cmmty_string", "$apm1." . hex($sessid));
354 my $stopt = snmpget($ARGV[1], "$cmmty_string", "$apm2." . hex($sessid));
355 $login = "--" if ($stopt > 0);
357 print LOG " login with session-id $ARGV[4]: $login\n" if ($debug);
359 (strip_username($login) eq strip_username($ARGV[3])) ? 1 : 0;
363 # See if the user is logged in using the Cisco MIB
365 $csm = '.iso.org.dod.internet.private.enterprises.9';
368 # Look up community string in naspasswd file.
369 my ($login, $pass) = naspasswd($ARGV[1], 1);
371 $pass = $cmmty_string;
372 } elsif ($login ne 'SNMP') {
375 " Error: Need SNMP community string for $ARGV[1]\n";
381 my $sess_id = hex($ARGV[4]);
385 # The AS5350 doesn't support polling the session ID,
386 # so we do it based on nas-port-id. This only works
387 # for analog sessions where port < 20000.
388 # Yes, this means that simultaneous-use on the as5350
389 # doesn't work for ISDN users.
391 $login = snmpget($ARGV[1], $pass, "$csm.2.9.2.1.18.$port");
392 print LOG " user at port S$port: $login\n" if ($debug);
394 $login = snmpget($ARGV[1], $pass,
395 "$csm.9.150.1.1.3.1.2.$sess_id");
396 print LOG " user with session id $ARGV[4] ($sess_id): " .
397 "$login\n" if ($debug);
400 # ($login eq $ARGV[3]) ? 1 : 0;
401 if($login eq $ARGV[3]) {
404 $out=snmpwalk($ARGV[1],$pass,".iso.org.dod.internet.private.enterprises.9.10.19.1.3.1.1.3");
405 if($out=~/\"$ARGV[3]\"/){
414 # Check a MultiTech CommPlete Server ( CC9600 & CC2400 )
416 # Author: Eric Honzay of Bennett Office Products <ehonzay@willmar.com>
418 $msm = '.iso.org.dod.internet.private.enterprises.995';
420 my $temp = $ARGV[2] + 1;
422 $login = snmpget($ARGV[1], "$cmmty_string", "$msm.2.31.1.1.1.$temp");
423 print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
425 ($login eq $ARGV[3]) ? 1 : 0;
429 # Check a Computone Powerrack via finger
431 # Old Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
432 # New Author: Alan Curry <pacman@world.std.com>
434 # The finger response format is version-dependent. To do this *right*, you
435 # need to know exactly where the port number and username are. I know that
436 # for 1.7.2, and 3.0.4 but for others I just guess.
437 # Oh yeah and on top of it all, the thing truncates usernames. --Pac.
439 # 1.7.2 and 3.0.4 both look like this:
441 # 0 0 000 00:56 luser pppfsm Incoming PPP, ppp00, 10.0.0.1
443 # and the truncated ones look like this:
445 # 25 0 000 00:15 longnameluse..pppfsm Incoming PPP, ppp25, 10.0.0.26
447 # Yes, the fields run together. Long Usernames Considered Harmful.
449 sub computone_finger {
452 open(FD, "$finger \@$ARGV[1]|") or return 2;
453 <FD>; # the [hostname] line is definitely uninteresting
454 $trunc = substr($ARGV[3], 0, 12);
457 if(/cnx kernel release ([^ ,]+)[, ]/) {
461 # Check for known versions
462 if ($ver eq '1.7.2' || $ver eq '3.0.4') {
463 if (/^\Q$ARGV[2]\E\s+\S+\s+\S+\s+\S+\s+\Q$trunc\E(\s+|\.\.)/) {
470 if (/^\s*\Q$ARGV[2]\E\s+.*\s+\Q$trunc\E\s+/) {
481 # Check an Ascend Max4000 or similar model via finger
483 # Note: Not all software revisions support finger
484 # You may also need to enable the finger option.
486 # Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
489 open(FD, "$finger $ARGV[3]\@$ARGV[1]|");
492 if( $line =~ /Session/ ){
496 if( $line =~ /$ARGV[4]/ ){
497 return 1; # user is online
501 return 0; # user is offline
506 # Check an Ascend Max4000 or similar model via SNMP
508 # Author: Blaz Zupan of Medinet <blaz@amis.net>
510 $asm = '.iso.org.dod.internet.private.enterprises.529';
519 # If it looks like hex, only try it as hex,
520 # otherwise try it as both decimal and hex.
523 if ($sess_id !~ /^0/ && $sess_id !~ /[a-f]/i) {
524 $l1 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
527 $sess_id = hex $ARGV[4];
528 $l2 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
531 print LOG " user at port S$ARGV[2]: $l1 (dec)\n" if ($debug && $l1);
532 print LOG " user at port S$ARGV[2]: $l2 (hex)\n" if ($debug && $l2);
534 (($l1 && $l1 eq $ARGV[3]) || ($l2 && $l2 eq $ARGV[3])) ? 1 : 0;
539 # See if the user is logged in using the portslave finger.
541 sub portslave_finger {
546 open(FD, "$finger \@$ARGV[1]|");
549 # Check for ^Port. If we don't see it we
550 # wont get confused by non-portslave-finger
557 next if (!$Port_seen);
560 ($port, $user) = /^.(...) (...............)/;
564 $ulen = length($user);
566 # HACK: strip [PSC] from the front of the username,
567 # and things like .ppp from the end.
570 $user =~ s/\.(ppp|slip|cslip)$//;
573 # HACK: because ut_user usually has max. 8 characters
574 # we only compare up the the length of $user if the
575 # unstripped name had 8 chars.
577 $argv_user = $ARGV[3];
579 $ulen = length($user);
580 $argv_user = substr($ARGV[3], 0, $ulen);
583 if ($port == $ARGV[2]) {
584 if ($user eq $argv_user) {
585 print LOG " $user matches $argv_user " .
586 "on port $port" if ($debug);
590 print LOG " $user doesn't match $argv_user " .
591 "on port $port" if ($debug);
602 # See if the user is already logged-in at the 3Com/USR Total Control.
603 # (this routine by Alexis C. Villalon <alexisv@compass.com.ph>).
604 # You must have the Net::Telnet module from CPAN for this to work.
605 # You must also have your /etc/raddb/naspasswd made up.
609 # Localize all variables first.
611 my ($Port_seen, $ts, $terminalserver, $log, $login, $pass, $password);
612 my ($telnet, $curprompt, $curline, $ok, $totlines, $ccntr);
613 my (@curlines, @cltok, $user, $port, $ulen);
615 return 2 unless (check_net_telnet());
617 $terminalserver = $ARGV[1];
620 # Get login name and password for a certain NAS from $naspass.
622 ($login, $password) = naspasswd($terminalserver, 1);
623 return 2 if ($password eq "");
626 # Communicate with NAS using Net::Telnet, then issue
627 # the command "show sessions" to see who are logged in.
628 # Thanks to Chris Jackson <chrisj@tidewater.net> for the
629 # for the "-- Press Return for More --" workaround.
631 $telnet = new Net::Telnet (Timeout => 5,
633 $telnet->open($terminalserver);
634 $telnet->login($login, $password);
635 $telnet->print("show sessions");
636 while ($curprompt ne "\>") {
637 ($curline, $curprompt) = $telnet->waitfor
638 (String => "-- Press Return for More --",
641 $ok = $telnet->print("");
642 push @curlines, split(/^/m, $curline);
646 # Telnet closed. We got the info. Let's examine it.
648 $totlines = @curlines;
650 while($ccntr < $totlines) {
654 if ($curlines[$ccntr] =~ /^Port/) {
660 # Ignore all unnecessary lines.
662 if (!$Port_seen || $curlines[$ccntr] =~ /^---/ ||
663 $curlines[$ccntr] =~ /^ .*$/) {
668 # Parse the current line for the port# and username.
670 @cltok = split(/\s+/, $curlines[$ccntr]);
674 $ulen = length($user);
676 # HACK: strip [PSC] from the front of the username,
677 # and things like .ppp from the end. Strip S from
678 # the front of the port number.
681 $user =~ s/\.(ppp|slip|cslip)$//;
684 # HACK: because "show sessions" shows max. 15 characters
685 # we only compare up to the length of $user if the
686 # unstripped name had 15 chars.
688 $argv_user = $ARGV[3];
690 $ulen = length($user);
691 $argv_user = substr($ARGV[3], 0, $ulen);
693 if ($port == $ARGV[2]) {
694 if ($user eq $argv_user) {
695 print LOG " $user matches $argv_user " .
696 "on port $port" if ($debug);
699 print LOG " $user doesn't match $argv_user " .
700 "on port $port" if ($debug);
709 # Check a Cyclades PathRAS via telnet
713 # Author: Antonio Dias of SST Internet <accdias@sst.com.br>
715 sub cyclades_telnet {
717 # Localize all variables first.
719 my ($pr, $pr_login, $pr_passwd, $pr_prompt, $endlist, @list, $port, $user);
721 # This variable must match PathRAS' command prompt
722 # string as entered in menu option 6.2.
723 # The value below matches the default command prompt.
725 $pr_prompt = '/Select option ==\>$/i';
728 # This variable match the end of userslist.
730 $endlist = '/Type \<enter\>/i';
733 # Do we have Net::Telnet installed?
735 return 2 unless (check_net_telnet());
738 # Get login name and password for NAS
739 # from $naspass file.
741 ($pr_login, $pr_passwd) = naspasswd($ARGV[1], 1);
744 # Communicate with PathRAS using Net::Telnet, then access
745 # menu option 6.8 to see who are logged in.
746 # Based on PathRAS firmware version 1.2.3
748 $pr = new Net::Telnet (
755 # Force PathRAS shows its banner.
762 if ($pr->waitfor(Match => '/login : $/i') == 1) {
763 $pr->print($pr_login);
765 print LOG " Error: sending login name to PathRAS\n" if ($debug);
770 if ($pr->waitfor(Match => '/password : $/i') == 1) {
771 $pr->print($pr_passwd);
773 print LOG " Error: sending password to PathRAS.\n" if ($debug);
781 # Access menu option 6 "PathRAS Management"
783 if ($pr->waitfor(Match => $pr_prompt) == 1) {
786 print LOG " Error: acessing menu option '6'.\n" if ($debug);
791 # Access menu option 8 "Show Active Ports"
793 if ($pr->waitfor(Match => $pr_prompt) == 1) {
794 @list = $pr->cmd(String => '8', Prompt => $endlist);
796 print LOG " Error: acessing menu option '8'.\n" if ($debug);
801 # Since we got the info we want, let's close
807 # Lets examine the userlist stored in @list
811 # We are interested in active sessions only
814 ($port, $user) = split;
816 # Strip out any prefix, suffix and
817 # realm from $user check to see if
820 if(strip_username($ARGV[3]) eq strip_username($user)) {
821 print LOG " User '$ARGV[3]' found on '$ARGV[1]:$port'.\n" if ($debug);
826 print LOG " User '$ARGV[3]' not found on '$ARGV[1]'.\n" if ($debug);
831 # Check a Patton 2800 via SNMP
835 # Author: Antonio Dias of SST Internet <accdias@sst.com.br>
840 #$oid = '.1.3.6.1.4.1.1768.5.100.1.40.' . hex $ARGV[4];
841 # Reported by "Andria Legon" <andria@patton.com>
842 # The OID below should be the correct one instead of the one above.
843 $oid = '.1.3.6.1.4.1.1768.5.100.1.56.' . hex $ARGV[4];
845 # Check if the session still active
847 if (snmpget($ARGV[1], "monitor", "$oid") == 0) {
848 print LOG " Session $ARGV[4] still active on NAS " .
849 "$ARGV[1], port $ARGV[2], for user $ARGV[3].\n" if ($debug);
856 # Check a Digitro BXS via rusers
860 # Author: Antonio Dias of SST Internet <accdias@sst.com.br>
866 if (-e $rusers && -x $rusers) {
868 # Get a list of users logged in via rusers
870 $_ = `$rusers $ARGV[1]`;
871 $ret = ((/$ARGV[3]/) ? 1 : 0);
873 print LOG " Error: can't execute $rusers\n" if $debug;
880 # Check Cyclades PR3000 and PR4000 via SNMP
884 # Author: Antonio Dias of SST Internet <accdias@sst.com.br>
890 $oid = ".1.3.6.1.4.1.2925.3.3.6.1.1.2";
892 $_ = snmpwalk($ARGV[1],"$cmmty_string",$oid);
893 $ret = ((/$ARGV[3]/) ? 1 : 0);
898 # 3Com/USR HiPer Arc Total Control.
899 # This works with HiPer Arc 4.0.30
900 # (this routine by Igor Brezac <igor@ipass.net>)
903 # This routine modified by Dan Halverson <danh@tbc.net>
904 # to suport additional versions of Hiper Arc
907 $usrm = '.iso.org.dod.internet.private.enterprises.429';
909 my ($login,$password,$oidext);
911 # Look up community string in naspasswd file.
912 ($login, $password) = naspasswd($ARGV[1], 1);
913 if ($login && $login ne 'SNMP') {
916 " Error: Need SNMP community string for $ARGV[1]\n";
920 # If password is defined in naspasswd file, use it as community, otherwise use $cmmty_string
921 if ($password eq '') {
922 $password = "$cmmty_string";
925 my ($ver) = get_hiper_ver(usrm=>$usrm, target=>$ARGV[1], community=>$password);
926 $oidext = get_oidext(ver=>$ver, tty=>$ARGV[2]);
929 $login = snmpget($ARGV[1], $password, "$usrm.4.10.1.1.18.$oidext");
930 if ($login =~ /\"/) {
931 $login =~ /^.*\"([^"]+)\"/;
935 print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
937 ($login eq $ARGV[3]) ? 1 : 0;
941 # get_hiper_ver and get_oidext by Dan Halverson <danh@tbc.net>
947 $ver = snmpget ($args{'target'}, $args{'community'}, $args{'usrm'}.".4.1.14.0");
952 # Add additional OID checks below before the else.
959 if ($args{'ver'} =~ /V5.1.99/) {
960 $oid = $args{'tty'}+1257-1;
963 $oid = 1257 + 256*int(($args{'tty'}-1) / $hiper_density) +
964 (($args{'tty'}-1) % $hiper_density);
970 # Check USR Netserver with Telnet - based on tc_tccheck.
971 # By "Marti" <mts@interplanet.es>
975 # Localize all variables first.
977 my ($ts, $terminalserver, $login, $password);
978 my ($telnet, $curprompt, $curline, $ok);
979 my (@curlines, $user, $port);
981 return 2 unless (check_net_telnet());
983 $terminalserver = $ARGV[1];
986 # Get login name and password for a certain NAS from $naspass.
988 ($login, $password) = naspasswd($terminalserver, 1);
989 return 2 if ($password eq "");
992 # Communicate with Netserver using Net::Telnet, then access
993 # list connectionsto see who are logged in.
995 $telnet = new Net::Telnet (Timeout => 5,
997 $telnet->open($terminalserver);
1002 $telnet->login($login, $password);
1005 # Launch list connections command
1007 $telnet->print("list connections");
1009 while ($curprompt ne "\>") {
1010 ($curline, $curprompt) = $telnet->waitfor
1013 $ok = $telnet->print("");
1014 push @curlines, split(/^/m, $curline);
1019 # Telnet closed. We got the info. Let's examine it.
1021 foreach(@curlines) {
1023 ($port, $user, $dummy) = split;
1025 # Strip out any prefixes and suffixes
1028 # uncomment this if you use the standard
1030 #$user =~ s/^[PSC]//;
1031 #$user =~ s/\.(ppp|slip|cslip)$//;
1033 # Check to see if $user is already connected
1035 if ($user eq $ARGV[3]) {
1036 print LOG " $user matches $ARGV[3] " .
1037 "on port $port" if ($debug);
1043 " $ARGV[3] not found on Netserver logged users list " if ($debug);
1048 # Versanet's Perl Script Support:
1050 # ___ versanet_snmp 1.0 by support@versanetcomm.com ___ July 1999
1051 # Versanet Enterprise MIB Base: 1.3.6.1.4.1.2180
1053 # VN2001/2002 use slot/port number to locate modems. To use snmp get we
1054 # have to translate the original port number into a slot/port pair.
1056 $vsm = '.iso.org.dod.internet.private.enterprises.2180';
1059 print LOG "argv[2] = $ARGV[2] " if ($debug);
1061 $port = 8 if ($port eq 0);
1062 print LOG "port = $port " if ($debug);
1063 $slot = (($ARGV[2]-$port)/8)+1;
1064 print LOG "slot = $slot" if ($debug);
1065 $loginname = snmpget($ARGV[1], "$cmmty_string", "$vsm.27.1.1.3.$slot.$port");
1067 # Note: the "$cmmty_string" string above could be replaced by the public
1068 # community string defined in Versanet VN2001/VN2002.
1070 print LOG " user at slot $slot port $port: $loginname\n" if ($debug); ($loginname eq $ARGV[3]) ? 1 : 0;
1074 # 1999/08/24 Chris Shenton <chris@shenton.org>
1075 # Check Bay8000 NAS (aka: Annex) using finger.
1076 # Returns from "finger @bay" like:
1077 # Port What User Location When Idle Address
1078 # asy2 PPP bill --- 9:33am :08 192.168.1.194
1079 # asy4 PPP hillary --- 9:36am :04 192.168.1.195
1081 # But also returns partial-match users if you say like "finger g@bay":
1082 # Port What User Location When Idle Address
1083 # asy2 PPP gore --- 9:33am :09 192.168.1.194
1084 # asy22 PPP gwbush --- Mon 9:19am :07 192.168.1.80
1085 # So check exact match of username!
1087 sub bay_finger { # ARGV: 1=nas_ip, 2=nas_port, 3=login, 4=sessid
1088 open(FINGER, "$finger $ARGV[3]\@$ARGV[1]|") || return 2; # error
1090 my ($Asy, $PPP, $User) = split;
1091 if( $User =~ /^$ARGV[3]$/ ){
1093 print LOG "checkrad:bay_finger: ONLINE $ARGV[3]\@$ARGV[1]"
1099 print LOG "checkrad:bay_finger: offline $ARGV[3]\@$ARGV[1]" if ($debug);
1104 # Cisco L2TP support
1105 # This is for PPP sessions coming from an L2TP tunnel from a Dial
1106 # or DSL wholesale provider
1107 # Paul Khavkine <paul@distributel.net>
1110 # find_l2tp_login() walks a part of cisco vpdn tree to find out what session
1111 # and tunnel ID's are for a given Virtual-Access interface to construct
1112 # the following OID: .1.3.6.1.4.1.9.10.24.1.3.2.1.2.2.$tunID.$sessID
1113 # Then gets the username from that OID.
1114 # Make sure you set the $realm variable at the begining of the file if
1115 # needed. The new type for naslist is cisco_l2tp
1119 my($host, $community, $port_num) = @_;
1120 my $l2tp_oid = '.1.3.6.1.4.1.9.10.24.1.3.2.1.2.2';
1121 my $port_oid = '.iso.org.dod.internet.private.enterprises.9.10.51.1.2.1.1.2.2';
1122 my $port = 'Vi' . $port_num;
1124 my $sess = new SNMP::Session(DestHost => $host, Community => $community);
1125 my $snmp_var = new SNMP::Varbind(["$port_oid"]);
1126 my $val = $sess->getnext($snmp_var);
1130 $sess->getnext($snmp_var);
1131 } until ($snmp_var->[$SNMP::Varbind::val_f] =~ /$port/) ||
1132 (!($snmp_var->[$SNMP::Varbind::ref_f] =~ /^$port_oid\.(\d+)\.(\d+)$/)) ||
1133 ($sess->{ErrorNum});
1135 my $val1 = $snmp_var->[$SNMP::Varbind::ref_f];
1137 if ($val1 =~ /^$port_oid/) {
1138 $result = substr($val1, length($port_oid));
1139 $result =~ /^\.(\d+)\.(\d+)$/;
1144 my $snmp_var1 = new SNMP::Varbind(["$l2tp_oid\.$tunID\.$sessID"]);
1145 $val = $sess->get($snmp_var1);
1146 my $login = $snmp_var1->[$SNMP::Varbind::val_f];
1153 my $login = find_l2tp_login("$ARGV[1]", $cmmty_string, "$ARGV[2]");
1154 print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
1155 ($login eq "$ARGV[3]\@$realm") ? 1 : 0;
1161 # MikroTik only supports version 1
1162 $snmp_version = "1";
1164 # Look up community string in naspasswd file.
1165 ($login, $password) = naspasswd($ARGV[1], 1);
1166 if ($login && $login ne 'SNMP') {
1168 print LOG "Error: Need SNMP community string for $ARGV[1]\n";
1172 # If password is defined in naspasswd file, use it as community,
1173 # otherwise use $cmmty_string
1174 if ($password eq '') {
1175 $password = "$cmmty_string";
1179 # We want interface descriptions
1182 # Mikrotik doesnt give port IDs correctly to RADIUS :(
1183 # practically this would limit us to a simple only-one user limit for
1184 # this script to work properly.
1185 @output = snmpwalk_prog($ARGV[1], $password, "$oid");
1187 foreach $line ( @output ) {
1190 #remove trailing whitespace
1191 ($line = $line) =~ s/\s+$//;
1192 if( $line =~ /<.*-$ARGV[3]>/ ) {
1197 #lets return something
1198 if ($username_seen > 0) {
1205 sub mikrotik_telnet {
1206 # Localize all variables first.
1207 my ($t, $login, $password);
1208 my (@fields, @output, $output, $username_seen, $user);
1210 return 2 unless (check_net_telnet());
1212 $terminalserver = $ARGV[1];
1215 # Get login name and password for a certain NAS from $naspass.
1216 ($login, $password) = naspasswd($terminalserver, 1);
1217 return 2 if ($password eq "");
1219 # MikroTik routeros doesnt tell us to which port the user is connected
1220 # practically this would limit us to a simple only-one user limit for
1221 # this script to work properly.
1222 $t = new Net::Telnet (Timeout => 5,
1223 Prompt => '//\[.*@.*\] > /');
1225 # Dont just exit when there is error
1226 $t->errmode('return');
1228 # Telnet to terminal server
1229 $t->open($terminalserver) or return 2;
1231 #Send login and password etc.
1232 $t->login(Name => $login,
1233 Password => $password,
1234 # We must detect if we are logged in from the login banner.
1235 # Because if routeros is with a free license the command
1236 # prompt dont come. Instead it waits us to press "Enter".
1237 Prompt => '/MikroTik/');
1239 # Just be sure that routeros isn't waiting for us to press "Enter"
1242 # Wait for the real prompt
1243 $t->waitfor('/\[.*@.*\] > /');
1245 # It is not possible to get the line numbers etc.
1246 # Thus we cant support if simultaneus-use is over 1
1247 # At least I was using pppoe so it wasnt possible.
1248 $t->print('ppp active print column name detail');
1250 # Somehow routeros echo'es our commands 2 times. We dont want to mix
1251 # this with the real command prompt.
1252 $t->waitfor('/\[.*@.*\] > ppp active print column name detail/');
1254 # Now lets get the list of online ppp users.
1255 ( $output ) = $t->waitfor('/\[.*@.*\] > /');
1257 # For debugging we can print the list to stdout
1260 #Lets logout to make everybody happy.
1261 #If we close the connection without logging out then routeros
1262 #starts to complain after a while. Saying;
1263 #telnetd: All network ports in use.
1267 #check for # of $user in output
1268 #the output includes only one = between name and username so we can
1269 #safely use it as a seperator.
1271 #disabled until mikrotik starts to send newline after each line...
1272 # @output = $output;
1273 # foreach $line ( @output ) {
1276 # #remove trailing whitespace
1277 # ($line = $line) =~ s/\s+$//;
1278 # if( $line =~ /name=/ ) {
1280 # @fields = split( /=/, $line );
1281 # if( $fields[1] == "\"$user\"") {
1287 if( $output =~ /name="$user"/ ) {
1291 #lets return something
1292 if ($username_seen > 0) {
1299 sub redback_telnet {
1300 #Localize all variables first.
1301 my ($terminalserver, $login, $password);
1302 my ($user, $context, $operprompt, $adminprompt, $t);
1303 return 2 unless (check_net_telnet());
1304 $terminalserver = $ARGV[1];
1305 ($user, $context) = split /@/, $ARGV[3];
1307 print LOG " Error: No user defined\n" if ($debug);
1311 print LOG " Error: No context defined\n" if ($debug);
1315 # Get loggin information
1316 ($root, $password) = naspasswd($terminalserver, 1);
1317 return 2 if ($password eq "");
1319 $operprompt = '/\[.*\].*>$/';
1320 $adminprompt = '/\[.*\].*#$/';
1322 # Logging to the RedBack NAS
1323 $t = new Net::Telnet (Timeout => 5, Prompt => $operprompt);
1324 $t->input_log("./debug");
1325 $t->open($terminalserver);
1326 $t->login($root, $password);
1330 $t->waitfor('/Password/');
1331 $t->print($password);
1332 $t->waitfor($adminprompt);
1333 $t->prompt($adminprompt);
1336 $t->cmd(String => "context $context");
1339 @lines = $t->cmd(String => "show subscribers active $user\@$context");
1340 if ($lines[0] =~ /subscriber $user\@$context/ ) {
1346 ###############################################################################
1348 # Poor man's getopt (for -d)
1349 if ($ARGV[0] eq '-d') {
1355 if ($debug eq 'stdout') {
1356 open(LOG, ">&STDOUT");
1357 } elsif ($debug eq 'stderr') {
1358 open(LOG, ">&STDERR");
1360 open(LOG, ">>$debug");
1362 print LOG "$now checkrad @ARGV\n";
1367 print LOG "Usage: checkrad nas_type nas_ip " .
1368 "nas_port login session_id\n" if ($debug);
1369 print STDERR "Usage: checkrad nas_type nas_ip " .
1370 "nas_port login session_id\n"
1371 unless ($debug =~ m/^(stdout|stderr)$/);
1372 close LOG if ($debug);
1376 if ($ARGV[0] eq 'livingston') {
1377 $ret = &livingston_snmp;
1378 } elsif ($ARGV[0] eq 'cisco') {
1380 } elsif ($ARGV[0] eq 'cvx') {
1382 } elsif ($ARGV[0] eq 'multitech') {
1383 $ret = &multitech_snmp;
1384 } elsif ($ARGV[0] eq 'computone') {
1385 $ret = &computone_finger;
1386 } elsif ($ARGV[0] eq 'max40xx') {
1387 $ret = &max40xx_finger;
1388 } elsif ($ARGV[0] eq 'ascend' || $ARGV[0] eq 'max40xx_snmp') {
1389 $ret = &ascend_snmp;
1390 } elsif ($ARGV[0] eq 'portslave') {
1391 $ret = &portslave_finger;
1392 } elsif ($ARGV[0] eq 'tc') {
1394 } elsif ($ARGV[0] eq 'pathras') {
1395 $ret = &cyclades_telnet;
1396 } elsif ($ARGV[0] eq 'pr3000') {
1397 $ret = &cyclades_snmp;
1398 } elsif ($ARGV[0] eq 'pr4000') {
1399 $ret = &cyclades_snmp;
1400 } elsif ($ARGV[0] eq 'patton') {
1401 $ret = &patton_snmp;
1402 } elsif ($ARGV[0] eq 'digitro') {
1403 $ret = &digitro_rusers;
1404 } elsif ($ARGV[0] eq 'usrhiper') {
1405 $ret = &usrhiper_snmp;
1406 } elsif ($ARGV[0] eq 'netserver') {
1407 $ret = &usrnet_telnet;
1408 } elsif ($ARGV[0] eq 'versanet') {
1409 $ret = &versanet_snmp;
1410 } elsif ($ARGV[0] eq 'bay') {
1412 } elsif ($ARGV[0] eq 'cisco_l2tp'){
1413 $ret = &cisco_l2tp_snmp;
1414 } elsif ($ARGV[0] eq 'mikrotik'){
1415 $ret = &mikrotik_telnet;
1416 } elsif ($ARGV[0] eq 'mikrotik_snmp'){
1417 $ret = &mikrotik_snmp;
1418 } elsif ($ARGV[0] eq 'redback'){
1419 $ret = &redback_telnet;
1420 } elsif ($ARGV[0] eq 'other') {
1423 print LOG " checkrad: unknown NAS type $ARGV[0]\n" if ($debug);
1424 print STDERR "checkrad: unknown NAS type $ARGV[0]\n";
1430 $mn = "double detected" if ($ret == 1);
1431 $mn = "error detected" if ($ret == 2);
1432 print LOG " Returning $ret ($mn)\n";