src/main/checkrad.pl.in

   1 #!@PERL@
   2 #
   3 # checkrad.pl   See if a user is (still) logged in on a certain port.
   4 #
   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.
   8 #
   9 # Called as:    nas_type nas_ip nas_port login session_id
  10 #
  11 # Returns:      0 = no duplicate, 1 = duplicate, >1 = error.
  12 #
  13 # Version:      $Id$
  14 #
  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
  35 #
  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
  44 #
  45
  46 $prefix         = "@prefix@";
  47 $localstatedir  = "@localstatedir@";
  48 $logdir         = "@logdir@";
  49 $sysconfdir     = "@sysconfdir@";
  50 $raddbdir       = "@raddbdir@";
  51
  52 $debug          = "";
  53 #$debug         = "$logdir/checkrad.log";
  54
  55 $snmpget        = "@SNMPGET@";
  56 $snmpwalk       = "@SNMPWALK@";
  57 $snmp_timeout   = 5;
  58 $snmp_retries   = 1;
  59 $snmp_version   = "2c";
  60 $rusers         = "@RUSERS@";
  61 $naspass        = "$raddbdir/naspasswd";
  62
  63 # Community string. Change this if yours isn't "public".
  64 $cmmty_string   = "public";
  65 # path to finger command
  66 $finger = "/usr/bin/finger";
  67
  68 #
  69 #       USR-Hiper: $hiper_density is the reported port density (default 256
  70 #       but 24 makes more sense)
  71 #
  72 $hiper_density = 256;
  73
  74 #
  75 #       Try to load Net::Telnet, SNMP_Session etc.
  76 #       Do not complain if we cannot find it.
  77 #       Prefer a locally installed copy.
  78 #
  79 BEGIN {
  80         unshift @INC, "/usr/local/lib/site_perl";
  81
  82         eval "use Net::Telnet 3.00;";
  83         $::HAVE_NET_TELNET = ($@ eq "");
  84
  85         eval "use SNMP_Session;";
  86         if ($@ eq "") {
  87                 eval "use BER;";
  88                 $::HAVE_SNMP_SESSION = ($@ eq "");
  89                 eval "use Socket;";
  90         }
  91 };
  92
  93 #
  94 #       Get password from /etc/raddb/naspasswd file.
  95 #       Returns (login, password).
  96 #
  97 sub naspasswd {
  98         my ($terminalserver, $emptyok) = @_;
  99         my ($login, $password);
 100         my ($ts, $log, $pass);
 101
 102         unless (open(NFD, $naspass)) {
 103                 if (!$emptyok) {
 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";
 108                 }
 109                 return ();
 110         }
 111         while (<NFD>) {
 112                 chop;
 113                 next if (m/^(#|$|[\t ]+$)/);
 114                 ($ts, $log, $pass) = split(/\s+/, $_, 3);
 115                 if ($ts eq $terminalserver) {
 116                         $login = $log;
 117                         $password = $pass;
 118                         last;
 119                 }
 120         }
 121         close NFD;
 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";
 128         }
 129         ($login, $password);
 130 }
 131
 132 #
 133 #       See if Net::Telnet is there.
 134 #
 135 sub check_net_telnet {
 136         if (!$::HAVE_NET_TELNET) {
 137                 print LOG
 138                 "  checkrad: Net::Telnet 3.00+ CPAN module not installed\n"
 139                 if ($debug);
 140                 print STDERR
 141                 "checkrad: Net::Telnet 3.00+ CPAN module not installed\n";
 142                 return 0;
 143         }
 144         1;
 145 }
 146
 147 #
 148 #       Do snmpwalk by calling snmpwalk.
 149 #
 150 sub snmpwalk_prog {
 151         my ($host, $community, $oid) = @_;
 152         local $_;
 153
 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`;
 156
 157         return $_;
 158 }
 159
 160 #
 161 #       Do snmpwalk.
 162 #
 163 sub snmpwalk {
 164         my $ret;
 165
 166         if (-x $snmpwalk) {
 167                 $ret = snmpwalk_prog(@_);
 168         } else {
 169                 $e = "$snmpwalk not found!";
 170                 print LOG "$e\n" if ($debug);
 171                 print STDERR "checkrad: $e\n";
 172                 $ret = "";
 173         }
 174         $ret;
 175 }
 176
 177
 178 #
 179 #       Do snmpget by calling snmpget.
 180 #
 181 sub snmpget_prog {
 182         my ($host, $community, $oid) = @_;
 183         my ($ret);
 184         local $_;
 185
 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|\"|$).*$/) {
 189                 # Session ID format.
 190                 $ret = $2;
 191         } elsif (/^.*=.*"(.*)"/) {
 192                 # oid = "...." junk format.
 193                 $ret = $1;
 194         } elsif (/^.*=\s*(\S+)/) {
 195                 # oid = string format
 196                 $ret = $1;
 197         }
 198
 199         # Strip trailing junk if any.
 200         $ret =~ s/\s*Hex:.*$//;
 201         $ret;
 202 }
 203
 204 #
 205 #       Do snmpget by using SNMP_Session.
 206 #       Coded by Jerry Workman <jerry@newwave.net>
 207 #
 208 sub snmpget_session {
 209         my ($host, $community, $OID) = @_;
 210         my ($ret);
 211         local $_;
 212         my (@enoid, $var,$response, $bindings, $binding, $value);
 213         my ($inoid, $outoid, $upoid, $oid, @retvals);
 214
 215         $OID =~ s/^.iso.org.dod.internet.private.enterprises/.1.3.6.1.4.1/;
 216
 217         push @enoid,  encode_oid((split /\./, $OID));
 218         srand();
 219
 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";
 225                 return "";
 226         }
 227         $response = $session->pdu_buffer;
 228         ($bindings) = $session->decode_get_response ($response);
 229         $session->close ();
 230         while ($bindings) {
 231                 ($binding,$bindings) = decode_sequence ($bindings);
 232                 ($oid,$value) = decode_by_template ($binding, "%O%@");
 233                 my $tempo = pretty_print($value);
 234                 $tempo=~s/\t/ /g;
 235                 $tempo=~s/\n/ /g;
 236                 $tempo=~s/^\s+//;
 237                 $tempo=~s/\s+$//;
 238
 239                 push @retvals, $tempo;
 240         }
 241         $retvals[0];
 242 }
 243
 244 #
 245 #       Do snmpget
 246 #
 247 sub snmpget {
 248         my $ret;
 249
 250         if ($::HAVE_SNMP_SESSION) {
 251                 $ret = snmpget_session(@_);
 252         } elsif (-x $snmpget) {
 253                 $ret = snmpget_prog(@_);
 254         } else {
 255                 $e = "Neither SNMP_Session module or $snmpget found!";
 256                 print LOG "$e\n" if ($debug);
 257                 print STDERR "checkrad: $e\n";
 258                 $ret = "";
 259         }
 260         $ret;
 261 }
 262
 263 #
 264 #       Strip domains, prefixes and suffixes from username
 265 #
 266 #       Known prefixes: (P)PP, (S)LIP e (C)SLIP
 267 #       Known suffixes: .ppp, .slip e .cslip
 268 #
 269 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 270 #
 271 sub strip_username {
 272         my ($user) = @_;
 273         #
 274         #       Trim white spaces.
 275         #
 276         $user =~ s/^\s*(.*?)\s*$/$1/;
 277         #
 278         #       Strip out domains, prefix and suffixes
 279         #
 280         $user =~ s/\@(.)*$//;
 281         $user =~ s/^[PSC]//;
 282         $user =~ s/\.(ppp|slip|cslip)$//;
 283         $user;
 284 }
 285
 286 #
 287 #       See if the user is logged in using the Livingston MIB.
 288 #       We don't check the username but the session ID.
 289 #
 290 $lvm     = '.iso.org.dod.internet.private.enterprises.307';
 291 sub livingston_snmp {
 292
 293         #
 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.
 297         #
 298         #       If the port < S23, probe ifIndex 5.
 299         #       If the port < S30, probe IfIndex 23.
 300         #       Otherwise probe ifIndex 32.
 301         #
 302         my $ifIndex;
 303         my $test_index;
 304         if ($ARGV[2] < 23) {
 305                 $test_index = 5;
 306         } elsif ($ARGV[2] < 30) {
 307                 $test_index = 23;
 308         } else {
 309                 $test_index = 32;
 310         }
 311         $_ = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.2.$test_index");
 312         /S([0-9]+)/;
 313         $xport = $1 + 0;
 314         $ifIndex = $ARGV[2] + ($test_index - $xport);
 315
 316         print LOG "  port S$ARGV[2] at SNMP ifIndex $ifIndex\n"
 317                 if ($debug);
 318
 319         #
 320         #       Now get the session id from the terminal server.
 321         #
 322         $sessid = snmpget($ARGV[1], "$cmmty_string", "$lvm.3.2.1.1.1.5.$ifIndex");
 323
 324         print LOG "  session id at port S$ARGV[2]: $sessid\n" if ($debug);
 325
 326         ($sessid eq $ARGV[4]) ? 1 : 0;
 327 }
 328
 329 #
 330 #       See if the user is logged in using the Aptis MIB.
 331 #       We don't check the username but the session ID.
 332 #
 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';
 337 sub cvx_snmp {
 338
 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];
 342         $sessid =~ s/^.*://;
 343         $sessid =~ s/^0*//;
 344         $sessid = "0" if ($sessid eq '');
 345
 346         #
 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.
 352         #
 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);
 356
 357         print LOG "  login with session-id $ARGV[4]: $login\n" if ($debug);
 358
 359         (strip_username($login) eq strip_username($ARGV[3])) ? 1 : 0;
 360 }
 361
 362 #
 363 #       See if the user is logged in using the Cisco MIB
 364 #
 365 $csm     = '.iso.org.dod.internet.private.enterprises.9';
 366 sub cisco_snmp {
 367
 368         # Look up community string in naspasswd file.
 369         my ($login, $pass) = naspasswd($ARGV[1], 1);
 370         if ($login eq '') {
 371                 $pass = $cmmty_string;
 372         } elsif ($login ne 'SNMP') {
 373                 if ($debug) {
 374                         print LOG
 375                         "   Error: Need SNMP community string for $ARGV[1]\n";
 376                 }
 377                 return 2;
 378         }
 379
 380         my $port = $ARGV[2];
 381         my $sess_id = hex($ARGV[4]);
 382
 383         if ($port < 20000) {
 384                 #
 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.
 390                 #
 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);
 393         } else {
 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);
 398         }
 399
 400         #       ($login eq $ARGV[3]) ? 1 : 0;
 401         if($login eq $ARGV[3]) {
 402                 return 1;
 403         }else{
 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]\"/){
 406                         return 1;
 407                 }else{
 408                         return 0;
 409                 }
 410         }
 411 }
 412
 413 #
 414 #       Check a MultiTech CommPlete Server ( CC9600 & CC2400 )
 415 #
 416 #       Author: Eric Honzay of Bennett Office Products <ehonzay@willmar.com>
 417 #
 418 $msm    = '.iso.org.dod.internet.private.enterprises.995';
 419 sub multitech_snmp {
 420         my $temp = $ARGV[2] + 1;
 421
 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);
 424
 425         ($login eq $ARGV[3]) ? 1 : 0;
 426 }
 427
 428 #
 429 #       Check a Computone Powerrack via finger
 430 #
 431 #       Old Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
 432 #       New Author: Alan Curry <pacman@world.std.com>
 433 #
 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.
 438 #
 439 # 1.7.2 and 3.0.4 both look like this:
 440 #
 441 # 0    0 000 00:56 luser         pppfsm  Incoming PPP, ppp00, 10.0.0.1
 442 #
 443 # and the truncated ones look like this:
 444 #
 445 # 25   0 000 00:15 longnameluse..pppfsm  Incoming PPP, ppp25, 10.0.0.26
 446 #
 447 # Yes, the fields run together. Long Usernames Considered Harmful.
 448 #
 449 sub computone_finger {
 450         my $trunc, $ver;
 451
 452         open(FD, "$finger \@$ARGV[1]|") or return 2;
 453         <FD>; # the [hostname] line is definitely uninteresting
 454         $trunc = substr($ARGV[3], 0, 12);
 455         $ver = "";
 456         while(<FD>) {
 457                 if(/cnx kernel release ([^ ,]+)[, ]/) {
 458                         $ver = $1;
 459                         next;
 460                 }
 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+|\.\.)/) {
 464                                 close FD;
 465                                 return 1;
 466                         }
 467                         next;
 468                 }
 469                 # All others.
 470                 if (/^\s*\Q$ARGV[2]\E\s+.*\s+\Q$trunc\E\s+/) {
 471                         close FD;
 472                         return 1;
 473                 }
 474         }
 475
 476         close FD;
 477         return 0;
 478 }
 479
 480 #
 481 #       Check an Ascend Max4000 or similar model via finger
 482 #
 483 #       Note: Not all software revisions support finger
 484 #             You may also need to enable the finger option.
 485 #
 486 #       Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
 487 #
 488 sub max40xx_finger {
 489         open(FD, "$finger $ARGV[3]\@$ARGV[1]|");
 490         while(<FD>) {
 491            $line = $_;
 492            if( $line =~ /Session/ ){
 493                 next;
 494            }
 495
 496            if( $line =~ /$ARGV[4]/ ){
 497               return 1; # user is online
 498            }
 499         }
 500         close FD;
 501         return 0; # user is offline
 502 }
 503
 504
 505 #
 506 #       Check an Ascend Max4000 or similar model via SNMP
 507 #
 508 #       Author: Blaz Zupan of Medinet <blaz@amis.net>
 509 #
 510 $asm   = '.iso.org.dod.internet.private.enterprises.529';
 511 sub ascend_snmp {
 512         my $sess_id;
 513         my $l1, $l2;
 514
 515         $l1 = '';
 516         $l2 = '';
 517
 518         #
 519         #       If it looks like hex, only try it as hex,
 520         #       otherwise try it as both decimal and hex.
 521         #
 522         $sess_id = $ARGV[4];
 523         if ($sess_id !~ /^0/ && $sess_id !~ /[a-f]/i) {
 524                 $l1 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
 525         }
 526         if (!$l1){
 527                 $sess_id = hex $ARGV[4];
 528                 $l2 = snmpget($ARGV[1], "$cmmty_string", "$asm.12.3.1.4.$sess_id");
 529         }
 530
 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);
 533
 534         (($l1 && $l1 eq $ARGV[3]) || ($l2 && $l2 eq $ARGV[3])) ? 1 : 0;
 535 }
 536
 537
 538 #
 539 #       See if the user is logged in using the portslave finger.
 540 #
 541 sub portslave_finger {
 542         my ($Port_seen);
 543
 544         $Port_seen = 0;
 545
 546         open(FD, "$finger \@$ARGV[1]|");
 547         while(<FD>) {
 548                 #
 549                 #       Check for ^Port. If we don't see it we
 550                 #       wont get confused by non-portslave-finger
 551                 #       output too.
 552                 #
 553                 if (/^Port/) {
 554                         $Port_seen++;
 555                         next;
 556                 }
 557                 next if (!$Port_seen);
 558                 next if (/^---/);
 559
 560                 ($port, $user) = /^.(...) (...............)/;
 561
 562                 $port =~ s/ .*//;
 563                 $user =~ s/ .*//;
 564                 $ulen = length($user);
 565                 #
 566                 #       HACK: strip [PSC] from the front of the username,
 567                 #       and things like .ppp from the end.
 568                 #
 569                 $user =~ s/^[PSC]//;
 570                 $user =~ s/\.(ppp|slip|cslip)$//;
 571
 572                 #
 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.
 576                 #
 577                 $argv_user = $ARGV[3];
 578                 if ($ulen == 8) {
 579                         $ulen = length($user);
 580                         $argv_user = substr($ARGV[3], 0, $ulen);
 581                 }
 582
 583                 if ($port == $ARGV[2]) {
 584                         if ($user eq $argv_user) {
 585                                 print LOG "  $user matches $argv_user " .
 586                                         "on port $port" if ($debug);
 587                                 close FD;
 588                                 return 1;
 589                         } else {
 590                                 print LOG "  $user doesn't match $argv_user " .
 591                                         "on port $port" if ($debug);
 592                                 close FD;
 593                                 return 0;
 594                         }
 595                 }
 596         }
 597         close FD;
 598         0;
 599 }
 600
 601 #
 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.
 606 #
 607 sub tc_tccheck {
 608         #
 609         #       Localize all variables first.
 610         #
 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);
 614
 615         return 2 unless (check_net_telnet());
 616
 617         $terminalserver = $ARGV[1];
 618         $Port_seen = 0;
 619         #
 620         #       Get login name and password for a certain NAS from $naspass.
 621         #
 622         ($login, $password) = naspasswd($terminalserver, 1);
 623         return 2 if ($password eq "");
 624
 625         #
 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.
 630         #
 631         $telnet = new Net::Telnet (Timeout => 5,
 632                                    Prompt => '/\>/');
 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 --",
 639                          String => "\>",
 640                          Timeout => 5);
 641                 $ok = $telnet->print("");
 642                 push @curlines, split(/^/m, $curline);
 643         }
 644         $telnet->close;
 645         #
 646         #       Telnet closed.  We got the info.  Let's examine it.
 647         #
 648         $totlines = @curlines;
 649         $ccntr = 0;
 650         while($ccntr < $totlines) {
 651                 #
 652                 #       Check for ^Port.
 653                 #
 654                 if ($curlines[$ccntr] =~ /^Port/) {
 655                         $Port_seen++;
 656                         $ccntr++;
 657                         next;
 658                 }
 659                 #
 660                 #       Ignore all unnecessary lines.
 661                 #
 662                 if (!$Port_seen || $curlines[$ccntr] =~ /^---/ ||
 663                         $curlines[$ccntr] =~ /^ .*$/) {
 664                         $ccntr++;
 665                         next;
 666                 }
 667                 #
 668                 #       Parse the current line for the port# and username.
 669                 #
 670                 @cltok = split(/\s+/, $curlines[$ccntr]);
 671                 $ccntr++;
 672                 $port = $cltok[0];
 673                 $user = $cltok[1];
 674                 $ulen = length($user);
 675                 #
 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.
 679                 #
 680                 $user =~ s/^[PSC]//;
 681                 $user =~ s/\.(ppp|slip|cslip)$//;
 682                 $port =~ s/^S//;
 683                 #
 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.
 687                 #
 688                 $argv_user = $ARGV[3];
 689                 if ($ulen == 15) {
 690                         $ulen = length($user);
 691                         $argv_user = substr($ARGV[3], 0, $ulen);
 692                 }
 693                 if ($port == $ARGV[2]) {
 694                         if ($user eq $argv_user) {
 695                                 print LOG "  $user matches $argv_user " .
 696                                         "on port $port" if ($debug);
 697                                 return 1;
 698                         } else {
 699                                 print LOG "  $user doesn't match $argv_user " .
 700                                         "on port $port" if ($debug);
 701                                 return 0;
 702                         }
 703                 }
 704         }
 705         0;
 706 }
 707
 708 #
 709 #       Check a Cyclades PathRAS via telnet
 710 #
 711 #       Version: 1.2
 712 #
 713 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 714 #
 715 sub cyclades_telnet {
 716         #
 717         #       Localize all variables first.
 718         #
 719         my ($pr, $pr_login, $pr_passwd, $pr_prompt, $endlist, @list, $port, $user);
 720         #
 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.
 724         #
 725         $pr_prompt = '/Select option ==\>$/i';
 726
 727         #
 728         #       This variable match the end of userslist.
 729         #
 730         $endlist = '/Type \<enter\>/i';
 731
 732         #
 733         #       Do we have Net::Telnet installed?
 734         #
 735         return 2 unless (check_net_telnet());
 736
 737         #
 738         #       Get login name and password for NAS
 739         #       from $naspass file.
 740         #
 741         ($pr_login, $pr_passwd) = naspasswd($ARGV[1], 1);
 742
 743         #
 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
 747         #
 748         $pr = new Net::Telnet (
 749                 Timeout         => 5,
 750                 Host            => $ARGV[1],
 751                 ErrMode         => 'return'
 752         ) || return 2;
 753
 754         #
 755         #       Force PathRAS shows its banner.
 756         #
 757         $pr->break();
 758
 759         #
 760         #       Log on PathRAS
 761         #
 762         if ($pr->waitfor(Match => '/login : $/i') == 1) {
 763                 $pr->print($pr_login);
 764         } else {
 765                 print LOG " Error: sending login name to PathRAS\n" if ($debug);
 766                 $pr->close;
 767                 return 2;
 768         }
 769
 770         if ($pr->waitfor(Match => '/password : $/i') == 1) {
 771                 $pr->print($pr_passwd);
 772         } else {
 773                 print LOG " Error: sending password to PathRAS.\n" if ($debug);
 774                 $pr->close;
 775                 return 2;
 776         }
 777
 778         $pr->print();
 779
 780         #
 781         #       Access menu option 6 "PathRAS Management"
 782         #
 783         if ($pr->waitfor(Match => $pr_prompt) == 1) {
 784                 $pr->print('6');
 785         } else {
 786                 print LOG "  Error: acessing menu option '6'.\n" if ($debug);
 787                 $pr->close;
 788                 return 2;
 789         }
 790         #
 791         #       Access menu option 8 "Show Active Ports"
 792         #
 793         if ($pr->waitfor(Match => $pr_prompt) == 1) {
 794                 @list = $pr->cmd(String => '8', Prompt => $endlist);
 795         } else {
 796                 print LOG "  Error: acessing menu option '8'.\n" if ($debug);
 797                 $pr->close;
 798                 return 2;
 799         }
 800         #
 801         #       Since we got the info we want, let's close
 802         #       the telnet session
 803         #
 804         $pr->close;
 805
 806         #
 807         #       Lets examine the userlist stored in @list
 808         #
 809         foreach(@list) {
 810                 #
 811                 #       We are interested in active sessions only
 812                 #
 813                 if (/Active/i) {
 814                         ($port, $user) = split;
 815                         #
 816                         #       Strip out any prefix, suffix and
 817                         #       realm from $user check to see if
 818                         #       $ARGV[3] matches.
 819                         #
 820                         if(strip_username($ARGV[3]) eq strip_username($user)) {
 821                                 print LOG "  User '$ARGV[3]' found on '$ARGV[1]:$port'.\n" if ($debug);
 822                                 return 1;
 823                         }
 824                 }
 825         }
 826         print LOG "  User '$ARGV[3]' not found on '$ARGV[1]'.\n" if ($debug);
 827         0;
 828 }
 829
 830 #
 831 #       Check a Patton 2800 via SNMP
 832 #
 833 #       Version: 1.0
 834 #
 835 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 836 #
 837 sub patton_snmp {
 838    my($oid);
 839
 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];
 844    #
 845    # Check if the session still active
 846    #
 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);
 850       return 1;
 851    }
 852    0;
 853 }
 854
 855 #
 856 #      Check a Digitro BXS via rusers
 857 #
 858 #      Version: 1.1
 859 #
 860 #      Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 861 #
 862 sub digitro_rusers {
 863    my ($ret);
 864    local $_;
 865
 866    if (-e $rusers && -x $rusers) {
 867       #
 868       # Get a list of users logged in via rusers
 869       #
 870       $_ = `$rusers $ARGV[1]`;
 871       $ret = ((/$ARGV[3]/) ? 1 : 0);
 872    } else {
 873       print LOG "   Error: can't execute $rusers\n" if $debug;
 874       $ret = 2;
 875    }
 876    $ret;
 877 }
 878
 879 #
 880 #       Check Cyclades PR3000 and PR4000 via SNMP
 881 #
 882 #       Version: 1.0
 883 #
 884 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 885 #
 886 sub cyclades_snmp {
 887    my ($oid, $ret);
 888    local $_;
 889
 890    $oid = ".1.3.6.1.4.1.2925.3.3.6.1.1.2";
 891
 892    $_ = snmpwalk($ARGV[1],"$cmmty_string",$oid);
 893    $ret = ((/$ARGV[3]/) ? 1 : 0);
 894    $ret;
 895 }
 896
 897 #
 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>)
 901 #
 902
 903 #       This routine modified by Dan Halverson <danh@tbc.net>
 904 #       to suport additional versions of Hiper Arc
 905 #
 906
 907 $usrm    = '.iso.org.dod.internet.private.enterprises.429';
 908 sub usrhiper_snmp {
 909         my ($login,$password,$oidext);
 910
 911         # Look up community string in naspasswd file.
 912         ($login, $password) = naspasswd($ARGV[1], 1);
 913         if ($login && $login ne 'SNMP') {
 914                 if($debug) {
 915                         print LOG
 916                         "   Error: Need SNMP community string for $ARGV[1]\n";
 917                 }
 918                 return 2;
 919         } else {
 920 # If password is defined in naspasswd file, use it as community, otherwise use $cmmty_string
 921                 if ($password eq '') {
 922                     $password = "$cmmty_string";
 923                 }
 924         }
 925         my ($ver) = get_hiper_ver(usrm=>$usrm, target=>$ARGV[1], community=>$password);
 926         $oidext = get_oidext(ver=>$ver, tty=>$ARGV[2]);
 927         my ($login);
 928
 929         $login = snmpget($ARGV[1], $password, "$usrm.4.10.1.1.18.$oidext");
 930         if ($login =~ /\"/) {
 931                 $login =~ /^.*\"([^"]+)\"/;
 932                 $login = $1;
 933         }
 934
 935         print LOG "  user at port S$ARGV[2]: $login\n" if ($debug);
 936
 937         ($login eq $ARGV[3]) ? 1 : 0;
 938 }
 939
 940 #
 941 #     get_hiper_ver and get_oidext by Dan Halverson <danh@tbc.net>
 942 #
 943 sub get_hiper_ver {
 944     my (%args) = @_;
 945     my ($ver
 946         );
 947     $ver = snmpget ($args{'target'}, $args{'community'}, $args{'usrm'}.".4.1.14.0");
 948     return($ver);
 949 }
 950
 951 #
 952 #   Add additional OID checks below before the else.
 953 #   Else is for 4.0.30
 954 #
 955 sub get_oidext {
 956     my (%args) = @_;
 957     my ($oid
 958         );
 959     if ($args{'ver'} =~ /V5.1.99/) {
 960         $oid = $args{'tty'}+1257-1;
 961     }
 962     else {
 963         $oid = 1257 + 256*int(($args{'tty'}-1) / $hiper_density) +
 964                              (($args{'tty'}-1) % $hiper_density);
 965     }
 966     return($oid);
 967 }
 968
 969 #
 970 #       Check USR Netserver with Telnet - based on tc_tccheck.
 971 #       By "Marti" <mts@interplanet.es>
 972 #
 973 sub usrnet_telnet {
 974         #
 975         #       Localize all variables first.
 976         #
 977         my ($ts, $terminalserver, $login, $password);
 978         my ($telnet, $curprompt, $curline, $ok);
 979         my (@curlines, $user, $port);
 980
 981         return 2 unless (check_net_telnet());
 982
 983         $terminalserver = $ARGV[1];
 984         $Port_seen = 0;
 985         #
 986         #       Get login name and password for a certain NAS from $naspass.
 987         #
 988         ($login, $password) = naspasswd($terminalserver, 1);
 989         return 2 if ($password eq "");
 990
 991         #
 992         #       Communicate with Netserver using Net::Telnet, then access
 993         #       list connectionsto see who are logged in.
 994         #
 995         $telnet = new Net::Telnet (Timeout => 5,
 996                                    Prompt => '/\>/');
 997         $telnet->open($terminalserver);
 998
 999         #
1000         #       Log on Netserver
1001         #
1002         $telnet->login($login, $password);
1003
1004         #
1005         #     Launch list connections command
1006
1007         $telnet->print("list connections");
1008
1009         while ($curprompt ne "\>") {
1010                 ($curline, $curprompt) = $telnet->waitfor
1011                         ( String => "\>",
1012                          Timeout => 5);
1013                 $ok = $telnet->print("");
1014                 push @curlines, split(/^/m, $curline);
1015         }
1016
1017         $telnet->close;
1018         #
1019         #       Telnet closed.  We got the info.  Let's examine it.
1020         #
1021         foreach(@curlines) {
1022                 if ( /mod\:/ ) {
1023                         ($port, $user, $dummy) = split;
1024                         #
1025                         # Strip out any prefixes and suffixes
1026                         # from the username
1027                         #
1028                         # uncomment this if you use the standard
1029                         # prefixes
1030                         #$user =~ s/^[PSC]//;
1031                         #$user =~ s/\.(ppp|slip|cslip)$//;
1032                         #
1033                         # Check to see if $user is already connected
1034                         #
1035                         if ($user eq $ARGV[3]) {
1036                                 print LOG "  $user matches $ARGV[3] " .
1037                                         "on port $port" if ($debug);
1038                                 return 1;
1039                         };
1040                 };
1041         };
1042         print LOG
1043         "  $ARGV[3] not found on Netserver logged users list " if ($debug);
1044         0;
1045 }
1046
1047 #
1048 #       Versanet's Perl Script Support:
1049 #
1050 #       ___ versanet_snmp 1.0 by support@versanetcomm.com ___ July 1999
1051 #       Versanet Enterprise MIB Base: 1.3.6.1.4.1.2180
1052 #
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.
1055 #
1056 $vsm     = '.iso.org.dod.internet.private.enterprises.2180';
1057 sub versanet_snmp {
1058
1059         print LOG "argv[2] = $ARGV[2] " if ($debug);
1060         $port = $ARGV[2]%8;
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");
1066 #
1067 #       Note: the "$cmmty_string" string above could be replaced by the public
1068 #             community string defined in Versanet VN2001/VN2002.
1069 #
1070           print LOG "  user at slot $slot port $port: $loginname\n" if ($debug);          ($loginname eq $ARGV[3]) ? 1 : 0;
1071 }
1072
1073
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
1080 #   [...]
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!
1086
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
1089     while(<FINGER>) {
1090         my ($Asy, $PPP, $User) = split;
1091         if( $User =~ /^$ARGV[3]$/ ){
1092             close FINGER;
1093             print LOG "checkrad:bay_finger: ONLINE $ARGV[3]\@$ARGV[1]"
1094                 if ($debug);
1095             return 1; # online
1096         }
1097     }
1098     close FINGER;
1099     print LOG "checkrad:bay_finger: offline $ARGV[3]\@$ARGV[1]" if ($debug);
1100     return 0; # offline
1101 }
1102
1103 #
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>
1108 #       July 19 2001
1109 #
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
1116
1117 sub find_l2tp_login
1118 {
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;
1123
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);
1127
1128   do
1129   {
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});
1134
1135   my $val1 = $snmp_var->[$SNMP::Varbind::ref_f];
1136
1137   if ($val1 =~ /^$port_oid/) {
1138     $result = substr($val1, length($port_oid));
1139     $result =~ /^\.(\d+)\.(\d+)$/;
1140     $tunID = $1;
1141     $sessID = $2;
1142   }
1143
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];
1147
1148   return $login;
1149 }
1150
1151 sub cisco_l2tp_snmp
1152 {
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;
1156 }
1157
1158 sub mikrotik_snmp {
1159
1160   # Set SNMP version
1161   # MikroTik only supports version 1
1162   $snmp_version = "1";
1163
1164   # Look up community string in naspasswd file.
1165   ($login, $password) = naspasswd($ARGV[1], 1);
1166   if ($login && $login ne 'SNMP') {
1167     if($debug) {
1168       print LOG "Error: Need SNMP community string for $ARGV[1]\n";
1169     }
1170     return 2;
1171   } else {
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";
1176     }
1177   }
1178
1179   # We want interface descriptions
1180   $oid = "ifDescr";
1181
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");
1186
1187   foreach $line ( @output ) {
1188     #remove newline
1189     chomp $line;
1190     #remove trailing whitespace
1191     ($line = $line) =~ s/\s+$//;
1192     if( $line =~ /<.*-$ARGV[3]>/ ) {
1193       $username_seen++;
1194     }
1195   }
1196
1197   #lets return something
1198   if ($username_seen > 0) {
1199     return 1;
1200   } else {
1201     return 0;
1202   }
1203 }
1204
1205 sub mikrotik_telnet {
1206   # Localize all variables first.
1207   my ($t, $login, $password);
1208   my (@fields, @output, $output, $username_seen, $user);
1209
1210   return 2 unless (check_net_telnet());
1211
1212   $terminalserver = $ARGV[1];
1213   $user = $ARGV[3];
1214
1215   # Get login name and password for a certain NAS from $naspass.
1216   ($login, $password) = naspasswd($terminalserver, 1);
1217   return 2 if ($password eq "");
1218
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 => '//\[.*@.*\] > /');
1224
1225   # Dont just exit when there is error
1226   $t->errmode('return');
1227
1228   # Telnet to terminal server
1229   $t->open($terminalserver) or return 2;
1230
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/');
1238
1239   # Just be sure that routeros isn't waiting for us to press "Enter"
1240   $t->print("");
1241
1242   # Wait for the real prompt
1243   $t->waitfor('/\[.*@.*\] > /');
1244
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');
1249
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/');
1253
1254   # Now lets get the list of online ppp users.
1255   ( $output ) = $t->waitfor('/\[.*@.*\] > /');
1256
1257   # For debugging we can print the list to stdout
1258 #  print $output;
1259
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.
1264   $t->print("quit");
1265   $t->close;
1266
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.
1270
1271 #disabled until mikrotik starts to send newline after each line...
1272 #  @output = $output;
1273 #  foreach $line ( @output ) {
1274 #    #remove newline
1275 #    chomp $line;
1276 #    #remove trailing whitespace
1277 #    ($line = $line) =~ s/\s+$//;
1278 #    if( $line =~ /name=/ ) {
1279 #      print($line);
1280 #      @fields = split( /=/, $line );
1281 #      if( $fields[1] == "\"$user\"") {
1282 #        $username_seen++;
1283 #      }
1284 #    }
1285 #  }
1286
1287   if( $output =~ /name="$user"/ ) {
1288     $username_seen++;
1289   }
1290
1291   #lets return something
1292   if ($username_seen > 0) {
1293     return 1;
1294   } else {
1295     return 0;
1296   }
1297 }
1298
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];
1306     if (not $user) {
1307         print LOG " Error: No user defined\n" if ($debug);
1308         return 2;
1309     }
1310     if (not $context) {
1311         print LOG " Error: No context defined\n" if ($debug);
1312         return 2;
1313     }
1314
1315     # Get loggin information
1316     ($root, $password) = naspasswd($terminalserver, 1);
1317     return 2 if ($password eq "");
1318
1319     $operprompt = '/\[.*\].*>$/';
1320     $adminprompt = '/\[.*\].*#$/';
1321
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);
1327
1328     #Enable us
1329     $t->print('ena');
1330     $t->waitfor('/Password/');
1331     $t->print($password);
1332     $t->waitfor($adminprompt);
1333     $t->prompt($adminprompt);
1334
1335     #Switch context
1336     $t->cmd(String => "context $context");
1337
1338     #Ask the question
1339     @lines = $t->cmd(String => "show subscribers active
1340 $user\@$context");
1341     if ($lines[0] =~ /subscriber $user\@$context/ ) {
1342         return 1;
1343     }
1344     return 0;
1345 }
1346
1347 ###############################################################################
1348
1349 # Poor man's getopt (for -d)
1350 if ($ARGV[0] eq '-d') {
1351         shift @ARGV;
1352         $debug = "stdout";
1353 }
1354
1355 if ($debug) {
1356         if ($debug eq 'stdout') {
1357                 open(LOG, ">&STDOUT");
1358         } elsif ($debug eq 'stderr') {
1359                 open(LOG, ">&STDERR");
1360         } else {
1361                 open(LOG, ">>$debug");
1362                 $now = localtime;
1363                 print LOG "$now checkrad @ARGV\n";
1364         }
1365 }
1366
1367 if ($#ARGV != 4) {
1368         print LOG "Usage: checkrad nas_type nas_ip " .
1369                         "nas_port login session_id\n" if ($debug);
1370         print STDERR "Usage: checkrad nas_type nas_ip " .
1371                         "nas_port login session_id\n"
1372                         unless ($debug =~ m/^(stdout|stderr)$/);
1373         close LOG if ($debug);
1374         exit(2);
1375 }
1376
1377 if ($ARGV[0] eq 'livingston') {
1378         $ret = &livingston_snmp;
1379 } elsif ($ARGV[0] eq 'cisco') {
1380         $ret = &cisco_snmp;
1381 } elsif ($ARGV[0] eq 'cvx') {
1382         $ret = &cvx_snmp;
1383 } elsif ($ARGV[0] eq 'multitech') {
1384         $ret = &multitech_snmp;
1385 } elsif ($ARGV[0] eq 'computone') {
1386         $ret = &computone_finger;
1387 } elsif ($ARGV[0] eq 'max40xx') {
1388         $ret = &max40xx_finger;
1389 } elsif ($ARGV[0] eq 'ascend' || $ARGV[0] eq 'max40xx_snmp') {
1390         $ret = &ascend_snmp;
1391 } elsif ($ARGV[0] eq 'portslave') {
1392         $ret = &portslave_finger;
1393 } elsif ($ARGV[0] eq 'tc') {
1394         $ret = &tc_tccheck;
1395 } elsif ($ARGV[0] eq 'pathras') {
1396         $ret = &cyclades_telnet;
1397 } elsif ($ARGV[0] eq 'pr3000') {
1398         $ret = &cyclades_snmp;
1399 } elsif ($ARGV[0] eq 'pr4000') {
1400         $ret = &cyclades_snmp;
1401 } elsif ($ARGV[0] eq 'patton') {
1402         $ret = &patton_snmp;
1403 } elsif ($ARGV[0] eq 'digitro') {
1404         $ret = &digitro_rusers;
1405 } elsif ($ARGV[0] eq 'usrhiper') {
1406         $ret = &usrhiper_snmp;
1407 } elsif ($ARGV[0] eq 'netserver') {
1408         $ret = &usrnet_telnet;
1409 } elsif ($ARGV[0] eq 'versanet') {
1410         $ret = &versanet_snmp;
1411 } elsif ($ARGV[0] eq 'bay') {
1412         $ret = &bay_finger;
1413 } elsif ($ARGV[0] eq 'cisco_l2tp'){
1414         $ret = &cisco_l2tp_snmp;
1415 } elsif ($ARGV[0] eq 'mikrotik'){
1416         $ret = &mikrotik_telnet;
1417 } elsif ($ARGV[0] eq 'mikrotik_snmp'){
1418         $ret = &mikrotik_snmp;
1419 } elsif ($ARGV[0] eq 'redback'){
1420         $ret = &redback_telnet;
1421 } elsif ($ARGV[0] eq 'other') {
1422         $ret = 1;
1423 } else {
1424         print LOG "  checkrad: unknown NAS type $ARGV[0]\n" if ($debug);
1425         print STDERR "checkrad: unknown NAS type $ARGV[0]\n";
1426         $ret = 2;
1427 }
1428
1429 if ($debug) {
1430         $mn = "login ok";
1431         $mn = "double detected" if ($ret == 1);
1432         $mn = "error detected" if ($ret == 2);
1433         print LOG "  Returning $ret ($mn)\n";
1434         close LOG;
1435 }
1436
1437 exit($ret);