checkrad.pl.in

radius server在linux下的源码

    }
    else {
	$oid = 1257 + 256*int(($args{'tty'}-1) / $hiper_density) +
	                     (($args{'tty'}-1) % $hiper_density);
    }
    return($oid);
}

#
#	Check USR Netserver with Telnet - based on tc_tccheck.
#	By "Marti" <[e-mail]>
#
sub usrnet_telnet {
	#
	#	Localize all variables first.
	#
	my ($ts, $terminalserver, $login, $password);
	my ($telnet, $curprompt, $curline, $ok);
	my (@curlines, $user, $port);

	return 2 unless (check_net_telnet());

	$terminalserver = $ARGV[1];
	$Port_seen = 0;
	#
	#	Get login name and password for a certain NAS from $naspass.
	#
	($login, $password) = naspasswd($terminalserver, 1);
	return 2 if ($password eq "");

	#
	#	Communicate with Netserver using Net::Telnet, then access
	#	list connectionsto see who are logged in. 
	# 
	$telnet = new Net::Telnet (Timeout => 5,
				   Prompt => '/\>/');
	$telnet->open($terminalserver);

	#
	#	Log on Netserver
	#
	$telnet->login($login, $password);

	#
	#     Launch list connections command

	$telnet->print("list connections");

	while ($curprompt ne "\>") {
		($curline, $curprompt) = $telnet->waitfor
			( String => "\>",
			 Timeout => 5);
		$ok = $telnet->print("");
		push @curlines, split(/^/m, $curline);
	}

	$telnet->close;
	#
	#	Telnet closed.  We got the info.  Let's examine it.
	#
	foreach(@curlines) {
		if ( /mod\:/ ) {
			($port, $user, $dummy) = split;
			#
			# Strip out any prefixes and suffixes 
			# from the username
			#
			# uncomment this if you use the standard
			# prefixes
			#$user =~ s/^[PSC]//;
			#$user =~ s/\.(ppp|slip|cslip)$//;
			#
			# Check to see if $user is already connected
			#
			if ($user eq $ARGV[3]) {
				print LOG "  $user matches $ARGV[3] " .
					"on port $port" if ($debug);
				return 1;
			};
		};
	};
	print LOG 
	"  $ARGV[3] not found on Netserver logged users list " if ($debug);
	0;
}

#
#	Versanet's Perl Script Support:
#
#	___ versanet_snmp 1.0 by [e-mail] ___ July 1999
#	Versanet Enterprise MIB Base: 1.3.6.1.4.1.2180
#   
#	VN2001/2002 use slot/port number to locate modems. To use snmp get we
#	have to translate the original port number into a slot/port pair.
#
$vsm     = '.iso.org.dod.internet.private.enterprises.2180';
sub versanet_snmp {
        
	print LOG "argv[2] = $ARGV[2] " if ($debug);
	$port = $ARGV[2]%8;
	$port = 8 if ($port eq 0);	  
	print LOG "port = $port " if ($debug);
	$slot = (($ARGV[2]-$port)/8)+1;
	print LOG "slot = $slot" if ($debug);
	$loginname = snmpget($ARGV[1], "$cmmty_string", "$vsm.27.1.1.3.$slot.$port");
#
#	Note: the "$cmmty_string" string above could be replaced by the public
#	      community string defined in Versanet VN2001/VN2002.
#
	  print LOG "  user at slot $slot port $port: $loginname\n" if ($debug);	  ($loginname eq $ARGV[3]) ? 1 : 0;	
}


# 1999/08/24 Chris Shenton <[e-mail]>
# Check Bay8000 NAS (aka: Annex) using finger. 
# Returns from "finger @bay" like:
#   Port  What User         Location         When          Idle  Address
#   asy2  PPP  bill         ---              9:33am         :08  192.168.1.194
#   asy4  PPP  hillary      ---              9:36am         :04  192.168.1.195
#   [...]
# But also returns partial-match users if you say like "finger g@bay":
#   Port  What User         Location         When          Idle  Address
#   asy2  PPP  gore         ---              9:33am         :09  192.168.1.194
#   asy22 PPP  gwbush       ---              Mon  9:19am    :07  192.168.1.80
# So check exact match of username!

