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 cistron-radius 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:      @(#)checkrad.pl  1.18  25-Jul-1999  miquels@cistron.nl
  14 #
  15 #               livingston_snmp  1.1    Author: miquels@cistron.nl
  16 #               portslave_finger 1.0    Author: miquels@cistron.nl
  17 #               max40xx_finger   1.0    Author: costa@mdi.ca
  18 #               computone_finger 1.1    Author: costa@mdi.ca
  19 #               sub tc_tccheck   1.1    Author: alexisv@compass.com.ph
  20 #               pathras_telnet   1.1    Author: accdias@sst.com.br
  21 #               patton_snmp      1.0    Author: accdias@sst.com.br
  22 #               digitro_rusers   1.0    Author: accdias@sst.com.br
  23 #               usrhiper_snmp    1.0    Author: igor@ipass.net
  24 #               multitech_snmp   1.0    Author: ehonzay@willmar.com
  25 #               netserver_telnet 1.0    Author: mts@interplanet.es
  26 #               versanet_snmp    1.0    Author: support@versanetcomm.com
  27 #
  28 #       Config: $debug is the file you want to put debug messages in
  29 #               $snmpget is the location of your ``snmpget'' program
  30 #               $naspass is the location of your NAS admin password file
  31 #
  32
  33 $prefix         = "@prefix@";
  34 $localstatedir  = "@localstatedir@";
  35 $logdir         = "@logdir@";
  36 $sysconfdir     = "@sysconfdir@";
  37 $raddbdir       = "@raddbdir@";
  38
  39 $debug          = "";
  40 #$debug         = "$logdir/checkrad.log";
  41
  42 $snmpget        = "@SNMPGET@";
  43 $naspass        = "$raddbdir/naspasswd";
  44 $rusers         = "@RUSERS@";
  45
  46 #
  47 #       PM3:    $lv_offs is where the last S port is before one or two
  48 #               ports are skipped (22 or 29, for US or Europe)
  49 #               $lv_hole is the size of the hole (1 or 2, for US or Europe).
  50 #
  51 $lv_offs = 29;
  52 $lv_hole = 2;
  53
  54 #
  55 #       Try to load Net::Telnet, SNMP_Session etc.
  56 #       Do not complain if we cannot find it.
  57 #       Prefer a locally installed copy.
  58 #
  59 BEGIN {
  60         unshift @INC, "/usr/local/lib/site_perl";
  61
  62         eval "use Net::Telnet 3.00;";
  63         $::HAVE_NET_TELNET = ($@ eq "");
  64
  65         eval "use SNMP_Session;";
  66         if ($@ eq "") {
  67                 eval "use BER;";
  68                 $::HAVE_SNMP_SESSION = ($@ eq "");
  69                 eval "use Socket;";
  70         }
  71 };
  72
  73 #
  74 #       Get password from /etc/raddb/naspasswd file.
  75 #       Returns (login, password).
  76 #
  77 sub naspasswd {
  78         my ($terminalserver, $emptyok) = @_;
  79         my ($login, $password);
  80         my ($ts, $log, $pass);
  81
  82         unless (open(NFD, $naspass)) {
  83                 if (!$emptyok) {
  84                         print LOG "checkrad: naspasswd file not found; " .
  85                         "possible match for $ARGV[3]\n" if ($debug);
  86                         print STDERR "checkrad: naspassswd file not found; " .
  87                         "possible match for $ARGV[3]\n";
  88                 }
  89                 return ();
  90         }
  91         while (<NFD>) {
  92                 chop;
  93                 next if (m/^(#|$|[\t ]+$)/);
  94                 ($ts, $log, $pass) = split(/\s+/, $_, 3);
  95                 if ($ts eq $terminalserver) {
  96                         $login = $log;
  97                         $password = $pass;
  98                         last;
  99                 }
 100         }
 101         close NFD;
 102         if ($password eq "" && !$emptyok) {
 103                 print LOG "checkrad: password for $ARGV[1] is null; " .
 104                         "possible match for $ARGV[3] on " .
 105                         "port $ARGV[2]\n" if ($debug);
 106                 print STDERR "checkrad: password for $ARGV[1] is null; " .
 107                         "possible match for $ARGV[3] on port $ARGV[2]\n";
 108         }
 109         ($login, $password);
 110 }
 111
 112 #
 113 #       See if Net::Telnet is there.
 114 #
 115 sub check_net_telnet {
 116         if (!$::HAVE_NET_TELNET) {
 117                 print LOG
 118                 "  checkrad: Net::Telnet 3.00+ CPAN module not installed\n"
 119                 if ($debug);
 120                 print STDERR
 121                 "checkrad: Net::Telnet 3.00+ CPAN module not installed\n";
 122                 return 0;
 123         }
 124         1;
 125 }
 126
 127 #
 128 #       Do snmpget by calling snmpget.
 129 #
 130 sub snmpget_prog {
 131         my ($host, $community, $oid) = @_;
 132         my ($ret);
 133         local $_;
 134
 135         $_ = `$snmpget $host $community $oid`;
 136         if (/^.*(\s|\")([0-9A-Za-z]{8})(\s|\"|$).*$/) {
 137                 # Session ID format.
 138                 $ret = $2;
 139         } elsif (/^.*=.*"(.*)"/) {
 140                 # oid = "...." junk format.
 141                 $ret = $1;
 142         } elsif (/^.*=\s*(\S+)/) {
 143                 # oid = string format
 144                 $ret = $1;
 145         }
 146
 147         # Strip trailing junk if any.
 148         $ret =~ s/\s*Hex:.*$//;
 149         $ret;
 150 }
 151
 152 #
 153 #       Do snmpget by using SNMP_Session.
 154 #       Coded by Jerry Workman <jerry@newwave.net>
 155 #
 156 sub snmpget_session {
 157         my ($host, $community, $OID) = @_;
 158         my ($ret);
 159         local $_;
 160         my (@enoid, $var,$response, $bindings, $binding, $value);
 161         my ($inoid, $outoid, $upoid, $oid, @retvals);
 162
 163         $OID =~ s/^.iso.org.dod.internet.private.enterprises/.1.3.6.1.4.1/;
 164
 165         push @enoid,  encode_oid((split /\./, $OID));
 166         srand();
 167
 168         my $session = SNMP_Session->open($host, $community, 161);
 169         if (!$session->get_request_response(@enoid)) {
 170                 $e = "No SNMP answer from $ARGV[0].";
 171                 print LOG "$e\n" if ($debug);
 172                 print STDERR "checkrad: $e\n";
 173                 return "";
 174         }
 175         $response = $session->pdu_buffer;
 176         ($bindings) = $session->decode_get_response ($response);
 177         $session->close ();
 178         while ($bindings) {
 179                 ($binding,$bindings) = decode_sequence ($bindings);
 180                 ($oid,$value) = decode_by_template ($binding, "%O%@");
 181                 my $tempo = pretty_print($value);
 182                 $tempo=~s/\t/ /g;
 183                 $tempo=~s/\n/ /g;
 184                 $tempo=~s/^\s+//;
 185                 $tempo=~s/\s+$//;
 186
 187                 push @retvals, $tempo;
 188         }
 189         $retvals[0];
 190 }
 191
 192 #
 193 #       Do snmpget
 194 #
 195 sub snmpget {
 196         my $ret;
 197
 198         if ($::HAVE_SNMP_SESSION) {
 199                 $ret = snmpget_session(@_);
 200         } elsif (-x $snmpget) {
 201                 $ret = snmpget_prog(@_);
 202         } else {
 203                 $e = "Neither SNMP_Session module or $snmpget found!";
 204                 print LOG "$e\n" if ($debug);
 205                 print STDERR "checkrad: $e\n";
 206                 $ret = "";
 207         }
 208         $ret;
 209 }
 210
 211 #
 212 #       Strip domains, prefixes and suffixes from username
 213 #
 214 #       Known prefixes: (P)PP, (S)LIP e (C)SLIP
 215 #       Known suffixes: .ppp, .slip e .cslip
 216 #
 217 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 218 #
 219 sub strip_username {
 220         my ($user) = @_;
 221         #
 222         #       Trim white spaces.
 223         #
 224         $user =~ s/^\s*(.*?)\s*$/$1/;
 225         #
 226         #       Strip out domains, prefix and suffixes
 227         #
 228         $user =~ s/\@(.)*$//;
 229         $user =~ s/^[PSC]//;
 230         $user =~ s/\.(ppp|slip|cslip)$//;
 231         $user;
 232 }
 233
 234 #
 235 #       See if the user is logged in using the Livingston MIB.
 236 #       We don't check the username but the session ID.
 237 #
 238 $lvm     = '.iso.org.dod.internet.private.enterprises.307';
 239 sub livingston_snmp {
 240
 241         #
 242         #       First find out the offset (ugly!!). Also, if the portno
 243         #       is greater than 29, substract 2 (S30 and S31 don't exist).
 244         #       You might need to change this to 23 and 1 for the USA.
 245         #
 246         $_ = snmpget($ARGV[1], "public", "$lvm.3.2.1.1.1.2.5");
 247         /S([0-9]+)/;
 248         $xport = $1 + 0;
 249         $portidx = $ARGV[2] + (5 - $xport);
 250         $portidx -= $lv_hole if ($ARGV[2] > $lv_offs);
 251         chop;
 252         print LOG "  using $xport offset for port / SNMPno translation\n"
 253                 if ($debug);
 254
 255         #
 256         #       Now get the session id from the terminal server.
 257         #
 258         $sessid = snmpget($ARGV[1], "public", "$lvm.3.2.1.1.1.5.$portidx");
 259
 260         print LOG "  session id at port S$ARGV[2]: $sessid\n" if ($debug);
 261
 262         ($sessid eq $ARGV[4]) ? 1 : 0;
 263 }
 264
 265 #
 266 #       See if the user is logged in using the Cisco MIB
 267 #
 268 $csm     = '.iso.org.dod.internet.private.enterprises.9';
 269 sub cisco_snmp {
 270         $login = snmpget($ARGV[1], "public", "$csm.2.9.2.1.18.$ARGV[2]");
 271
 272         print LOG "  user at port S$ARGV[2]: $login\n" if ($debug);
 273
 274         ($login eq $ARGV[3]) ? 1 : 0;
 275 }
 276
 277 #
 278 #       Check a MultiTech CommPlete Server ( CC9600 & CC2400 )
 279 #
 280 #       Author: Eric Honzay of Bennett Office Products <ehonzay@willmar.com>
 281 #
 282 $msm    = '.iso.org.dod.internet.private.enterprises.995';
 283 sub multitech_snmp {
 284         my $temp = $ARGV[2] + 1;
 285
 286         $login = snmpget($ARGV[1], "public", "$msm.2.31.1.1.1.$temp");
 287         print LOG " user at port S$ARGV[2]: $login\n" if ($debug);
 288
 289         ($login eq $ARGV[3]) ? 1 : 0;
 290 }
 291
 292 #
 293 #       Check a Computone Powerrack via finger
 294 #
 295 #       Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
 296 #
 297 sub computone_finger {
 298         $online = 0;
 299         open(FD, "finger \@$ARGV[1]|");
 300         while(<FD>) {
 301            @line = <FD>;
 302            }
 303          $numline = @line;
 304          for ($num = 0; $num < $numline; $num++) {
 305            if( $line[$num]  =~ / $ARGV[3] / ){
 306              #print "$ARGV[3] is online\n";
 307              $online = 1; # user is online
 308            }
 309          }
 310         close FD;
 311         return $online;
 312 }
 313
 314 #
 315 #       Check an Ascend Max4000 or similar model via finger
 316 #
 317 #       Note: Not all software revisions support finger
 318 #             You may also need to enable the finger option.
 319 #
 320 #       Author: Shiloh Costa of MDI Internet Inc. <costa@mdi.ca>
 321 #
 322 sub max40xx_finger {
 323         open(FD, "finger $ARGV[3]\@$ARGV[1]|");
 324         while(<FD>) {
 325            $line = <FD>;
 326            if( $line =~ /Session/ ){
 327               return 1; # user is online
 328            }else{
 329               return 0; # user is offline
 330            }
 331         }
 332         close FD;
 333 }
 334
 335 #
 336 #       See if the user is logged in using the portslave finger.
 337 #
 338 sub portslave_finger {
 339         my ($Port_seen);
 340
 341         $Port_seen = 0;
 342
 343         open(FD, "finger \@$ARGV[1]|");
 344         while(<FD>) {
 345                 #
 346                 #       Check for ^Port. If we don't see it we
 347                 #       wont get confused by non-portslave-finger
 348                 #       output too.
 349                 #
 350                 if (/^Port/) {
 351                         $Port_seen++;
 352                         next;
 353                 }
 354                 next if (!$Port_seen);
 355                 next if (/^---/);
 356
 357                 ($port, $user) = /^.(...) (...............)/;
 358
 359                 $port =~ s/ .*//;
 360                 $user =~ s/ .*//;
 361                 $ulen = length($user);
 362                 #
 363                 #       HACK: strip [PSC] from the front of the username,
 364                 #       and things like .ppp from the end.
 365                 #
 366                 $user =~ s/^[PSC]//;
 367                 $user =~ s/\.(ppp|slip|cslip)$//;
 368
 369                 #
 370                 #       HACK: because ut_user usually has max. 8 characters
 371                 #       we only compare up the the length of $user if the
 372                 #       unstripped name had 8 chars.
 373                 #
 374                 $argv_user = $ARGV[3];
 375                 if ($ulen == 8) {
 376                         $ulen = length($user);
 377                         $argv_user = substr($ARGV[3], 0, $ulen);
 378                 }
 379
 380                 if ($port == $ARGV[2]) {
 381                         if ($user eq $argv_user) {
 382                                 print LOG "  $user matches $argv_user " .
 383                                         "on port $port" if ($debug);
 384                                 close FD;
 385                                 return 1;
 386                         } else {
 387                                 print LOG "  $user doesn't match $argv_user " .
 388                                         "on port $port" if ($debug);
 389                                 close FD;
 390                                 return 0;
 391                         }
 392                 }
 393         }
 394         close FD;
 395         0;
 396 }
 397
 398 #
 399 #       See if the user is already logged-in at the 3Com/USR Total Control.
 400 #       (this routine by Alexis C. Villalon <alexisv@compass.com.ph>).
 401 #       You must have the Net::Telnet module from CPAN for this to work.
 402 #       You must also have your /etc/raddb/naspasswd made up.
 403 #
 404 sub tc_tccheck {
 405         #
 406         #       Localize all variables first.
 407         #
 408         my ($Port_seen, $ts, $terminalserver, $log, $login, $pass, $password);
 409         my ($telnet, $curprompt, $curline, $ok, $totlines, $ccntr);
 410         my (@curlines, @cltok, $user, $port, $ulen);
 411
 412         return 2 unless (check_net_telnet());
 413
 414         $terminalserver = $ARGV[1];
 415         $Port_seen = 0;
 416         #
 417         #       Get login name and password for a certain NAS from $naspass.
 418         #
 419         ($login, $password) = naspasswd($terminalserver, 1);
 420         return 2 if ($password eq "");
 421
 422         #
 423         #       Communicate with NAS using Net::Telnet, then issue
 424         #       the command "show sessions" to see who are logged in.
 425         #       Thanks to Chris Jackson <chrisj@tidewater.net> for the
 426         #       for the "-- Press Return for More --" workaround.
 427         #
 428         $telnet = new Net::Telnet (Timeout => 10,
 429                                    Prompt => '/\>/');
 430         $telnet->open($terminalserver);
 431         $telnet->login($login, $password);
 432         $telnet->print("show sessions");
 433         while ($curprompt ne "\>") {
 434                 ($curline, $curprompt) = $telnet->waitfor
 435                         (String => "-- Press Return for More --",
 436                          String => "\>",
 437                          Timeout => 10);
 438                 $ok = $telnet->print("");
 439                 push @curlines, split(/^/m, $curline);
 440         }
 441         $telnet->close;
 442         #
 443         #       Telnet closed.  We got the info.  Let's examine it.
 444         #
 445         $totlines = @curlines;
 446         $ccntr = 0;
 447         while($ccntr < $totlines) {
 448                 #
 449                 #       Check for ^Port.
 450                 #
 451                 if ($curlines[$ccntr] =~ /^Port/) {
 452                         $Port_seen++;
 453                         $ccntr++;
 454                         next;
 455                 }
 456                 #
 457                 #       Ignore all unnecessary lines.
 458                 #
 459                 if (!$Port_seen || $curlines[$ccntr] =~ /^---/ ||
 460                         $curlines[$ccntr] =~ /^ .*$/) {
 461                         $ccntr++;
 462                         next;
 463                 }
 464                 #
 465                 #       Parse the current line for the port# and username.
 466                 #
 467                 @cltok = split(/\s+/, $curlines[$ccntr]);
 468                 $ccntr++;
 469                 $port = $cltok[0];
 470                 $user = $cltok[1];
 471                 $ulen = length($user);
 472                 #
 473                 #       HACK: strip [PSC] from the front of the username,
 474                 #       and things like .ppp from the end.  Strip S from
 475                 #       the front of the port number.
 476                 #
 477                 $user =~ s/^[PSC]//;
 478                 $user =~ s/\.(ppp|slip|cslip)$//;
 479                 $port =~ s/^S//;
 480                 #
 481                 #       HACK: because "show sessions" shows max. 15 characters
 482                 #       we only compare up to the length of $user if the
 483                 #       unstripped name had 15 chars.
 484                 #
 485                 $argv_user = $ARGV[3];
 486                 if ($ulen == 15) {
 487                         $ulen = length($user);
 488                         $argv_user = substr($ARGV[3], 0, $ulen);
 489                 }
 490                 if ($port == $ARGV[2]) {
 491                         if ($user eq $argv_user) {
 492                                 print LOG "  $user matches $argv_user " .
 493                                         "on port $port" if ($debug);
 494                                 return 1;
 495                         } else {
 496                                 print LOG "  $user doesn't match $argv_user " .
 497                                         "on port $port" if ($debug);
 498                                 return 0;
 499                         }
 500                 }
 501         }
 502         0;
 503 }
 504
 505 #
 506 #       Check a Cyclades PathRAS via telnet
 507 #
 508 #       Version: 1.1
 509 #
 510 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 511 #
 512 sub pathras_telnet {
 513    #
 514    #    Localize all variables first.
 515    #
 516    my (@users, $pathras, $port, $errmsg, $user, $login, $password);
 517    #
 518    #    Do we have Net::Telnet installed?
 519    #
 520    return 2 unless (check_net_telnet());
 521    #
 522    #    Get login name and password for NAS from $naspass file.
 523    #
 524    ($login, $password) = naspasswd($ARGV[1], 1);
 525    #
 526    #    NAS doesn't have a password defined
 527    #
 528    return 2 if ($password eq "");
 529    #
 530    #    Communicate with PathRAS using Net::Telnet, then access
 531    #    menu option 6.8 to see who are logged in. This assumes
 532    #    you are using the default Prompt String (menu option 6.2)
 533    #    and is based on PathRAS firmware version 1.1.9g
 534    #
 535    #
 536    $pathras = new Net::Telnet (
 537         Timeout => 10,
 538         Prompt => '/(.*)\s:*$/',
 539         Errmode => 'return'
 540    );
 541    #
 542    #
 543    #
 544    if (!$pathras->open($ARGV[1])) {;
 545       print LOG "  Error: " . $pathras->errmsg . "\n" if ($debug);
 546       $pathras->close;
 547       return 2;
 548    }
 549    #
 550    #    Dunno why but PathRAS only issue its banner and
 551    #    the login prompt after receive a "CR"
 552    #
 553    if (!$pathras->print("")) {
 554       print LOG "  Error: " . $pathras->errmsg . "\n" if ($debug);
 555       $pathras->close;
 556       return 2;
 557
 558    }
 559    #
 560    #    Log on PathRAS
 561    #
 562    if (!($pathras->login($login, $password))) {
 563       print LOG "  Error: " . $pathras->errmsg . "\n" if ($debug);
 564       $pathras->close;
 565       return 2;
 566    }
 567    #
 568    #  Access menu option 6 "PathRAS Management"
 569    #
 570    if (!($pathras->cmd(String => '6',
 571         Prompt => '/ ==\> $/',
 572         Timeout => 10))) {
 573       print LOG "  Error: " . $pathras->errmsg . "\n" if ($debug);
 574       $pathras->close;
 575       return 2;
 576    }
 577    #
 578    #  Access menu option 8 "Show Active Ports"
 579    #
 580    if (!(@users = $pathras->cmd(String => '8',
 581         Prompt => '/Type \<enter\>/',
 582         Timeout => 10))) {
 583       print LOG "  Error: " . $pathras->errmsg . "\n" if ($debug);
 584       $pathras->close;
 585       return 2;
 586    }
 587    #
 588    # Since we got the info we want, let's close the session
 589    #
 590    $pathras->close;
 591    #
 592    #    Telnet closed.  We got the info so let's examine it.
 593    #
 594    foreach(@users) {
 595       if (m/PPP Active|SLIP Active/) {
 596          ($port, $user) = split;
 597          #
 598          # Strip out any prefixes and suffixes
 599          # from the username
 600          #
 601          $user = strip_username($user);
 602          #
 603          # Check if $user is already connected
 604          #
 605          if ($user eq $ARGV[3]) {
 606             print LOG "  User $ARGV[3] found on " .
 607                "NAS $ARGV[1] port $port.\n" if ($debug);
 608             return 1;
 609          }
 610       }
 611    }
 612    print LOG "  User $ARGV[3] not found on " .
 613         "NAS $ARGV[1].\n" if ($debug);
 614    0;
 615 }
 616
 617 #
 618 #       Check a Patton 2800 via snmp
 619 #
 620 #       Version: 1.0
 621 #
 622 #       Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 623 #
 624 sub patton_snmp {
 625    my($oid);
 626
 627    $oid = '.1.3.6.1.4.1.1768.5.100.1.40.' . hex $ARGV[4];
 628    #
 629    # Check if the session still active
 630    #
 631    if (snmpget($ARGV[1], "monitor", "$oid") == 0) {
 632       print LOG "  Session $ARGV[4] still active on NAS " .
 633         "$ARGV[1], port $ARGV[2], for user $ARGV[3].\n" if ($debug);
 634       return 1;
 635    }
 636    0;
 637 }
 638
 639 #
 640 #      Check a Digitro BXS via rusers
 641 #
 642 #      Version: 1.0
 643 #
 644 #      Author: Antonio Dias of SST Internet <accdias@sst.com.br>
 645 #
 646 sub digitro_rusers {
 647    if (-e $rusers && -x $rusers) {
 648       open(FD, "$rusers $ARGV[1]|");
 649    } else {
 650       print LOG "   Error: can't execute $rusers\n" if $debug;
 651       return 2;
 652    }
 653
 654    while(<FD>) {
 655       if (/$ARGV[3]/) {
 656         close FD;
 657         return 1;
 658       }
 659    }
 660    close FD;
 661    0;
 662 }
 663
 664 #
 665 #       3Com/USR HiPer Arc Total Control.
 666 #       This works with HiPer Arc 4.0.30
 667 #       (this routine by Igor Brezac <igor@ipass.net>)
 668 #
 669 $usrm    = '.iso.org.dod.internet.private.enterprises.429';
 670 sub usrhiper_snmp {
 671
 672         # Somebody please verify????
 673         my($oidext) = $ARGV[2] + 1256;
 674         my ($login);
 675
 676         $login = snmpget($ARGV[1], "public", "$usrm.4.10.1.1.18.$oidext");
 677
 678         print LOG "  user at port S$ARGV[2]: $login\n" if ($debug);
 679
 680         ($login eq $ARGV[3]) ? 1 : 0;
 681 }
 682
 683
 684 #
 685 #       Check USR Netserver with Telnet - based on tc_tccheck.
 686 #       By "Marti" <mts@interplanet.es>
 687 #
 688 sub usrnet_telnet {
 689         #
 690         #       Localize all variables first.
 691         #
 692         my ($ts, $terminalserver, $login, $password);
 693         my ($telnet, $curprompt, $curline, $ok);
 694         my (@curlines, $user, $port);
 695
 696         return 2 unless (check_net_telnet());
 697
 698         $terminalserver = $ARGV[1];
 699         $Port_seen = 0;
 700         #
 701         #       Get login name and password for a certain NAS from $naspass.
 702         #
 703         ($login, $password) = naspasswd($terminalserver, 1);
 704         return 2 if ($password eq "");
 705
 706         #
 707         #       Communicate with Netserver using Net::Telnet, then access
 708         #       list connectionsto see who are logged in.
 709         #
 710         $telnet = new Net::Telnet (Timeout => 10,
 711                                    Prompt => '/\>/');
 712         $telnet->open($terminalserver);
 713
 714         #
 715         #       Log on Netserver
 716         #
 717         $telnet->login($login, $password);
 718
 719         #
 720         #     Launch list connections command
 721
 722         $telnet->print("list connections");
 723
 724         while ($curprompt ne "\>") {
 725                 ($curline, $curprompt) = $telnet->waitfor
 726                         ( String => "\>",
 727                          Timeout => 10);
 728                 $ok = $telnet->print("");
 729                 push @curlines, split(/^/m, $curline);
 730         }
 731
 732         $telnet->close;
 733         #
 734         #       Telnet closed.  We got the info.  Let's examine it.
 735         #
 736         foreach(@curlines) {
 737                 if ( /mod\:/ ) {
 738                         ($port, $user, $dummy) = split;
 739                         #
 740                         # Strip out any prefixes and suffixes
 741                         # from the username
 742                         #
 743                         # uncomment this if you use the standard
 744                         # prefixes
 745                         #$user =~ s/^[PSC]//;
 746                         #$user =~ s/\.(ppp|slip|cslip)$//;
 747                         #
 748                         # Check to see if $user is already connected
 749                         #
 750                         if ($user eq $ARGV[3]) {
 751                                 print LOG "  $user matches $ARGV[3] " .
 752                                         "on port $port" if ($debug);
 753                                 return 1;
 754                         };
 755                 };
 756         };
 757         print LOG
 758         "  $ARGV[3] not found on Netserver logged users list " if ($debug);
 759         0;
 760 }
 761
 762 #
 763 #       Versanet's Perl Script Support:
 764 #
 765 #       ___ versanet_snmp 1.0 by support@versanetcomm.com ___ July 1999
 766 #       Versanet Enterprise MIB Base: 1.3.6.1.4.1.2180
 767 #
 768 #       VN2001/2002 use slot/port number to locate modems. To use snmp get we
 769 #       have to translate the original port number into a slot/port pair.
 770 #
 771 $vsm     = '.iso.org.dod.internet.private.enterprises.2180';
 772 sub versanet_snmp {
 773
 774         print LOG "argv[2] = $ARGV[2] " if ($debug);
 775         $port = $ARGV[2]%8;
 776         $port = 8 if ($port eq 0);
 777         print LOG "port = $port " if ($debug);
 778         $slot = (($ARGV[2]-$port)/8)+1;
 779         print LOG "slot = $slot" if ($debug);
 780         $loginname = snmpget($ARGV[1], "public", "$vsm.27.1.1.3.$slot.$port");
 781 #
 782 #       Note: the "public" string above could be replaced by the public
 783 #             community string defined in Versanet VN2001/VN2002.
 784 #
 785           print LOG "  user at slot $slot port $port: $loginname\n" if ($debug);          ($loginname eq $ARGV[3]) ? 1 : 0;
 786 }
 787
 788
 789 if ($debug) {
 790         open(LOG, ">>$debug");
 791         $now = localtime;
 792         print LOG "$now checkrad @ARGV\n";
 793 }
 794
 795 if ($#ARGV != 4) {
 796         print LOG "Usage: checkrad nas_type nas_ip " .
 797                         "nas_port login session_id\n" if ($debug);
 798         print STDERR "Usage: checkrad nas_type nas_ip " .
 799                         "nas_port login session_id\n";
 800         close LOG if ($debug);
 801         exit(2);
 802 }
 803
 804 if ($ARGV[0] eq 'livingston') {
 805         $ret = &livingston_snmp;
 806 } elsif ($ARGV[0] eq 'cisco') {
 807         $ret = &cisco_snmp;
 808 } elsif ($ARGV[0] eq 'multitech') {
 809         $ret = &multitech_snmp;
 810 } elsif ($ARGV[0] eq 'computone') {
 811         $ret = &computone_finger;
 812 } elsif ($ARGV[0] eq 'max40xx') {
 813         $ret = &max40xx_finger;
 814 } elsif ($ARGV[0] eq 'portslave') {
 815         $ret = &portslave_finger;
 816 } elsif ($ARGV[0] eq 'tc') {
 817         $ret = &tc_tccheck;
 818 } elsif ($ARGV[0] eq 'pathras') {
 819         $ret = &pathras_telnet;
 820 } elsif ($ARGV[0] eq 'patton') {
 821         $ret = &patton_snmp;
 822 } elsif ($ARGV[0] eq 'digitro') {
 823         $ret = &digitro_rusers;
 824 } elsif ($ARGV[0] eq 'usrhiper') {
 825         $ret = &usrhiper_snmp;
 826 } elsif ($ARGV[0] eq 'netserver') {
 827         $ret = &usrnet_telnet;
 828 } elsif ($ARGV[0] eq 'versanet'){
 829         $ret = &versanet_snmp;
 830 } elsif ($ARGV[0] eq 'other') {
 831         $ret = 1;
 832 } else {
 833         print LOG "  checkrad: unknown NAS type $ARGV[0]\n" if ($debug);
 834         print STDERR "checkrad: unknown NAS type $ARGV[0]\n";
 835         $ret = 2;
 836 }
 837
 838 if ($debug) {
 839         $mn = "login ok";
 840         $mn = "double detected" if ($ret == 1);
 841         $mn = "error detected" if ($ret == 2);
 842         print LOG "  Returning $ret ($mn)\n";
 843         close LOG;
 844 }
 845
 846 exit($ret);