sub bay_finger {		# ARGV: 1=nas_ip, 2=nas_port, 3=login, 4=sessid
    open(FINGER, "$finger $ARGV[3]\@$ARGV[1]|") || return 2; # error
    while(<FINGER>) {
	my ($Asy, $PPP, $User) = split;
	if( $User =~ /^$ARGV[3]$/ ){
	    close FINGER;
	    print LOG "checkrad:bay_finger: ONLINE $ARGV[3]\@$ARGV[1]"
		if ($debug);
	    return 1; # online
	}
    }
    close FINGER;
    print LOG "checkrad:bay_finger: offline $ARGV[3]\@$ARGV[1]" if ($debug);
    return 0; # offline
}

#
#	Cisco L2TP support
#	This is for PPP sessions coming from an L2TP tunnel from a Dial
#	or DSL wholesale provider
#	Paul Khavkine <[e-mail]>
#	July 19 2001
#
# find_l2tp_login() walks a part of cisco vpdn tree to find out what session
# and tunnel ID's are for a given Virtual-Access interface to construct
# the following OID: .1.3.6.1.4.1.9.10.24.1.3.2.1.2.2.$tunID.$sessID
# Then gets the username from that OID.
# Make sure you set the $realm variable at the begining of the file if
# needed. The new type for naslist is cisco_l2tp

sub find_l2tp_login
{
  my($host, $community, $port_num) = @_;
  my $l2tp_oid = '.1.3.6.1.4.1.9.10.24.1.3.2.1.2.2';
  my $port_oid = '.iso.org.dod.internet.private.enterprises.9.10.51.1.2.1.1.2.2';
  my $port = 'Vi' . $port_num;

  my $sess = new SNMP::Session(DestHost => $host, Community =>  $community);
  my $snmp_var = new  SNMP::Varbind(["$port_oid"]);
  my $val = $sess->getnext($snmp_var);

  do
  {
    $sess->getnext($snmp_var);
  } until ($snmp_var->[$SNMP::Varbind::val_f] =~ /$port/) ||
	(!($snmp_var->[$SNMP::Varbind::ref_f] =~ /^$port_oid\.(\d+)\.(\d+)$/)) ||
  	($sess->{ErrorNum});

  my $val1 = $snmp_var->[$SNMP::Varbind::ref_f];

  if ($val1 =~ /^$port_oid/) {
    $result = substr($val1, length($port_oid));
    $result =~ /^\.(\d+)\.(\d+)$/;
    $tunID = $1;
    $sessID = $2;
  }

  my $snmp_var1 = new SNMP::Varbind(["$l2tp_oid\.$tunID\.$sessID"]);
  $val = $sess->get($snmp_var1);
  my $login = $snmp_var1->[$SNMP::Varbind::val_f];

  return $login;
}

sub cisco_l2tp_snmp
{
  my $login = find_l2tp_login("$ARGV[1]", $cmmty_string, "$ARGV[2]");
  print LOG "  user at port S$ARGV[2]: $login\n" if ($debug);
  ($login eq "$ARGV[3]\@$realm") ? 1 : 0;
}

sub mikrotik_snmp {

  # Set SNMP version
  # MikroTik only supports version 1
  $snmp_version = "1";
 
  # Look up community string in naspasswd file.
  ($login, $password) = naspasswd($ARGV[1], 1);
  if ($login && $login ne 'SNMP') {
    if($debug) {
      print LOG "Error: Need SNMP community string for $ARGV[1]\n";
    }
    return 2;
  } else { 
  # If password is defined in naspasswd file, use it as community,
  # otherwise use $cmmty_string
    if ($password eq '') {
      $password = "$cmmty_string";
    }
  }
 
  # We want interface descriptions
  $oid = "ifDescr";

  # Mikrotik doesnt give port IDs correctly to RADIUS :(
  # practically this would limit us to a simple only-one user limit for
  # this script to work properly.
  @output = snmpwalk_prog($ARGV[1], $password, "$oid");

  foreach $line ( @output ) {
    #remove newline
    chomp $line;
    #remove trailing whitespace
    ($line = $line) =~ s/\s+$//;
    if( $line =~ /<.*-$ARGV[3]>/ ) {
      $username_seen++;
    }
  }

  #lets return something
  if ($username_seen > 0) {
    return 1;
  } else {
    return 0;
  }
}

sub mikrotik_telnet {
  # Localize all variables first.
  my ($t, $login, $password);
  my (@fields, @output, $output, $username_seen, $user);

  return 2 unless (check_net_telnet());

  $terminalserver = $ARGV[1];
  $user = $ARGV[3];

  # Get login name and password for a certain NAS from $naspass.
  ($login, $password) = naspasswd($terminalserver, 1);
  return 2 if ($password eq "");

  # MikroTik routeros doesnt tell us to which port the user is connected
  # practically this would limit us to a simple only-one user limit for
  # this script to work properly.
  $t = new Net::Telnet (Timeout => 5,
                        Prompt => '//\[.*@.*\] > /');

  # Dont just exit when there is error
  $t->errmode('return');
                       
  # Telnet to terminal server
  $t->open($terminalserver) or return 2;

  #Send login and password etc.
  $t->login(Name => $login,
            Password => $password,
  # We must detect if we are logged in from the login banner.
  # Because if routeros is with a free license the command
  # prompt dont come. Instead it waits us to press "Enter".
            Prompt => '/MikroTik/');

  # Just be sure that routeros isn't waiting for us to press "Enter"
  $t->print("");

  # Wait for the real prompt
  $t->waitfor('/\[.*@.*\] > /');

  # It is not possible to get the line numbers etc.
  # Thus we cant support if simultaneus-use is over 1
  # At least I was using pppoe so it wasnt possible.
  $t->print('ppp active print column name detail');

  # Somehow routeros echo'es our commands 2 times. We dont want to mix
  # this with the real command prompt.
  $t->waitfor('/\[.*@.*\] > ppp active print column name detail/');

  # Now lets get the list of online ppp users.
  ( $output ) = $t->waitfor('/\[.*@.*\] > /');

  # For debugging we can print the list to stdout
#  print $output;

  #Lets logout to make everybody happy.
  #If we close the connection without logging out then routeros
  #starts to complain after a while. Saying;
  #telnetd: All network ports in use.
  $t->print("quit");
  $t->close;

  #check for # of $user in output
  #the output includes only one = between name and username so we can
  #safely use it as a seperator.

#disabled until mikrotik starts to send newline after each line...
#  @output = $output;
#  foreach $line ( @output ) {
#    #remove newline
#    chomp $line;
#    #remove trailing whitespace
#    ($line = $line) =~ s/\s+$//;
#    if( $line =~ /name=/ ) {
#      print($line);
#      @fields = split( /=/, $line );
#      if( $fields[1] == "\"$user\"") {
#        $username_seen++;
#      }
#    }
#  }

  if( $output =~ /name="$user"/ ) {
    $username_seen++;
  } 

  #lets return something
  if ($username_seen > 0) {
    return 1;
  } else {
    return 0;
  }
}

sub redback_telnet {
    #Localize all variables first.
    my ($terminalserver, $login, $password);
    my ($user, $context, $operprompt, $adminprompt, $t);
    return 2 unless (check_net_telnet());
    $terminalserver = $ARGV[1];
    ($user, $context) = split /@/, $ARGV[3];
    if (not $user) {
	print LOG " Error: No user defined\n" if ($debug);
	return 2;
    }
    if (not $context) {
	print LOG " Error: No context defined\n" if ($debug);
	return 2;
    }
    
    # Get loggin information
    ($root, $password) = naspasswd($terminalserver, 1);
    return 2 if ($password eq "");
    
    $operprompt = '/\[.*\].*>$/';
    $adminprompt = '/\[.*\].*#$/';
    
    # Logging to the RedBack NAS
    $t = new Net::Telnet (Timeout => 5, Prompt => $operprompt);
    $t->input_log("./debug");
    $t->open($terminalserver);
    $t->login($root, $password);
    
    #Enable us
    $t->print('ena');
    $t->waitfor('/Password/');
    $t->print($password);
    $t->waitfor($adminprompt);
    $t->prompt($adminprompt);
    
    #Switch context
    $t->cmd(String => "context $context");
    
    #Ask the question
    @lines = $t->cmd(String => "show subscribers active
$user\@$context");
    if ($lines[0] =~ /subscriber $user\@$context/ ) {
	return 1;
    }
    return 0;
}

###############################################################################

# Poor man's getopt (for -d)
if ($ARGV[0] eq '-d') {
	shift @ARGV;
	$debug = "stdout";
}

if ($debug) {
	if ($debug eq 'stdout') {
		open(LOG, ">&STDOUT");
	} elsif ($debug eq 'stderr') {
		open(LOG, ">&STDERR");
	} else {
		open(LOG, ">>$debug");
		$now = localtime;
		print LOG "$now checkrad @ARGV\n";
	}
}

if ($#ARGV != 4) {
	print LOG "Usage: checkrad nas_type nas_ip " .
			"nas_port login session_id\n" if ($debug);
	print STDERR "Usage: checkrad nas_type nas_ip " .
			"nas_port login session_id\n"
			unless ($debug =~ m/^(stdout|stderr)$/);
	close LOG if ($debug);
	exit(2);
}

if ($ARGV[0] eq 'livingston') {
	$ret = &livingston_snmp;
} elsif ($ARGV[0] eq 'cisco') {
	$ret = &cisco_snmp;
} elsif ($ARGV[0] eq 'cvx') {
	$ret = &cvx_snmp;
} elsif ($ARGV[0] eq 'multitech') {
        $ret = &multitech_snmp;
} elsif ($ARGV[0] eq 'computone') {
	$ret = &computone_finger;
} elsif ($ARGV[0] eq 'max40xx') {
	$ret = &max40xx_finger;
} elsif ($ARGV[0] eq 'ascend' || $ARGV[0] eq 'max40xx_snmp') {
	$ret = &ascend_snmp;
} elsif ($ARGV[0] eq 'portslave') {
	$ret = &portslave_finger;
} elsif ($ARGV[0] eq 'tc') {
	$ret = &tc_tccheck;
} elsif ($ARGV[0] eq 'pathras') {
	$ret = &cyclades_telnet;
} elsif ($ARGV[0] eq 'pr3000') {
	$ret = &cyclades_snmp;
} elsif ($ARGV[0] eq 'pr4000') {
	$ret = &cyclades_snmp;
} elsif ($ARGV[0] eq 'patton') {
	$ret = &patton_snmp;
} elsif ($ARGV[0] eq 'digitro') {
	$ret = &digitro_rusers;
} elsif ($ARGV[0] eq 'usrhiper') {
	$ret = &usrhiper_snmp;
} elsif ($ARGV[0] eq 'netserver') {
	$ret = &usrnet_telnet;
} elsif ($ARGV[0] eq 'versanet') {
        $ret = &versanet_snmp;
} elsif ($ARGV[0] eq 'bay') {
	$ret = &bay_finger;
} elsif ($ARGV[0] eq 'cisco_l2tp'){
        $ret = &cisco_l2tp_snmp;
} elsif ($ARGV[0] eq 'mikrotik'){
        $ret = &mikrotik_telnet;
} elsif ($ARGV[0] eq 'mikrotik_snmp'){
        $ret = &mikrotik_snmp;
} elsif ($ARGV[0] eq 'redback'){
        $ret = &redback_telnet;
} elsif ($ARGV[0] eq 'other') {
	$ret = 1;
} else {
	print LOG "  checkrad: unknown NAS type $ARGV[0]\n" if ($debug);
	print STDERR "checkrad: unknown NAS type $ARGV[0]\n";
	$ret = 2;
}

if ($debug) {
	$mn = "login ok";
	$mn = "double detected" if ($ret == 1);
	$mn = "error detected" if ($ret == 2);
	print LOG "  Returning $ret ($mn)\n";
	close LOG;
}

exit($ret);